[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
This commit is contained in:
Ed Schonberg 2019-08-14 09:51:34 +00:00 committed by Pierre-Marie de Rodat
parent 4cac730ccc
commit 16b9e3c32d
5 changed files with 51 additions and 0 deletions

View File

@ -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):

View File

@ -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:

View File

@ -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,

View File

@ -0,0 +1,5 @@
-- { dg-do compile }
package body Assert2 is
procedure Dummy is null;
end Assert2;

View File

@ -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;