[gcc r13-7876] ada: Fix wrong finalization for loop on indexed container

[gcc r13-7876] ada: Fix wrong finalization for loop on indexed container

[Eric Botcazou]

https://gcc.gnu.org/g:7d149f954070b65d7b7dd1cd48cc7f8eda01a897

commit r13-7876-g7d149f954070b65d7b7dd1cd48cc7f8eda01a897
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Fri Apr 7 19:17:20 2023 +0200

    ada: Fix wrong finalization for loop on indexed container
    
    The problem is that a transient temporary created for the constant indexing
    of the container is finalized almost immediately after its creation.
    
    gcc/ada/
    
            * exp_util.adb (Is_Finalizable_Transient.Is_Indexed_Container):
            New predicate to detect a temporary created to hold the result of
            a constant indexing on a container.
            (Is_Finalizable_Transient.Is_Iterated_Container): Adjust a couple
            of obsolete comments.
            (Is_Finalizable_Transient): Return False if Is_Indexed_Container
            returns True on the object.

Diff:
---
 gcc/ada/exp_util.adb | 102 +++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 99 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 80c01bf40fd..91e3587d719 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8274,6 +8274,13 @@ package body Exp_Util is
       function Is_Allocated (Trans_Id : Entity_Id) return Boolean;
       --  Determine whether transient object Trans_Id is allocated on the heap
 
+      function Is_Indexed_Container
+        (Trans_Id   : Entity_Id;
+         First_Stmt : Node_Id) return Boolean;
+      --  Determine whether transient object Trans_Id denotes a container which
+      --  is in the process of being indexed in the statement list starting
+      --  from First_Stmt.
+
       function Is_Iterated_Container
         (Trans_Id   : Entity_Id;
          First_Stmt : Node_Id) return Boolean;
@@ -8548,6 +8555,91 @@ package body Exp_Util is
              and then Nkind (Expr) = N_Allocator;
       end Is_Allocated;
 
+      --------------------------
+      -- Is_Indexed_Container --
+      --------------------------
+
+      function Is_Indexed_Container
+        (Trans_Id   : Entity_Id;
+         First_Stmt : Node_Id) return Boolean
+      is
+         Aspect : Node_Id;
+         Call   : Node_Id;
+         Index  : Entity_Id;
+         Param  : Node_Id;
+         Stmt   : Node_Id;
+         Typ    : Entity_Id;
+
+      begin
+         --  It is not possible to iterate over containers in non-Ada 2012 code
+
+         if Ada_Version < Ada_2012 then
+            return False;
+         end if;
+
+         Typ := Etype (Trans_Id);
+
+         --  Handle access type created for the reference below
+
+         if Is_Access_Type (Typ) then
+            Typ := Designated_Type (Typ);
+         end if;
+
+         --  Look for aspect Constant_Indexing. It may be part of a type
+         --  declaration for a container, or inherited from a base type
+         --  or parent type.
+
+         Aspect := Find_Value_Of_Aspect (Typ, Aspect_Constant_Indexing);
+
+         if Present (Aspect) then
+            Index := Entity (Aspect);
+
+            --  Examine the statements following the container object and
+            --  look for a call to the default indexing routine where the
+            --  first parameter is the transient. Such a call appears as:
+
+            --     It : Access_To_Constant_Reference_Type :=
+            --            Constant_Indexing (Tran_Id.all, ...)'reference;
+
+            Stmt := First_Stmt;
+            while Present (Stmt) loop
+
+               --  Detect an object declaration which is initialized by a
+               --  controlled function call.
+
+               if Nkind (Stmt) = N_Object_Declaration
+                 and then Present (Expression (Stmt))
+                 and then Nkind (Expression (Stmt)) = N_Reference
+                 and then Nkind (Prefix (Expression (Stmt))) = N_Function_Call
+               then
+                  Call := Prefix (Expression (Stmt));
+
+                  --  The call must invoke the default indexing routine of
+                  --  the container and the transient object must appear as
+                  --  the first actual parameter. Skip any calls whose names
+                  --  are not entities.
+
+                  if Is_Entity_Name (Name (Call))
+                    and then Entity (Name (Call)) = Index
+                    and then Present (Parameter_Associations (Call))
+                  then
+                     Param := First (Parameter_Associations (Call));
+
+                     if Nkind (Param) = N_Explicit_Dereference
+                       and then Entity (Prefix (Param)) = Trans_Id
+                     then
+                        return True;
+                     end if;
+                  end if;
+               end if;
+
+               Next (Stmt);
+            end loop;
+         end if;
+
+         return False;
+      end Is_Indexed_Container;
+
       ---------------------------
       -- Is_Iterated_Container --
       ---------------------------
@@ -8572,7 +8664,7 @@ package body Exp_Util is
 
          Typ := Etype (Trans_Id);
 
-         --  Handle access type created for secondary stack use
+         --  Handle access type created for the reference below
 
          if Is_Access_Type (Typ) then
             Typ := Designated_Type (Typ);
@@ -8598,7 +8690,7 @@ package body Exp_Util is
             while Present (Stmt) loop
 
                --  Detect an object declaration which is initialized by a
-               --  secondary stack function call.
+               --  controlled function call.
 
                if Nkind (Stmt) = N_Object_Declaration
                  and then Present (Expression (Stmt))
@@ -8717,7 +8809,11 @@ package body Exp_Util is
           --  transient objects must exist for as long as the loop is around,
           --  otherwise any operation carried out by the iterator will fail.
 
-          and then not Is_Iterated_Container (Obj_Id, Decl);
+          and then not Is_Iterated_Container (Obj_Id, Decl)
+
+          --  Likewise for indexed containers in the context of iterator loops
+
+          and then not Is_Indexed_Container (Obj_Id, Decl);
    end Is_Finalizable_Transient;
 
    ---------------------------------