diff options
Diffstat (limited to 'gcc/ada/exp_prag.adb')
-rw-r--r-- | gcc/ada/exp_prag.adb | 18 |
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 |