[Ada] Crash on predicate in full view in a generic unit

This patch fixes a compiler abort on a dynamic predicate applied to the
full view of a type in a generic package declaration, when the
expression for the predicate is a conditionql expression that contains
references to components of the full view of the type.

2019-09-19  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Simplify
	handling of expressions in predicates when the context is a
	generic unit.

gcc/testsuite/

	* gnat.dg/predicate14.adb, gnat.dg/predicate14.ads: New
	testcase.

From-SVN: r275939

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b3e94dbf5dc307f9002aba019ae0031299deb5d6..2caf52da59dc3888cf666662729b953c6f7f2f05 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2019-09-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Simplify
+       handling of expressions in predicates when the context is a
+       generic unit.
+
 2019-09-19  Bob Duff  <duff@adacore.com>
 
        * sem_attr.adb (Resolve_Attribute): Make sure the secondary

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index ef9f965a564b3d5cce5f5c899963c35ebfa5ba21..354d068117a85f7a8d9c5d5aaa55e56e4797b032 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -9374,17 +9374,22 @@ package body Sem_Ch13 is
 
       else
          --  In a generic context freeze nodes are not always generated, so
-         --  analyze the expression now. If the aspect is for a type, this
-         --  makes its potential components accessible.
+         --  analyze the expression now. If the aspect is for a type, we must
+         --  also make its potential components accessible.
 
          if not Analyzed (Freeze_Expr) and then Inside_A_Generic then
             if A_Id = Aspect_Dynamic_Predicate
               or else A_Id = Aspect_Predicate
-              or else A_Id = Aspect_Priority
             then
                Push_Type (Ent);
-               Preanalyze_Spec_Expression (Freeze_Expr, T);
+               Preanalyze_Spec_Expression (Freeze_Expr, Standard_Boolean);
+               Pop_Type (Ent);
+
+            elsif A_Id = Aspect_Priority then
+               Push_Type (Ent);
+               Preanalyze_Spec_Expression (Freeze_Expr, Any_Integer);
                Pop_Type (Ent);
+
             else
                Preanalyze (Freeze_Expr);
             end if;
@@ -9395,12 +9400,23 @@ package body Sem_Ch13 is
 
          Set_Parent (End_Decl_Expr, ASN);
 
-         --  In a generic context the aspect expressions have not been
-         --  preanalyzed, so do it now. There are no conformance checks
-         --  to perform in this case.
+         --  In a generic context the original  aspect expressions have not
+         --  been preanalyzed, so do it now. There are no conformance checks
+         --  to perform in this case. As before, we have to make components
+         --  visible for aspects that may reference them.
 
          if No (T) then
-            Check_Aspect_At_Freeze_Point (ASN);
+            if A_Id = Aspect_Dynamic_Predicate
+              or else A_Id = Aspect_Predicate
+              or else A_Id = Aspect_Priority
+            then
+               Push_Type (Ent);
+               Check_Aspect_At_Freeze_Point (ASN);
+               Pop_Type (Ent);
+
+            else
+               Check_Aspect_At_Freeze_Point (ASN);
+            end if;
             return;
 
          --  The default values attributes may be defined in the private part,

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 69e78548ab8e2b699c6cbc571c6a428e62741d58..7cde63d60b90ca875bc2f4de1a8aa760060d14c1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-09-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/predicate14.adb, gnat.dg/predicate14.ads: New
+       testcase.
+
 2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/generic_inst13.adb,

diff --git a/gcc/testsuite/gnat.dg/predicate14.adb b/gcc/testsuite/gnat.dg/predicate14.adb
new file mode 100644 (file)
index 0000000..3caf7a4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/predicate14.adb
@@ -0,0 +1,4 @@
+--  { dg-do compile }
+package body Predicate14 is
+    procedure Dummy is null;
+end Predicate14;

diff --git a/gcc/testsuite/gnat.dg/predicate14.ads b/gcc/testsuite/gnat.dg/predicate14.ads
new file mode 100644 (file)
index 0000000..9ed6c86
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/predicate14.ads
@@ -0,0 +1,56 @@
+generic
+package Predicate14 with
+  SPARK_Mode
+is
+
+   type Field_Type is (F_Initial, F_Payload, F_Final);
+
+   type State_Type is (S_Valid, S_Invalid);
+
+   type Cursor_Type (State : State_Type := S_Invalid) is private;
+
+   type Cursors_Type is array (Field_Type) of Cursor_Type;
+
+   type Context_Type is private;
+
+   type Result_Type (Field : Field_Type := F_Initial) is
+      record
+         case Field is
+            when F_Initial | F_Final =>
+               null;
+            when F_Payload =>
+               Value : Integer;
+         end case;
+      end record;
+
+   function Valid_Context (Context : Context_Type) return Boolean;
+
+private
+
+   function Valid_Type (Result : Result_Type) return Boolean is
+     (Result.Field = F_Initial);
+
+   type Cursor_Type (State : State_Type := S_Invalid) is
+      record
+         case State is
+            when S_Valid =>
+               Value : Result_Type;
+            when S_Invalid =>
+               null;
+         end case;
+      end record
+      with Dynamic_Predicate =>
+          (if State = S_Valid then Valid_Type (Value));
+
+   type Context_Type is
+      record
+         Field : Field_Type := F_Initial;
+         Cursors : Cursors_Type := (others => (State => S_Invalid));
+      end record;
+
+   function Valid_Context (Context : Context_Type) return Boolean is
+     (for all F in Context.Cursors'Range =>
+         (Context.Cursors (F).Value.Field = F));
+
+   procedure Dummy;
+end Predicate14;
\ No newline at end of file