Commit cb572b75 by Samuel Tardieu Committed by Samuel Tardieu

re PR ada/15915 (Illegal program not detected, RM 13.11(15))

    gcc/ada/
	PR ada/15915
	* sem_util.ads, sem_util.adb (Denotes_Variable): New function.
	* sem_ch12.adb (Instantiate_Object): Use it.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ensure that
	storage pool denotes a variable as per RM 13.11(15).

    gcc/testsuite/
	PR ada/15915
	* gnat.dg/specs/storage.ads: New.

From-SVN: r134261
parent 17972da7
2008-04-14 Samuel Tardieu <sam@rfc1149.net>
PR ada/15915
* sem_util.ads, sem_util.adb (Denotes_Variable): New function.
* sem_ch12.adb (Instantiate_Object): Use it.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ensure that
storage pool denotes a variable as per RM 13.11(15).
2008-04-14 Samuel Tardieu <sam@rfc1149.net>
* sem_util.ads, sem_util.adb (In_Subprogram): New function.
* sem_attr.adb (Analyze_Attribute, Attribute_Old case): Use it.
......@@ -8213,7 +8213,7 @@ package body Sem_Ch12 is
Resolve (Actual, Ftyp);
if not Is_Variable (Actual) or else Paren_Count (Actual) > 0 then
if not Denotes_Variable (Actual) then
Error_Msg_NE
("actual for& must be a variable", Actual, Formal_Id);
......
......@@ -1481,6 +1481,11 @@ package body Sem_Ch13 is
Analyze_And_Resolve
(Expr, Class_Wide_Type (RTE (RE_Root_Storage_Pool)));
if not Denotes_Variable (Expr) then
Error_Msg_N ("storage pool must be a variable", Expr);
return;
end if;
if Nkind (Expr) = N_Type_Conversion then
T := Etype (Expression (Expr));
else
......
......@@ -2143,6 +2143,15 @@ package body Sem_Util is
end Denotes_Discriminant;
----------------------
-- Denotes_Variable --
----------------------
function Denotes_Variable (N : Node_Id) return Boolean is
begin
return Is_Variable (N) and then Paren_Count (N) = 0;
end Denotes_Variable;
-----------------------------
-- Depends_On_Discriminant --
-----------------------------
......
......@@ -245,6 +245,9 @@ package Sem_Util is
-- components of protected types, and constraint checks on entry
-- families constrained by discriminants.
function Denotes_Variable (N : Node_Id) return Boolean;
-- Returns True if node N denotes a single variable without parentheses.
function Depends_On_Discriminant (N : Node_Id) return Boolean;
-- Returns True if N denotes a discriminant or if N is a range, a subtype
-- indication or a scalar subtype where one of the bounds is a
......
2008-04-14 Samuel Tardieu <sam@rfc1149.net>
PR ada/15915
* gnat.dg/specs/storage.ads: New.
2008-04-14 Samuel Tardieu <sam@rfc1149.net>
* gnat.dg/deep_old.adb: New.
2008-04-14 Eric Botcazou <ebotcazou@adacore.com>
-- { dg-do compile }
with System.Pool_Global;
package Storage is
x1: System.Pool_Global.Unbounded_No_Reclaim_Pool;
type T1 is access integer;
for T1'Storage_Pool use (x1); -- { dg-error "denote a variable" }
type T2 is access Integer;
for T2'Storage_Pool use x1;
end Storage;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment