[gcc r12-4123] [Ada] Fix resolution of Declare_Expressions involving transient scopes

[gcc r12-4123] [Ada] Fix resolution of Declare_Expressions involving transient scopes

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:f729943cf65ec9d475acccc5d04d7752680e19a3

commit r12-4123-gf729943cf65ec9d475acccc5d04d7752680e19a3
Author: Ed Schonberg <schonberg@adacore.com>
Date:   Mon Aug 30 17:41:29 2021 -0400

    [Ada] Fix resolution of Declare_Expressions involving transient scopes
    
    gcc/ada/
    
            * sem_res.adb (Resolve_Declare_Expression): Use tree traversals
            to perform name capture of local entities in the expression of
            the construct.
            * exp_util.adb (Possible_Side_Effects_In_SPARK): Do not apply to
            the prefix of an attribute reference Reduce when that prefix is
            an aggregate, because it will be expanded into a loop, and has
            no identifiable type.

Diff:
---
 gcc/ada/exp_util.adb |   5 +++
 gcc/ada/sem_res.adb  | 108 ++++++++++++++++++++++++++++-----------------------
 2 files changed, 64 insertions(+), 49 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 4a301e20624..c0966fb0b96 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -11737,10 +11737,15 @@ package body Exp_Util is
       --  case and it is better not to make an additional one for the attribute
       --  itself, because the return type of many of them is universal integer,
       --  which is a very large type for a temporary.
+      --  The prefix of an attribute reference Reduce may be syntactically an
+      --  aggregate, but will be expanded into a loop, so no need to remove
+      --  side-effects.
 
       if Nkind (Exp) = N_Attribute_Reference
         and then Side_Effect_Free_Attribute (Attribute_Name (Exp))
         and then Side_Effect_Free (Expressions (Exp), Name_Req, Variable_Ref)
+        and then (Attribute_Name (Exp) /= Name_Reduce
+                   or else Nkind (Prefix (Exp)) /= N_Aggregate)
         and then not Is_Name_Reference (Prefix (Exp))
       then
          Remove_Side_Effects (Prefix (Exp), Name_Req, Variable_Ref);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ec2d5ec353f..4dc3827acba 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7487,66 +7487,76 @@ package body Sem_Res is
      (N   : Node_Id;
       Typ : Entity_Id)
    is
-      Decl                 : Node_Id;
-      Need_Transient_Scope : Boolean := False;
-   begin
-      --  Install the scope created for local declarations, if
-      --  any. The syntax allows a Declare_Expression with no
-      --  declarations, in analogy with block statements.
-      --  Note that that scope has no explicit declaration, but
-      --  appears as the scope of all entities declared therein.
+      Expr : constant Node_Id := Expression (N);
 
-      Decl := First (Actions (N));
-      while Present (Decl) loop
-         exit when Nkind (Decl)
-                     in N_Object_Declaration | N_Object_Renaming_Declaration;
-         Next (Decl);
-      end loop;
+      Decl  : Node_Id;
+      Local : Entity_Id := Empty;
 
-      if Present (Decl) then
+      function Replace_Local (N  : Node_Id) return Traverse_Result;
+      --  Use a tree traversal to replace each ocurrence of the name of
+      --  a local object declared in the construct, with the corresponding
+      --  entity. This replaces the usual way to perform name capture by
+      --  visibility, because it is not possible to place on the scope
+      --  stack the fake scope created for the analysis of the local
+      --  declarations; such a scope conflicts with the transient scopes
+      --  that may be generated if the expression includes function calls
+      --  requiring finalization.
 
-         --  Need to establish a transient scope in case Expression (N)
-         --  requires actions to be wrapped.
+      -------------------
+      -- Replace_Local --
+      -------------------
 
-         declare
-            Node : Node_Id;
-         begin
-            Node := First (Actions (N));
-            while Present (Node) loop
-               if Nkind (Node) = N_Object_Declaration
-                 and then Requires_Transient_Scope
-                            (Etype (Defining_Identifier (Node)))
-               then
-                  Need_Transient_Scope := True;
-                  exit;
-               end if;
+      function Replace_Local (N  : Node_Id) return Traverse_Result is
+      begin
+         --  The identifier may be the prefix of a selected component,
+         --  but not a selector name, because the local entities do not
+         --  have a scope that can be named: a selected component whose
+         --  selector is a homonym of a local entity must denote some
+         --  global entity.
+
+         if Nkind (N) = N_Identifier
+           and then Chars (N) = Chars (Local)
+           and then No (Entity (N))
+           and then
+             (Nkind (Parent (N)) /= N_Selected_Component
+               or else N = Prefix (Parent (N)))
+         then
+            Set_Entity (N, Local);
+            Set_Etype (N, Etype (Local));
+         end if;
 
-               Next (Node);
-            end loop;
-         end;
+         return OK;
+      end Replace_Local;
 
-         if Need_Transient_Scope then
-            Establish_Transient_Scope (Decl, Manage_Sec_Stack => True);
-         else
-            Push_Scope (Scope (Defining_Identifier (Decl)));
+      procedure Replace_Local_Ref is new Traverse_Proc (Replace_Local);
+
+      --  Start of processing for  Resolve_Declare_Expression
+
+   begin
+
+      Decl := First (Actions (N));
+
+      while Present (Decl) loop
+         if Nkind (Decl) in
+            N_Object_Declaration | N_Object_Renaming_Declaration
+              and then Comes_From_Source (Defining_Identifier (Decl))
+         then
+            Local := Defining_Identifier (Decl);
+            Replace_Local_Ref (Expr);
          end if;
 
-         declare
-            E : Entity_Id := First_Entity (Current_Scope);
-         begin
-            while Present (E) loop
-               Set_Current_Entity (E);
-               Set_Is_Immediately_Visible (E);
-               Next_Entity (E);
-            end loop;
-         end;
+         Next (Decl);
+      end loop;
 
-         Resolve (Expression (N), Typ);
-         End_Scope;
+      --  The end of the declarative list is a freeze point for the
+      --  local declarations.
 
-      else
-         Resolve (Expression (N), Typ);
+      if Present (Local) then
+         Decl := Parent (Local);
+         Freeze_All (First_Entity (Scope (Local)), Decl);
       end if;
+
+      Resolve (Expr, Typ);
    end Resolve_Declare_Expression;
 
    -----------------------------------------