From: Eric Botcazou <ebotca...@adacore.com> The return object is incorrectly finalized when the nested return is taken, because the special flag attached to the return object is not updated.
gcc/ada/ * exp_ch6.adb (Build_Flag_For_Function): New function made up of the code building the special flag for return object present... (Expand_N_Extended_Return_Statement): ...in there. Replace the code with a call to Build_Flag_For_Function. Add assertion for the flag. (Expand_Non_Function_Return): For a nested return, if the return object needs finalization actions, update the special flag. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch6.adb | 148 +++++++++++++++++++++++++++++--------------- 1 file changed, 98 insertions(+), 50 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index d4802402670..a2b5cdcfa8e 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -194,6 +194,10 @@ package body Exp_Ch6 is -- the activation Chain. Note: Master_Actual can be Empty, but only if -- there are no tasks. + function Build_Flag_For_Function (Func_Id : Entity_Id) return Entity_Id; + -- Generate code to declare a boolean flag initialized to False in the + -- function Func_Id and return the entity for the flag. + function Caller_Known_Size (Func_Call : Node_Id; Result_Subt : Entity_Id) return Boolean; @@ -909,6 +913,53 @@ package body Exp_Ch6 is end if; end BIP_Suffix_Kind; + ----------------------------- + -- Build_Flag_For_Function -- + ----------------------------- + + function Build_Flag_For_Function (Func_Id : Entity_Id) return Entity_Id is + Flag_Decl : Node_Id; + Flag_Id : Entity_Id; + Func_Bod : Node_Id; + Loc : Source_Ptr; + + begin + -- Recover the function body + + Func_Bod := Unit_Declaration_Node (Func_Id); + + if Nkind (Func_Bod) = N_Subprogram_Declaration then + Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod))); + end if; + + if Nkind (Func_Bod) = N_Function_Specification then + Func_Bod := Parent (Func_Bod); -- one more level for child units + end if; + + pragma Assert (Nkind (Func_Bod) = N_Subprogram_Body); + + Loc := Sloc (Func_Bod); + + -- Create a flag to track the function state + + Flag_Id := Make_Temporary (Loc, 'F'); + + -- Insert the flag at the beginning of the function declarations, + -- generate: + -- Fnn : Boolean := False; + + Flag_Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Flag_Id, + Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc), + Expression => New_Occurrence_Of (Standard_False, Loc)); + + Prepend_To (Declarations (Func_Bod), Flag_Decl); + Analyze (Flag_Decl); + + return Flag_Id; + end Build_Flag_For_Function; + --------------------------- -- Build_In_Place_Formal -- --------------------------- @@ -5615,49 +5666,14 @@ package body Exp_Ch6 is -- perform the appropriate cleanup should it fail to return. The state -- of the function itself is tracked through a flag which is coupled -- with the scope finalizer. There is one flag per each return object - -- in case of multiple returns. - - if Needs_Finalization (Etype (Ret_Obj_Id)) then - declare - Flag_Decl : Node_Id; - Flag_Id : Entity_Id; - Func_Bod : Node_Id; - - begin - -- Recover the function body - - Func_Bod := Unit_Declaration_Node (Func_Id); - - if Nkind (Func_Bod) = N_Subprogram_Declaration then - Func_Bod := Parent (Parent (Corresponding_Body (Func_Bod))); - end if; - - if Nkind (Func_Bod) = N_Function_Specification then - Func_Bod := Parent (Func_Bod); -- one more level for child units - end if; - - pragma Assert (Nkind (Func_Bod) = N_Subprogram_Body); - - -- Create a flag to track the function state - - Flag_Id := Make_Temporary (Loc, 'F'); - Set_Status_Flag_Or_Transient_Decl (Ret_Obj_Id, Flag_Id); + -- in case of multiple extended returns. Note that the flag has already + -- been created if the extended return contains a nested return. - -- Insert the flag at the beginning of the function declarations, - -- generate: - -- Fnn : Boolean := False; - - Flag_Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Flag_Id, - Object_Definition => - New_Occurrence_Of (Standard_Boolean, Loc), - Expression => - New_Occurrence_Of (Standard_False, Loc)); - - Prepend_To (Declarations (Func_Bod), Flag_Decl); - Analyze (Flag_Decl); - end; + if Needs_Finalization (Etype (Ret_Obj_Id)) + and then No (Status_Flag_Or_Transient_Decl (Ret_Obj_Id)) + then + Set_Status_Flag_Or_Transient_Decl + (Ret_Obj_Id, Build_Flag_For_Function (Func_Id)); end if; -- Build a simple_return_statement that returns the return object when @@ -5722,6 +5738,8 @@ package body Exp_Ch6 is Status_Flag_Or_Transient_Decl (Ret_Obj_Id); begin + pragma Assert (Present (Flag_Id)); + -- Generate: -- Fnn := True; @@ -6387,14 +6405,44 @@ package body Exp_Ch6 is -- return of the previously declared return object. elsif Kind = E_Return_Statement then - Rewrite (N, - Make_Simple_Return_Statement (Loc, - Expression => - New_Occurrence_Of (First_Entity (Scope_Id), Loc))); - Set_Comes_From_Extended_Return_Statement (N); - Set_Return_Statement_Entity (N, Scope_Id); - Expand_Simple_Function_Return (N); - return; + declare + Ret_Obj_Id : constant Entity_Id := First_Entity (Scope_Id); + + Flag_Id : Entity_Id; + + begin + -- Apply the same processing as Expand_N_Extended_Return_Statement + -- if the returned object needs finalization actions. Note that we + -- are invoked before Expand_N_Extended_Return_Statement but there + -- may be multiple nested returns within the extended one. + + if Needs_Finalization (Etype (Ret_Obj_Id)) then + if Present (Status_Flag_Or_Transient_Decl (Ret_Obj_Id)) then + Flag_Id := Status_Flag_Or_Transient_Decl (Ret_Obj_Id); + else + Flag_Id := + Build_Flag_For_Function (Return_Applies_To (Scope_Id)); + Set_Status_Flag_Or_Transient_Decl (Ret_Obj_Id, Flag_Id); + end if; + + -- Generate: + -- Fnn := True; + + Insert_Action (N, + Make_Assignment_Statement (Loc, + Name => + New_Occurrence_Of (Flag_Id, Loc), + Expression => New_Occurrence_Of (Standard_True, Loc))); + end if; + + Rewrite (N, + Make_Simple_Return_Statement (Loc, + Expression => New_Occurrence_Of (Ret_Obj_Id, Loc))); + Set_Comes_From_Extended_Return_Statement (N); + Set_Return_Statement_Entity (N, Scope_Id); + Expand_Simple_Function_Return (N); + return; + end; end if; pragma Assert (Is_Entry (Scope_Id)); -- 2.42.0