From: Ed Schonberg Date: Wed, 3 Jul 2019 08:14:24 +0000 (+0000) Subject: [Ada] Spurious error on dynamic predicate in a generic context X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8334176aaaebf68214328518b84a64ee20c72580;p=gcc.git [Ada] Spurious error on dynamic predicate in a generic context This patch fixes a spurious error on the conformance checking between the expression for an aspect analyzed at the freeze point of the type, and the analysis of a copy of the expression performed at the end of the enclosing list of declarationss. In a generic context the first may not have been analyzed yet and this must be done before the conformance check. 2019-07-03 Ed Schonberg gcc/ada/ * sem_ch13.adb (Analyze_Attribute_Definition_Clause): No error message on attribute applied to a renaming when the renamed object is an aggregate (from code reading). (Check_Aspect_At_End_Of_Declarations): In a generic context where freeze nodes are not generated, the original expression for an aspect may need to be analyzed to precent spurious conformance errors when compared with the expression that is anakyzed at the end of the current declarative list. gcc/testsuite/ * gnat.dg/predicate5.adb, gnat.dg/predicate5.ads: New testcase. From-SVN: r272969 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e932dab6568..0af3e419fea 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2019-07-03 Ed Schonberg + + * sem_ch13.adb (Analyze_Attribute_Definition_Clause): No error + message on attribute applied to a renaming when the renamed + object is an aggregate (from code reading). + (Check_Aspect_At_End_Of_Declarations): In a generic context + where freeze nodes are not generated, the original expression + for an aspect may need to be analyzed to precent spurious + conformance errors when compared with the expression that is + anakyzed at the end of the current declarative list. + 2019-07-03 Eric Botcazou * layout.adb (Layout_Type): Do not set the component size of an diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 7e6e5fc14e3..ffd6f2311d4 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4934,8 +4934,12 @@ package body Sem_Ch13 is and then Present (Renamed_Object (Ent)) then -- Case of renamed object from source, this is an error + -- unless the pbject is an aggregate and the renaming is + -- created for an object declaration. - if Comes_From_Source (Renamed_Object (Ent)) then + if Comes_From_Source (Renamed_Object (Ent)) + and then Nkind (Renamed_Object (Ent)) /= N_Aggregate + then Get_Name_String (Chars (N)); Error_Msg_Strlen := Name_Len; Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len); @@ -9336,6 +9340,16 @@ package body Sem_Ch13 is -- All other cases else + + -- In a generic context freeze nodes are not always generated, + -- so analyze the expression now. + + if not Analyzed (Freeze_Expr) + and then Inside_A_Generic + then + Preanalyze (Freeze_Expr); + end if; + -- Indicate that the expression comes from an aspect specification, -- which is used in subsequent analysis even if expansion is off. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 245bf25d4ac..058b533ba77 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-03 Ed Schonberg + + * gnat.dg/predicate5.adb, gnat.dg/predicate5.ads: New testcase. + 2019-07-03 Eric Botcazou * gnat.dg/alignment14.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/predicate5.adb b/gcc/testsuite/gnat.dg/predicate5.adb new file mode 100644 index 00000000000..01acf64443e --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate5.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Predicate5 is + procedure Foo is null; +end Predicate5; diff --git a/gcc/testsuite/gnat.dg/predicate5.ads b/gcc/testsuite/gnat.dg/predicate5.ads new file mode 100644 index 00000000000..4e8f9b9e1a4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate5.ads @@ -0,0 +1,17 @@ +generic + type Value_Type is private; +package Predicate5 is + type MT (Has : Boolean := False) is record + case Has is + when False => + null; + when True => + MX : Value_Type; + end case; + end record; + function Foo (M : MT) return Boolean is (not M.Has); + subtype LT is MT with Dynamic_Predicate => not LT.Has; + function Bar (M : MT) return Boolean is (Foo (M)); + + procedure Foo; +end;