From cb572b755dcc64f8e5581f8734e5b1034381d41b Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Mon, 14 Apr 2008 12:10:16 +0000 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch12.adb | 2 +- gcc/ada/sem_ch13.adb | 5 +++++ gcc/ada/sem_util.adb | 9 +++++++++ gcc/ada/sem_util.ads | 3 +++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/specs/storage.ads | 10 ++++++++++ 7 files changed, 41 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/specs/storage.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 848beee0598..9905b15ac73 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2008-04-14 Samuel Tardieu + + 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 * 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 8728bfe4684..e7755c4f534 100644 --- 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 93d66270e74..f72ffff6397 100644 --- 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 3d5aa776e89..e7a6658e88d 100644 --- 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 d8c0b17e8d7..291e230f430 100644 --- 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 97d0dc701b1..a129d156362 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-04-14 Samuel Tardieu + + PR ada/15915 + * gnat.dg/specs/storage.ads: New. + 2008-04-14 Samuel Tardieu * 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 index 00000000000..85a91d0724e --- /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; + -- 2.30.2