ada: Fix premature finalization of temporaries for interface objects

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.

1 files changed, 17 insertions, 28 deletions

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index f86b938..da5e849 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 --
    --------------------------------