From: Ed Schonberg <schonberg@adacore.com>
Date: Fri, 25 May 2018 09:03:04 +0000 (+0000)
Subject: [Ada] Compiler loop on expression function and predicate in generic unit
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8218cfde96a4e9df2ce00fabc3d616d6f3cfc83c;p=gcc.git

[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 8fd40527f0a..104dbdc722f 100644
--- 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 74bfd422fee..bdd9f4ed6a9 100644
--- 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 1399fb17087..3fff97300b1 100644
--- 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
index 00000000000..16bbde2c65b
--- /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
index 00000000000..4364fc866c5
--- /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;