[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  <schonberg@adacore.com>

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 e932dab..0af3e41 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2019-07-03  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <ebotcazou@adacore.com>
 
        * 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 7e6e5fc..ffd6f23 100644 (file)
--- 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 245bf25..058b533 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-03  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/predicate5.adb, gnat.dg/predicate5.ads: New testcase.
+
 2019-07-03  Eric Botcazou  <ebotcazou@adacore.com>
 
        * 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 (file)
index 0000000..01acf64
--- /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 (file)
index 0000000..4e8f9b9
--- /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;