From 8218cfde96a4e9df2ce00fabc3d616d6f3cfc83c Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 25 May 2018 09:03:04 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_ch13.adb | 17 +++++++++++------ gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/static_pred1.adb | 21 +++++++++++++++++++++ gcc/testsuite/gnat.dg/static_pred1.ads | 5 +++++ 5 files changed, 48 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/static_pred1.adb create mode 100644 gcc/testsuite/gnat.dg/static_pred1.ads 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 + + * 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 * 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 + + * gnat.dg/static_pred1.adb, gnat.dg/static_pred1.ads: New testcase. + 2018-05-25 Richard Sandiford * 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; -- 2.30.2