From b45a9ff305f536031a12509c6c6e7aea9cb7f884 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Wed, 26 Sep 2018 09:17:21 +0000 Subject: [PATCH] [Ada] Crash on expression functions within quantified expressions This patch fixes an issue whereby using a call to an expression function as the domain of iteration for a loop would trigger a crash due to the function not being frozen appropriately. 2018-09-26 Justin Squirek gcc/ada/ * sem_ch5.adb (Analyze_Iterator_Specification): Add conditional to freeze called functions within iterator specifications during full analysis. (Preanalyze_Range): Minor typo fix. gcc/testsuite/ * gnat.dg/expr_func8.adb: New testcase. From-SVN: r264612 --- gcc/ada/ChangeLog | 7 ++++++ gcc/ada/sem_ch5.adb | 21 +++++++++++++--- gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gnat.dg/expr_func8.adb | 37 ++++++++++++++++++++++++++++ 4 files changed, 65 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/expr_func8.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9db27470fe0..4ab1bcd54aa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-09-26 Justin Squirek + + * sem_ch5.adb (Analyze_Iterator_Specification): Add conditional + to freeze called functions within iterator specifications during + full analysis. + (Preanalyze_Range): Minor typo fix. + 2018-09-26 Ed Schonberg * sem_ch6.adb (Analyze_Function_Return): If the return type has diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index f35b37d9c36..2f446913350 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2203,6 +2203,19 @@ package body Sem_Ch5 is Preanalyze_Range (Iter_Name); + -- If the domain of iteration is a function call, make sure the function + -- itself is frozen. This is an issue if this is a local expression + -- function. + + if Nkind (Iter_Name) = N_Function_Call + and then Is_Entity_Name (Name (Iter_Name)) + and then Full_Analysis + and then (In_Assertion_Expr = 0 + or else Assertions_Enabled) + then + Freeze_Before (N, Entity (Name (Iter_Name))); + end if; + -- Set the kind of the loop variable, which is not visible within the -- iterator name. @@ -4136,10 +4149,10 @@ package body Sem_Ch5 is Full_Analysis := False; Expander_Mode_Save_And_Set (False); - -- In addition to the above we must ecplicity suppress the - -- generation of freeze nodes which might otherwise be generated - -- during resolution of the range (e.g. if given by an attribute - -- that will freeze its prefix). + -- In addition to the above we must explicitly suppress the generation + -- of freeze nodes that might otherwise be generated during resolution + -- of the range (e.g. if given by an attribute that will freeze its + -- prefix). Set_Must_Not_Freeze (R_Copy); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3c954322f59..f8591aa6db9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-09-26 Justin Squirek + + * gnat.dg/expr_func8.adb: New testcase. + 2018-09-26 Ed Schonberg * gnat.dg/predicate3.adb, gnat.dg/predicate3_pkg.ads: New diff --git a/gcc/testsuite/gnat.dg/expr_func8.adb b/gcc/testsuite/gnat.dg/expr_func8.adb new file mode 100644 index 00000000000..90d3c9382d4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/expr_func8.adb @@ -0,0 +1,37 @@ +-- { dg-do compile } +-- { dg-options "-gnata" } + +procedure Expr_Func8 is + + type Node_Set is array (Positive range <>) of Integer; + + function Nodes return Node_Set is + ((1,2,3,4,5,6,7,8,9)); + + X1 : Boolean := (for all N of Nodes => N = N); + + function Predecessors (N : Integer) return Node_Set Is + (Nodes (1 .. N - 1)); + function Successors (N : Integer) return Node_Set Is + (Nodes (N + 1 .. Nodes'Last)); + + pragma Assert + (for all N of Nodes => + (for some S of Successors (N) => S = N)); + + X2 : Boolean := + (for all N of Nodes => + (for some S of Successors (N) => S = N)); + + X3 : Boolean := + (for all N of Nodes => + (for some S of Successors (N) => S = N)) with Ghost; + + pragma Assert + (for all N of Nodes => + (for all P of Predecessors (N) => + (for some S of Successors (P) => S = N))); + +begin + null; +end; -- 2.30.2