mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-21 22:51:06 +08:00
[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:
parent
4cac730ccc
commit
16b9e3c32d
@ -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):
|
||||
|
@ -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:
|
||||
|
||||
|
@ -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,
|
||||
|
5
gcc/testsuite/gnat.dg/assert2.adb
Normal file
5
gcc/testsuite/gnat.dg/assert2.adb
Normal file
@ -0,0 +1,5 @@
|
||||
-- { dg-do compile }
|
||||
|
||||
package body Assert2 is
|
||||
procedure Dummy is null;
|
||||
end Assert2;
|
15
gcc/testsuite/gnat.dg/assert2.ads
Normal file
15
gcc/testsuite/gnat.dg/assert2.ads
Normal 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;
|
Loading…
x
Reference in New Issue
Block a user