This patch fixes an infinite loop in the compiler when analyzing an
expression function whose expression mentions a subtype with a static
predicate, and the context is a generic unit.

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-05-25  Ed Schonberg  <schonb...@adacore.com>

gcc/ada/

        * sem_ch13.adb (Build_Predicate_Functions): The predicate function
        declaration is inserted into the tree and analyzed at that point, so
        should not be reinserted when the body is constructed. Inside a
        generic, ensure that the body is not inserted twice in the tree.

gcc/testsuite/

        * gnat.dg/static_pred1.adb, gnat.dg/static_pred1.ads: New testcase.
--- gcc/ada/sem_ch13.adb
+++ gcc/ada/sem_ch13.adb
@@ -8832,15 +8832,20 @@ package body Sem_Ch13 is
                       Make_Simple_Return_Statement (Loc,
                         Expression => Expr))));
 
-            --  If declaration has not been analyzed yet, Insert declaration
-            --  before freeze node. Insert body itself after freeze node.
-
-            if not Analyzed (FDecl) then
-               Insert_Before_And_Analyze (N, FDecl);
-            end if;
+            --  The declaration has been analyzed when created, and placed
+            --  after type declaration. Insert body itself after freeze node.
 
             Insert_After_And_Analyze (N, FBody);
 
+            --  within a generic unit, prevent a double analysis of the body
+            --  which will not be marked analyzed yet. This will happen when
+            --  the freeze node is created during the pre-analysis of an
+            --  expression function.
+
+            if Inside_A_Generic then
+               Set_Analyzed (FBody);
+            end if;
+
             --  Static predicate functions are always side-effect free, and
             --  in most cases dynamic predicate functions are as well. Mark
             --  them as such whenever possible, so redundant predicate checks

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/static_pred1.adb
@@ -0,0 +1,21 @@
+--  { dg-do compile }
+
+package body Static_Pred1 is
+
+   type Enum_Type is (A, B, C);
+
+   subtype Enum_Subrange is Enum_Type with Static_Predicate =>
+     Enum_Subrange in A | C;
+
+   function "not" (Kind : Enum_Subrange) return Enum_Subrange is
+     (case Kind is
+      when A => C,
+      when C => A);
+
+   procedure Dummy (Value : T) is
+      IK : Enum_Subrange := not A;
+   begin
+      null;
+   end Dummy;
+
+end Static_Pred1;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/static_pred1.ads
@@ -0,0 +1,5 @@
+generic
+   type T is private;
+package Static_Pred1 is
+   procedure Dummy (Value : T);
+end Static_Pred1;

Reply via email to