aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/exp_prag.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/exp_prag.adb')
-rw-r--r--gcc/ada/exp_prag.adb18
1 files changed, 16 insertions, 2 deletions
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 0631172..2def83c 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -453,6 +453,8 @@ package body Exp_Prag is
New_Occurrence_Of (RTE (RE_Assert_Failure),
Loc))))))));
+ Set_Comes_From_Check_Or_Contract (N);
+
-- Case where we call the procedure
else
@@ -541,6 +543,8 @@ package body Exp_Prag is
Name =>
New_Occurrence_Of (RTE (RE_Raise_Assert_Failure), Loc),
Parameter_Associations => New_List (Relocate_Node (Msg))))));
+
+ Set_Comes_From_Check_Or_Contract (N);
end if;
Analyze (N);
@@ -1433,6 +1437,8 @@ package body Exp_Prag is
Condition => Cond,
Then_Statements => New_List (Error));
+ Set_Comes_From_Check_Or_Contract (Checks);
+
else
if No (Elsif_Parts (Checks)) then
Set_Elsif_Parts (Checks, New_List);
@@ -1642,6 +1648,8 @@ package body Exp_Prag is
Condition => New_Occurrence_Of (Flag, Loc),
Then_Statements => Eval_Stmts);
+ Set_Comes_From_Check_Or_Contract (Evals);
+
-- Otherwise generate:
-- elsif Flag then
-- <evaluation statements>
@@ -1836,6 +1844,8 @@ package body Exp_Prag is
Set (Flag),
Increment (Count)));
+ Set_Comes_From_Check_Or_Contract (If_Stmt);
+
Append_To (Decls, If_Stmt);
Analyze (If_Stmt);
@@ -1904,6 +1914,8 @@ package body Exp_Prag is
Right_Opnd => Make_Integer_Literal (Loc, 0)),
Then_Statements => CG_Stmts);
+ Set_Comes_From_Check_Or_Contract (CG_Checks);
+
-- Detect a possible failure due to several case guards evaluating to
-- True.
@@ -1937,15 +1949,17 @@ package body Exp_Prag is
New_Occurrence_Of (Msg_Str, Loc))))))))));
end if;
+ -- Append the checks, but do not analyze them at this point, because
+ -- contracts get potentially expanded as part of a wrapper which gets
+ -- fully analyzed once it is fully formed.
+
Append_To (Decls, CG_Checks);
- Analyze (CG_Checks);
-- Once all case guards are evaluated and checked, evaluate any prefixes
-- of attribute 'Old founds in the selected consequence.
if Present (Old_Evals) then
Append_To (Decls, Old_Evals);
- Analyze (Old_Evals);
end if;
-- Raise Assertion_Error when the corresponding consequence of a case