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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 848beee0598ada69aab1c069d99e3e2d244cf5b0..9905b15ac73f8de8094b997f0cf3487f999f1bee 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+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.

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 8728bfe468464e56704eafe871bfd6eb039bd124..e7755c4f53412fcd8e6a7db269fb4245298e462f 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -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);
 

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 93d66270e745e892ee1cd1a76cfb9f473334e5c9..f72ffff6397a837cde8bb50d434bac8b71d07808 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 3d5aa776e893c2174573d12148569f8d5174f865..e7a6658e88de9231c7fc9fdc095f7f0b9d28825d 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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 --
    -----------------------------

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index d8c0b17e8d7e8ec78767fa5a8e4b7ca7aa5a0f97..291e230f4307dd8be2c2a9c2f14c07dfc90fd164 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 97d0dc701b14ae821d8d62508d0ad82f64db3202..a129d156362a5f86967b4719ccb77a42ce669636 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gnat.dg/specs/storage.ads b/gcc/testsuite/gnat.dg/specs/storage.ads
new file mode 100644 (file)
index 0000000..85a91d0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/storage.ads
@@ -0,0 +1,10 @@
+-- { 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;
+