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

ada: Fix premature finalization of temporaries for interface objects

Browse source 
This restores the proper finalization of temporaries for interface objects
in the case where the initializing expression is not of an interface type.

It turns out that neither Is_Temporary_For_Interface_Object nor its previous
incarnation are sufficient to catch all the various cases, so it is replaced
by a small enhancement to Is_Aliased, which is more robust.

gcc/ada/

	* exp_util.adb (Is_Temporary_For_Interface_Object): Delete.
	(Is_Finalizable_Transient.Is_Aliased): Deal with the specific case
	of temporaries generated for interface objects.
This commit is contained in:
Eric Botcazou 2023-01-06 13:24:18 +01:00 • committed by Marc Poulhiès
parent 1f038e845b
commit 00fdfe9de2
1 changed files with 17 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
gcc/ada/exp_util.adb
View file

@ -168,11 +168,6 @@ package body Exp_Util is
-- Force evaluation of bounds of a slice, which may be given by a range
-- or by a subtype indication with or without a constraint.
function Is_Temporary_For_Interface_Object
(Obj_Id : Entity_Id) return Boolean;
-- Determine whether Obj_Id is a temporary created for the handling of a
-- (class-wide) interface object.
function Is_Uninitialized_Aggregate
(Exp : Node_Id;
T : Entity_Id) return Boolean;
@ -8397,6 +8392,23 @@ package body Exp_Util is
Search (Name (Ren_Decl));
end if;
-- For renamings generated by Expand_N_Object_Declaration to deal
-- with (class-wide) interface objects, there is an intermediate
-- temporary of an anonymous access type used to hold the result
-- of the displacement of the address of the renamed object.
if Present (Ren_Obj)
and then Ekind (Ren_Obj) = E_Constant
and then Is_Itype (Etype (Ren_Obj))
and then Ekind (Etype (Ren_Obj)) = E_Anonymous_Access_Type
and then
Is_Class_Wide_Type (Directly_Designated_Type (Etype (Ren_Obj)))
and then
Is_Interface (Directly_Designated_Type (Etype (Ren_Obj)))
then
Search (Constant_Value (Ren_Obj));
end if;
return Ren_Obj;
end Find_Renamed_Object;
@ -8638,11 +8650,6 @@ package body Exp_Util is
and then not Initialized_By_Aliased_BIP_Func_Call (Obj_Id)
-- Do not consider temporaries created for (class-wide) interface
-- objects because they must exist as long as the object is around.
and then not Is_Temporary_For_Interface_Object (Obj_Id)
-- Do not consider iterators because those are treated as normal
-- controlled objects and are processed by the usual finalization
-- machinery. This avoids the double finalization of an iterator.
@ -9150,24 +9157,6 @@ package body Exp_Util is
and then Has_Controlling_Result (Id);
end Is_Secondary_Stack_Thunk;
---------------------------------------
-- Is_Temporary_For_Interface_Object --
---------------------------------------
function Is_Temporary_For_Interface_Object
(Obj_Id : Entity_Id) return Boolean
is
Expr : constant Node_Id := Expression (Declaration_Node (Obj_Id));
begin
-- This must be kept synchronized with Expand_N_Object_Declaration
return Is_Class_Wide_Type (Etype (Obj_Id))
and then Present (Expr)
and then Nkind (Expr) = N_Unchecked_Type_Conversion
and then Is_RTE (Etype (Expression (Expr)), RE_Tag);
end Is_Temporary_For_Interface_Object;
--------------------------------
-- Is_Uninitialized_Aggregate --
--------------------------------