[COMMITTED] ada: Fix premature finalization of temporaries for interface objects

[COMMITTED] ada: Fix premature finalization of temporaries for interface objects

[Marc Poulhiès]

From: Eric Botcazou <ebotcazou@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