[gcc r13-5207] ada: Fix premature finalization of temporaries for interface objects

[Marc Poulhi?s <dkm@gcc.gnu.org>]

https://gcc.gnu.org/g:00fdfe9de2e2205330f312364b3b60fca3005b61

commit r13-5207-g00fdfe9de2e2205330f312364b3b60fca3005b61
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Fri Jan 6 13:24:18 2023 +0100

    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.

Diff:
---
 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 --
    --------------------------------