[Ada] Compiler loop on expression function and predicate in generic unit

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.

2018-05-25  Ed Schonberg  <schonberg@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.

From-SVN: r260716

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8fd40527f0a6fddc32a9e5a133a846930e19cd7d..104dbdc722fdf9faa7a73db195747481fa2acd01 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-05-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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.
+
 2018-05-25  Yannick Moy  <moy@adacore.com>
 
        * sem_prag.adb (Check_Grouping): Modify test to ignore statements and

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 74bfd422fee55261b9a041485f5c3f22823f0f02..bdd9f4ed6a941abf099dcf718e44698d61987f51 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1399fb17087d665310f35b16f80b5b9dd1e0c6dd..3fff97300b1318156f41d247cbaa9f1463a99f2d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-05-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/static_pred1.adb, gnat.dg/static_pred1.ads: New testcase.
+
 2018-05-25  Richard Sandiford  <richard.sandiford@linaro.org>
 
        * lib/target-supports.exp

diff --git a/gcc/testsuite/gnat.dg/static_pred1.adb b/gcc/testsuite/gnat.dg/static_pred1.adb
new file mode 100644 (file)
index 0000000..16bbde2
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/static_pred1.ads b/gcc/testsuite/gnat.dg/static_pred1.ads
new file mode 100644 (file)
index 0000000..4364fc8
--- /dev/null
+++ b/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;