From: Viljar Indus Date: Wed, 6 May 2026 10:05:22 +0000 (+0300) Subject: ada: Remove conversion to an if-statement X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=9d46e6d1712a65f765be459df249cc76474e1dca;p=thirdparty%2Fgcc.git ada: Remove conversion to an if-statement There is no need to convert the ignored pragmas into if-statements with a statically false condition and a null body since the ignored ghost node removal should take care of this removal from now on. This simplifies the detection of those ignored pragmas and makes the code more easily identifiable and common with ignored ghost code that should behave similarly to ignored asseritons. gcc/ada/ChangeLog: * expander.adb: Handle pragma statements in the expander. * sem_ch6.adb (Check_Statement_Sequence): Handle cases where an ignored assertion pragma is at the end of a function body that is known to trigger an assertion. * sem_prag.adb (Analyze_Pragma): Remove the if-statement creation for ignored pragmas. Relocate checks for assertion pragma conditions that were performed on these transformed if-statements here. * sem_res.adb (Resolve_Short_Circuit): Remove the code for ignored assertion pragmas. * sem_util.adb (Original_Aspect_Pragma_Name): use the identifier name for pragma Check only when it did not come from source. * tbuild.adb (Make_Implicit_Loop_Statement): Adjust the code for ignored Check pragmas. --- diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb index e5ecd2c7050..e2af4f8a009 100644 --- a/gcc/ada/expander.adb +++ b/gcc/ada/expander.adb @@ -537,7 +537,8 @@ package body Expander is if Scope_Is_Transient and then N = Node_To_Be_Wrapped then case Nkind (N) is - when N_Procedure_Call_Statement + when N_Pragma + | N_Procedure_Call_Statement | N_Statement_Other_Than_Procedure_Call => Wrap_Transient_Statement (N); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 007b052db9e..338c798d874 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7118,9 +7118,10 @@ package body Sem_Ch6 is end loop; end if; - -- Don't count pragmas + -- Don't count pragmas, unless they are assertions that expect to + -- fail. - while Nkind (Last_Stm) = N_Pragma + while (Nkind (Last_Stm) = N_Pragma and then not Assert_False) -- Don't count call to SS_Release (can happen after -- Raise_Exception). diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 72534eec97f..fa9f11c3592 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -15483,6 +15483,10 @@ package body Sem_Prag is -- restore the Ghost mode. when Pragma_Check => Check : declare + procedure Check_Assertion_Failure (Arg_Check : Node_Id); + -- Check whether an Assert or a Check pragma evaluates to False, + -- except when the condition was explicitly set to False, and emit + -- a warning. procedure Handle_Dynamic_Predicate_Check; -- Enable or ignore the pragma depending on whether dynamic @@ -15526,6 +15530,52 @@ package body Sem_Prag is end if; end Handle_Dynamic_Predicate_Check; + ----------------------------- + -- Check_Assertion_Failure -- + ----------------------------- + + procedure Check_Assertion_Failure (Arg_Check : Node_Id) is + Orig_Check : Node_Id; + begin + if not Warn_On_Assertion_Failure + or else not Is_Entity_Name (Arg_Check) + or else not (Entity (Arg_Check) = Standard_False) + then + return; + end if; + + Orig_Check := Original_Node (Arg_Check); + + -- Don't warn if original condition is explicit False, since + -- obviously the failure is expected in this case. + + if Is_Entity_Name (Orig_Check) + and then Entity (Orig_Check) = Standard_False + then + return; + end if; + + case Pname is + when Name_Assert => + -- Note: Use Error_Msg_F here rather than Error_Msg_N. + -- The source location of the expression is not usually + -- the best choice here. For example, it gets located on + -- the last AND keyword in a chain of boolean expressiond + -- AND'ed together. It is best to put the message on the + -- first character of the assertion, which is the effect + -- of the First_Node call here. + + Error_Msg_F + ("?.a?assertion would fail at run time!", Arg_Check); + + when Name_Check => + Error_Msg_F + ("?.a?check would fail at run time!", Arg_Check); + when others => + null; + end case; + end Check_Assertion_Failure; + -- Local variables Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; @@ -15540,7 +15590,6 @@ package body Sem_Prag is Arg_Message : Node_Id renames Args (3); Cname : Name_Id; - Eloc : Source_Ptr; -- Start of processing for Pragma_Check @@ -15646,54 +15695,29 @@ package body Sem_Prag is Preanalyze_And_Resolve (Arg_Message, Standard_String); end if; - -- Now you might think we could just do the same with the Boolean - -- expression if checks are off (and expansion is on) and then - -- rewrite the check as a null statement. This would work but we - -- would lose the useful warnings about an assertion being bound - -- to fail even if assertions are turned off. - - -- So instead we wrap the boolean expression in an if statement - -- that looks like: - - -- if False and then condition then - -- null; - -- end if; - - -- The reason we do this rewriting during semantic analysis rather - -- than as part of normal expansion is that we cannot analyze and - -- expand the code for the boolean expression directly, or it may - -- cause insertion of actions that would escape the attempt to - -- suppress the check code. - - -- Note that the Sloc for the if statement corresponds to the - -- argument condition, not the pragma itself. The reason for - -- this is that we may generate a warning if the condition is - -- False at compile time, and we do not want to delete this - -- warning when we delete the if statement. - if Expander_Active and Is_Ignored_In_Codegen (N) then - -- Mark pragma as ignored ghost to reuse the same removal - -- process. + -- Even though technically ignored assertions are not ghost + -- code they should behave the same way. Meaning that they + -- should be analyzed but they should not affect the generated + -- code. Use the ignored ghost mechanism here to ensure that + -- the original pragma and any expanded code is also removed. + -- Ideally these two cases should be separated in the + -- implementation ??? Mark_Ghost_Pragma (N, Opt.Ignore); - Eloc := Sloc (Arg_Check); + In_Assertion_Expr := In_Assertion_Expr + 1; + Analyze_And_Resolve (Arg_Check, Any_Boolean); + In_Assertion_Expr := In_Assertion_Expr - 1; - Rewrite (N, - Make_If_Statement (Eloc, - Condition => - Make_And_Then (Eloc, - Left_Opnd => Make_Identifier (Eloc, Name_False), - Right_Opnd => Arg_Check), - Then_Statements => New_List ( - Make_Null_Statement (Eloc)))); + -- Suppress any warnings on the condition we might get - -- Now go ahead and analyze the if statement + Kill_Dead_Code (Arg_Check); - In_Assertion_Expr := In_Assertion_Expr + 1; - Analyze (N); - In_Assertion_Expr := In_Assertion_Expr - 1; + -- Warn if the condition is known to fail statically + + Check_Assertion_Failure (Arg_Check); -- Check is active or expansion not active. In these cases we can -- just go ahead and analyze the boolean with no worries. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 2d23b3f8567..43b6500ca61 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -11665,7 +11665,6 @@ package body Sem_Res is B_Typ : constant Entity_Id := Base_Type (Typ); L : constant Node_Id := Left_Opnd (N); R : constant Node_Id := Right_Opnd (N); - begin -- Ensure all actions associated with the left operand (e.g. -- finalization of transient objects) are fully evaluated locally within @@ -11694,101 +11693,6 @@ package body Sem_Res is Resolve (L, B_Typ); Resolve (R, B_Typ); - -- Check for issuing warning for always False assert/check, this happens - -- when assertions are turned off, in which case the pragma Assert/Check - -- was transformed into: - - -- if False and then then ... - - -- and we detect this pattern - - if Warn_On_Assertion_Failure - and then Is_Entity_Name (R) - and then Entity (R) = Standard_False - and then Nkind (Parent (N)) = N_If_Statement - and then Nkind (N) = N_And_Then - and then Is_Entity_Name (L) - and then Entity (L) = Standard_False - then - declare - Orig : constant Node_Id := Original_Node (Parent (N)); - - begin - -- Special handling of Asssert pragma - - if Nkind (Orig) = N_Pragma - and then Pragma_Name (Orig) = Name_Assert - then - declare - Expr : constant Node_Id := - Original_Node - (Expression - (First (Pragma_Argument_Associations (Orig)))); - - begin - -- Don't warn if original condition is explicit False, - -- since obviously the failure is expected in this case. - - if Is_Entity_Name (Expr) - and then Entity (Expr) = Standard_False - then - null; - - -- Issue warning. We do not want the deletion of the - -- IF/AND-THEN to take this message with it. We achieve this - -- by making sure that the expanded code points to the Sloc - -- of the expression, not the original pragma. - - else - -- Note: Use Error_Msg_F here rather than Error_Msg_N. - -- The source location of the expression is not usually - -- the best choice here. For example, it gets located on - -- the last AND keyword in a chain of boolean expressiond - -- AND'ed together. It is best to put the message on the - -- first character of the assertion, which is the effect - -- of the First_Node call here. - - Error_Msg_F - ("?.a?assertion would fail at run time!", - Expression - (First (Pragma_Argument_Associations (Orig)))); - end if; - end; - - -- Similar processing for Check pragma - - elsif Nkind (Orig) = N_Pragma - and then Pragma_Name (Orig) = Name_Check - then - -- Don't want to warn if original condition is explicit False - - declare - Expr : constant Node_Id := - Original_Node - (Expression - (Next (First (Pragma_Argument_Associations (Orig))))); - begin - if Is_Entity_Name (Expr) - and then Entity (Expr) = Standard_False - then - null; - - -- Post warning - - else - -- Again use Error_Msg_F rather than Error_Msg_N, see - -- comment above for an explanation of why we do this. - - Error_Msg_F - ("?.a?check would fail at run time!", - Expression - (Last (Pragma_Argument_Associations (Orig)))); - end if; - end; - end if; - end; - end if; - -- Continue with processing of short circuit Check_Unset_Reference (L); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 813632c1077..e027e5afb70 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -26724,7 +26724,7 @@ package body Sem_Util is Item_Nam := Chars (Original_Node (Pragma_Identifier (Original_Node (Item)))); - if Item_Nam = Name_Check then + if Item_Nam = Name_Check and then not Comes_From_Source (Item) then -- Pragma "Check" preserves the original pragma name as its first -- argument. Item_Nam := diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 77a564a8c28..4ccbf4faa01 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -35,7 +35,6 @@ with Opt; use Opt; with Restrict; use Restrict; with Rident; use Rident; with Sinfo.Utils; use Sinfo.Utils; -with Sem_Util; use Sem_Util; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; @@ -328,33 +327,12 @@ package body Tbuild is Has_Created_Identifier : Boolean := False; End_Label : Node_Id := Empty) return Node_Id is - P : Node_Id; - Check_Restrictions : Boolean := True; - begin - -- Do not check restrictions if the implicit loop statement is part - -- of a dead branch: False and then ... - -- This will occur in particular as part of the expansion of pragma - -- Assert when assertions are disabled. - - P := Parent (Node); - while Present (P) loop - if Nkind (P) = N_And_Then then - if Nkind (Left_Opnd (P)) = N_Identifier - and then Entity (Left_Opnd (P)) = Standard_False - then - Check_Restrictions := False; - exit; - end if; - - -- Prevent the search from going too far - - elsif Is_Body_Or_Package_Declaration (P) then - exit; - end if; - - P := Parent (P); - end loop; + -- Avoid constraint checks in ignored ghost regions that are going to be + -- removed later. + Check_Restrictions : constant Boolean := + Ghost_Config.Ghost_Mode /= Ignore; + begin if Check_Restrictions then Check_Restriction (No_Implicit_Loops, Node);