From: Eric Botcazou <ebotca...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_util.adb | 45 +++++++++++++++++---------------------------
1 file changed, 17 insertions(+), 28 deletions(-)
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index f86b93819ac..da5e84958ca 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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 --
--------------------------------
--
2.34.1
