[COMMITTED] ada: Fix premature finalization for nested return within extended one
Checks
Commit Message
From: Eric Botcazou <ebotcazou@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(-)
@@ -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));