FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

ada: Fix premature finalization for nested return within extended one

Browse source 
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.
This commit is contained in:
Eric Botcazou 2023-11-08 23:29:01 +01:00 • committed by Marc Poulhiès
parent d2f2b9e6f9
commit f6bbf84ec7
1 changed files with 98 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

148
gcc/ada/exp_ch6.adb
View file

@ -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.
-- in case of multiple extended returns. Note that the flag has already
-- been created if the extended return contains a nested return.
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);
-- 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));