From: Eric Botcazou <ebotca...@adacore.com> We can now use an extended return statement in all cases since it no longer generates an extra copy for nonlimited by-reference types.
gcc/ada/ * contracts.adb (Build_Subprogram_Contract_Wrapper): Generate an extended return statement in all cases. (Expand_Subprogram_Contract): Adjust comment. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/contracts.adb | 105 ++---------------------------------------- 1 file changed, 5 insertions(+), 100 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 59121ca9ea2..77c231e1d4f 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -30,7 +30,6 @@ with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; -with Exp_Ch6; use Exp_Ch6; with Exp_Prag; use Exp_Prag; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; @@ -1616,40 +1615,8 @@ package body Contracts is -- preserving the result for the purpose of evaluating postconditions, -- contracts, type invariants, etc. - -- In the case of a regular function, generate: + -- In the case of a function, generate: -- - -- function Original_Func (X : in out Integer) return Typ is - -- <prologue renamings> - -- <preconditions> - -- - -- function _Wrapped_Statements return Typ is - -- <original declarations> - -- begin - -- <original statements> - -- end; - -- - -- begin - -- declare - -- type Axx is access all Typ; - -- Rxx : constant Axx := _Wrapped_Statements'reference; - -- Result_Obj : Typ renames Rxx.all; - -- - -- begin - -- <postconditions statments> - -- return Rxx.all; - -- end; - -- end; - -- - -- This sequence is recognized by Expand_Simple_Function_Return as a - -- tail call, in other words equivalent to "return _Wrapped_Statements;" - -- and thus the copy to the anonymous return object is elided, including - -- a pair of calls to Adjust/Finalize for types requiring finalization. - - -- Note that an extended return statement does not yield the same result - -- because the copy of the return object is not elided by GNAT for now. - - -- Or else, in the case of a BIP function, generate: - -- function Original_Func (X : in out Integer) return Typ is -- <prologue renamings> -- <preconditions> @@ -1733,9 +1700,9 @@ package body Contracts is (Handled_Statement_Sequence (Body_Decl), Stmts); -- Generate the post-execution statements and the extended return - -- when the subprogram being wrapped is a BIP function. + -- when the subprogram being wrapped is a function. - elsif Is_Build_In_Place_Result_Type (Ret_Type) then + else Set_Statements (Handled_Statement_Sequence (Body_Decl), New_List ( Make_Extended_Return_Statement (Loc, Return_Object_Declarations => New_List ( @@ -1751,65 +1718,6 @@ package body Contracts is Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts)))); - - -- Declare a renaming of the result of the call to the wrapper and - -- append a return of the result of the call when the subprogram is - -- a function, after manually removing the side effects. Note that - -- we cannot call Remove_Side_Effects here because nothing has been - -- analyzed yet and we cannot return the renaming itself because - -- Expand_Simple_Function_Return expects an explicit dereference. - - else - declare - A_Id : constant Node_Id := Make_Temporary (Loc, 'A'); - R_Id : constant Node_Id := Make_Temporary (Loc, 'R'); - - begin - Set_Statements (Handled_Statement_Sequence (Body_Decl), New_List ( - Make_Block_Statement (Loc, - - Declarations => New_List ( - Make_Full_Type_Declaration (Loc, - Defining_Identifier => A_Id, - Type_Definition => - Make_Access_To_Object_Definition (Loc, - All_Present => True, - Null_Exclusion_Present => True, - Subtype_Indication => - New_Occurrence_Of (Ret_Type, Loc))), - - Make_Object_Declaration (Loc, - Defining_Identifier => R_Id, - Object_Definition => New_Occurrence_Of (A_Id, Loc), - Constant_Present => True, - Expression => - Make_Reference (Loc, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Wrapper_Id, Loc)))), - - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Result, - Subtype_Mark => New_Occurrence_Of (Ret_Type, Loc), - Name => - Make_Explicit_Dereference (Loc, - New_Occurrence_Of (R_Id, Loc)))), - - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stmts)))); - - Append_To (Stmts, - Make_Simple_Return_Statement (Loc, - Expression => - Make_Explicit_Dereference (Loc, - New_Occurrence_Of (R_Id, Loc)))); - - -- It is required for Is_Related_To_Func_Return to return True - -- that the temporary Rxx be related to the expression of the - -- simple return statement built just above. - - Set_Related_Expression (R_Id, Expression (Last (Stmts))); - end; end if; end Build_Subprogram_Contract_Wrapper; @@ -3479,9 +3387,7 @@ package body Contracts is -- end _Wrapped_Statements; -- begin - -- declare - -- Result : ... renames _Wrapped_Statements; - -- begin + -- return Result : constant ... := _Wrapped_Statements do -- <refined postconditions from body> -- <postconditions from body> -- <postconditions from spec> @@ -3489,8 +3395,7 @@ package body Contracts is -- <contract case consequences> -- <invariant check of function result> -- <invariant and predicate checks of parameters - -- return Result; - -- end; + -- end return; -- end Original_Code; -- Step 1: augment contracts list with postconditions associated with -- 2.34.1