From: Justin Squirek Date: Wed, 23 Dec 2020 18:06:22 +0000 (-0500) Subject: [Ada] Expansion in _postconditions confusing CodePeer X-Git-Tag: upstream/12.2.0~8341 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3ffe57d4b11ca8daab277d94c86db2b95feafa9d;p=platform%2Fupstream%2Fgcc.git [Ada] Expansion in _postconditions confusing CodePeer gcc/ada/ * contracts.adb (Build_Postconditions_Procedure): Remove internally generated if statement used to control finalization actions. * exp_ch6.adb (Add_Return, Expand_Non_Function_Return, Expand_Simple_Function_Return): Add if statement around _postconditions to control finalization. * exp_ch7.adb (Build_Finalizer): Likewise. * sem_prag.adb (Find_Related_Declaration_Or_Body): Add case to handle Context itself being a handled sequence of statements. --- diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 29557ec..f42a950 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -2367,6 +2367,10 @@ package body Contracts is -- postconditions until finalization has been performed when cleanup -- actions are present. + -- NOTE: This flag could be made into a predicate since we should be + -- able at compile time to recognize when finalization and cleanup + -- actions occur, but in practice this is not possible ??? + -- Generate: -- -- Postcond_Enabled : Boolean := True; @@ -2405,16 +2409,16 @@ package body Contracts is -- the postconditions: this would cause confusing debug info to be -- produced, interfering with coverage-analysis tools. - -- Also, wrap the postcondition checks in a conditional which can be - -- used to delay their evaluation when clean-up actions are present. + -- NOTE: Coverage-analysis and static-analysis tools rely on the + -- postconditions procedure being free of internally generated code + -- since some of these tools, like CodePeer, treat _postconditions + -- as original source. -- Generate: -- -- procedure _postconditions is -- begin - -- if Postcond_Enabled and then Return_Success_For_Postcond then - -- [Stmts]; - -- end if; + -- [Stmts]; -- end; Proc_Bod := @@ -2425,19 +2429,7 @@ package body Contracts is Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, End_Label => Make_Identifier (Loc, Chars (Proc_Id)), - Statements => New_List ( - Make_If_Statement (Loc, - Condition => - Make_And_Then (Loc, - Left_Opnd => - New_Occurrence_Of - (Defining_Identifier - (Postcond_Enabled_Decl), Loc), - Right_Opnd => - New_Occurrence_Of - (Defining_Identifier - (Return_Success_Decl), Loc)), - Then_Statements => Stmts)))); + Statements => Stmts)); Insert_After_And_Analyze (Last_Decl, Proc_Bod); end Build_Postconditions_Procedure; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6b14656..cc6c177 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6246,7 +6246,8 @@ package body Exp_Ch6 is -- has contract assertions that need to be verified on exit. -- Also, mark the successful return to signal that postconditions - -- need to be evaluated when finalization occurs. + -- need to be evaluated when finalization occurs by setting + -- Return_Success_For_Postcond to be True. if Ekind (Spec_Id) = E_Procedure and then Present (Postconditions_Proc (Spec_Id)) @@ -6254,19 +6255,30 @@ package body Exp_Ch6 is -- Generate: -- -- Return_Success_For_Postcond := True; - -- _postconditions; + -- if Postcond_Enabled then + -- _postconditions; + -- end if; Insert_Action (Stmt, Make_Assignment_Statement (Loc, Name => New_Occurrence_Of - (Get_Return_Success_For_Postcond (Spec_Id), Loc), + (Get_Return_Success_For_Postcond (Spec_Id), Loc), Expression => New_Occurrence_Of (Standard_True, Loc))); + -- Wrap the call to _postconditions within a test of the + -- Postcond_Enabled flag to delay postcondition evaluation + -- until after finalization when required. + Insert_Action (Stmt, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (Postconditions_Proc (Spec_Id), Loc))); + Make_If_Statement (Loc, + Condition => + New_Occurrence_Of (Get_Postcond_Enabled (Spec_Id), Loc), + Then_Statements => New_List ( + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of + (Postconditions_Proc (Spec_Id), Loc))))); end if; -- Ada 2020 (AI12-0279): append the call to 'Yield unless this is @@ -6699,7 +6711,9 @@ package body Exp_Ch6 is -- Generate: -- -- Return_Success_For_Postcond := True; - -- _postconditions; + -- if Postcond_Enabled then + -- _postconditions; + -- end if; Insert_Action (N, Make_Assignment_Statement (Loc, @@ -6708,9 +6722,19 @@ package body Exp_Ch6 is (Get_Return_Success_For_Postcond (Scope_Id), Loc), Expression => New_Occurrence_Of (Standard_True, Loc))); + -- Wrap the call to _postconditions within a test of the + -- Postcond_Enabled flag to delay postcondition evaluation until + -- after finalization when required. + Insert_Action (N, - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Postconditions_Proc (Scope_Id), Loc))); + Make_If_Statement (Loc, + Condition => + New_Occurrence_Of (Get_Postcond_Enabled (Scope_Id), Loc), + Then_Statements => New_List ( + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of + (Postconditions_Proc (Scope_Id), Loc))))); end if; -- Ada 2020 (AI12-0279) @@ -7621,6 +7645,9 @@ package body Exp_Ch6 is -- Generate: -- -- Return_Success_For_Postcond := True; + -- if Postcond_Enabled then + -- _Postconditions ([exp]); + -- end if; Insert_Action (Exp, Make_Assignment_Statement (Loc, @@ -7629,13 +7656,20 @@ package body Exp_Ch6 is (Get_Return_Success_For_Postcond (Scope_Id), Loc), Expression => New_Occurrence_Of (Standard_True, Loc))); - -- Generate call to _Postconditions + -- Wrap the call to _postconditions within a test of the + -- Postcond_Enabled flag to delay postcondition evaluation until + -- after finalization when required. Insert_Action (Exp, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (Postconditions_Proc (Scope_Id), Loc), - Parameter_Associations => New_List (New_Copy_Tree (Exp)))); + Make_If_Statement (Loc, + Condition => + New_Occurrence_Of (Get_Postcond_Enabled (Scope_Id), Loc), + Then_Statements => New_List ( + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of + (Postconditions_Proc (Scope_Id), Loc), + Parameter_Associations => New_List (New_Copy_Tree (Exp)))))); end if; -- Ada 2005 (AI-251): If this return statement corresponds with an diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 0315458..7b2676d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3795,7 +3795,9 @@ package body Exp_Ch7 is -- -- Perform postcondition checks after general finalization, but -- -- before finalization of 'Old related objects. -- - -- if not Raised_Finalization_Exception then + -- if not Raised_Finalization_Exception + -- and then Return_Success_For_Postcond + -- then -- begin -- -- Re-enable postconditions and check them -- @@ -3973,7 +3975,9 @@ package body Exp_Ch7 is -- Generate: -- - -- if not Raised_Finalization_Exception then + -- if not Raised_Finalization_Exception + -- and then Return_Success_For_Postcond + -- then -- begin -- Postcond_Enabled := True; -- _postconditions [(Result_Obj_For_Postcond[.all])]; @@ -3988,10 +3992,15 @@ package body Exp_Ch7 is Append_To (Fin_Controller_Stmts, Make_If_Statement (Loc, Condition => - Make_Op_Not (Loc, + Make_And_Then (Loc, + Left_Opnd => + Make_Op_Not (Loc, + Right_Opnd => + New_Occurrence_Of + (Raised_Finalization_Exception_Id, Loc)), Right_Opnd => New_Occurrence_Of - (Raised_Finalization_Exception_Id, Loc)), + (Get_Return_Success_For_Postcond (Def_Ent), Loc)), Then_Statements => New_List ( Make_Block_Statement (Loc, Handled_Statement_Sequence => diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 7647b6d..6e209d4 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -30689,14 +30689,19 @@ package body Sem_Prag is elsif Nkind (Context) = N_Entry_Body then return Context; - -- The pragma appears inside the statements of a subprogram body. This - -- placement is the result of subprogram contract expansion. + -- The pragma appears inside the statements of a subprogram body at + -- some nested level. elsif Is_Statement (Context) and then Present (Enclosing_HSS (Context)) then return Parent (Enclosing_HSS (Context)); + -- The pragma appears directly in the statements of a subprogram body + + elsif Nkind (Context) = N_Handled_Sequence_Of_Statements then + return Parent (Context); + -- The pragma appears inside the declarative part of a package body elsif Nkind (Context) = N_Package_Body then