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> 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_util.ads, sem_util.adb (In_Subprogram): New function.
* sem_attr.adb (Analyze_Attribute, Attribute_Old case): Use it. * sem_attr.adb (Analyze_Attribute, Attribute_Old case): Use it.
...@@ -8213,7 +8213,7 @@ package body Sem_Ch12 is ...@@ -8213,7 +8213,7 @@ package body Sem_Ch12 is
Resolve (Actual, Ftyp); Resolve (Actual, Ftyp);
if not Is_Variable (Actual) or else Paren_Count (Actual) > 0 then if not Denotes_Variable (Actual) then
Error_Msg_NE Error_Msg_NE
("actual for& must be a variable", Actual, Formal_Id); ("actual for& must be a variable", Actual, Formal_Id);
......
...@@ -1481,6 +1481,11 @@ package body Sem_Ch13 is ...@@ -1481,6 +1481,11 @@ package body Sem_Ch13 is
Analyze_And_Resolve Analyze_And_Resolve
(Expr, Class_Wide_Type (RTE (RE_Root_Storage_Pool))); (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 if Nkind (Expr) = N_Type_Conversion then
T := Etype (Expression (Expr)); T := Etype (Expression (Expr));
else else
......
...@@ -2143,6 +2143,15 @@ package body Sem_Util is ...@@ -2143,6 +2143,15 @@ package body Sem_Util is
end Denotes_Discriminant; 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 -- -- Depends_On_Discriminant --
----------------------------- -----------------------------
......
...@@ -245,6 +245,9 @@ package Sem_Util is ...@@ -245,6 +245,9 @@ package Sem_Util is
-- components of protected types, and constraint checks on entry -- components of protected types, and constraint checks on entry
-- families constrained by discriminants. -- 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; function Depends_On_Discriminant (N : Node_Id) return Boolean;
-- Returns True if N denotes a discriminant or if N is a range, a subtype -- 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 -- indication or a scalar subtype where one of the bounds is a
......
2008-04-14 Samuel Tardieu <sam@rfc1149.net> 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. * gnat.dg/deep_old.adb: New.
2008-04-14 Eric Botcazou <ebotcazou@adacore.com> 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