aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2019-08-14 09:51:34 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-08-14 09:51:34 +0000
commit16b9e3c32d0c52334644021e5e0465b1c43d190e (patch)
treec953956ad17a9263c210e8f7d5199c4b60d8fdea
parent4cac730ccc741a9bf780390c2703163edc6da470 (diff)
downloadgcc-16b9e3c32d0c52334644021e5e0465b1c43d190e.zip
gcc-16b9e3c32d0c52334644021e5e0465b1c43d190e.tar.gz
gcc-16b9e3c32d0c52334644021e5e0465b1c43d190e.tar.bz2
[Ada] Crash on quantified expression in disabled assertion
The defining identifier of a quantified expression may be the freeze point of its type. If the quantified expression appears in an assertion that is disavbled, the freeze node for that type may appear in a tree that will be discarded when the enclosing pragma is elaborated. To ensure that the freeze node is reachable for subsquent uses we must generate its freeze node explicitly when the quantified expression is analyzed. 2019-08-14 Ed Schonberg <schonberg@adacore.com> gcc/ada/ * exp_ch4.adb (Expand_N_Quantified_Expression): Freeze explicitly the type of the loop parameter. gcc/testsuite/ * gnat.dg/assert2.adb, gnat.dg/assert2.ads: New testcase. From-SVN: r274456
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/exp_ch4.adb22
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/assert2.adb5
-rw-r--r--gcc/testsuite/gnat.dg/assert2.ads15
5 files changed, 51 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c661a38..99b551f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-08-14 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Quantified_Expression): Freeze
+ explicitly the type of the loop parameter.
+
2019-08-14 Javier Miranda <miranda@adacore.com>
* sem_util.adb (New_Copy_Tree.Copy_Node_With_Replacement):
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 4404c5d..00f9aae 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -10337,8 +10337,30 @@ package body Exp_Ch4 is
Flag : Entity_Id;
Scheme : Node_Id;
Stmts : List_Id;
+ Var : Entity_Id;
begin
+ -- Ensure that the bound variable is properly frozen. We must do
+ -- this before expansion because the expression is about to be
+ -- converted into a loop, and resulting freeze nodes may end up
+ -- in the wrong place in the tree.
+
+ if Present (Iter_Spec) then
+ Var := Defining_Identifier (Iter_Spec);
+ else
+ Var := Defining_Identifier (Loop_Spec);
+ end if;
+
+ declare
+ P : Node_Id := Parent (N);
+ begin
+ while Nkind (P) in N_Subexpr loop
+ P := Parent (P);
+ end loop;
+
+ Freeze_Before (P, Etype (Var));
+ end;
+
-- Create the declaration of the flag which tracks the status of the
-- quantified expression. Generate:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6b71b95..9923987 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-08-14 Ed Schonberg <schonberg@adacore.com>
+
+ * gnat.dg/assert2.adb, gnat.dg/assert2.ads: New testcase.
+
2019-08-14 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/inline18.adb, gnat.dg/inline18.ads,
diff --git a/gcc/testsuite/gnat.dg/assert2.adb b/gcc/testsuite/gnat.dg/assert2.adb
new file mode 100644
index 0000000..1328004
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/assert2.adb
@@ -0,0 +1,5 @@
+-- { dg-do compile }
+
+package body Assert2 is
+ procedure Dummy is null;
+end Assert2;
diff --git a/gcc/testsuite/gnat.dg/assert2.ads b/gcc/testsuite/gnat.dg/assert2.ads
new file mode 100644
index 0000000..adf9b921
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/assert2.ads
@@ -0,0 +1,15 @@
+package Assert2
+ with SPARK_Mode
+is
+ type Living is new Integer;
+ function Is_Martian (Unused : Living) return Boolean is (False);
+
+ function Is_Green (Unused : Living) return Boolean is (True);
+
+ pragma Assert
+ (for all M in Living => (if Is_Martian (M) then Is_Green (M)));
+ pragma Assert
+ (for all M in Living => (if Is_Martian (M) then not Is_Green (M)));
+
+ procedure Dummy;
+end Assert2;