[COMMITTED 10/30] ada: Another small cleanup about allocators and aggregates

["Marc Poulhiès" <poulhies@adacore.com>]

From: Eric Botcazou <ebotcazou@adacore.com>

This eliminates a few more oddities present in the expander for allocators
and aggregates nested in allocators and other constructs:

  - Convert_Aggr_In_Allocator takes both the N_Allocator and the aggregate
    as parameters, while the sibling procedures Convert_Aggr_In_Assignment
    and Convert_Aggr_In_Object_Decl only take the former.  This changes the
    first to be consistent with the two others and propagates the change to
    Convert_Array_Aggr_In_Allocator.

  - Convert_Aggr_In_Object_Decl contains an awkward code structure with a
    useless inner block statement.

  - In_Place_Assign_OK and Convert_To_Assignments have some declarations of
    local variables not in the right place.

No functional changes (presumably).

gcc/ada/

	* exp_aggr.ads (Convert_Aggr_In_Allocator): Remove Aggr parameter
	and adjust description.
	(Convert_Aggr_In_Object_Decl): Adjust description.
	* exp_aggr.adb (Convert_Aggr_In_Allocator): Remove Aggr parameter
	and add local variable of the same name instead.  Adjust call to
	Convert_Array_Aggr_In_Allocator.
	(Convert_Aggr_In_Object_Decl): Add comment for early return and
	remove useless inner block statement.
	(Convert_Array_Aggr_In_Allocator):  Remove Aggr parameter and add
	local variable of the same name instead.
	(In_Place_Assign_OK): Move down declarations of local variables.
	(Convert_To_Assignments): Put all declarations of local variables
	in the same place.  Fix typo in comment.  Replace T with Full_Typ.
	* exp_ch4.adb (Expand_Allocator_Expression): Call Unqualify instead
	of Expression on the qualified expression of the allocator for the
	sake of consistency.  Adjust call to Convert_Aggr_In_Allocator.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_aggr.adb | 188 +++++++++++++++++++++----------------------
 gcc/ada/exp_aggr.ads |  18 ++---
 gcc/ada/exp_ch4.adb  |   4 +-
 3 files changed, 104 insertions(+), 106 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 2476675604c..8a3d1685cb3 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -282,10 +282,7 @@ package body Exp_Aggr is
    --    Indexes is the current list of expressions used to index the object we
    --    are writing into.
 
-   procedure Convert_Array_Aggr_In_Allocator
-     (N      : Node_Id;
-      Aggr   : Node_Id;
-      Target : Node_Id);
+   procedure Convert_Array_Aggr_In_Allocator (N : Node_Id; Target : Node_Id);
    --  If the aggregate appears within an allocator and can be expanded in
    --  place, this routine generates the individual assignments to components
    --  of the designated object. This is an optimization over the general
@@ -3543,11 +3540,8 @@ package body Exp_Aggr is
    -- Convert_Aggr_In_Allocator --
    -------------------------------
 
-   procedure Convert_Aggr_In_Allocator
-     (N    : Node_Id;
-      Aggr : Node_Id;
-      Temp : Entity_Id)
-   is
+   procedure Convert_Aggr_In_Allocator (N : Node_Id; Temp : Entity_Id) is
+      Aggr : constant Node_Id    := Unqualify (Expression (N));
       Loc  : constant Source_Ptr := Sloc (Aggr);
       Typ  : constant Entity_Id  := Etype (Aggr);
 
@@ -3557,7 +3551,7 @@ package body Exp_Aggr is
 
    begin
       if Is_Array_Type (Typ) then
-         Convert_Array_Aggr_In_Allocator (N, Aggr, Occ);
+         Convert_Array_Aggr_In_Allocator (N, Occ);
 
       elsif Has_Default_Init_Comps (Aggr) then
          declare
@@ -3605,12 +3599,9 @@ package body Exp_Aggr is
       Aggr : constant Node_Id    := Unqualify (Expression (N));
       Loc  : constant Source_Ptr := Sloc (Aggr);
       Typ  : constant Entity_Id  := Etype (Aggr);
-      Occ  : constant Node_Id    := New_Occurrence_Of (Obj, Loc);
-
-      Has_Transient_Scope : Boolean := False;
 
       function Discriminants_Ok return Boolean;
-      --  If the object type is constrained, the discriminants in the
+      --  If the object's subtype is constrained, the discriminants in the
       --  aggregate must be checked against the discriminants of the subtype.
       --  This cannot be done using Apply_Discriminant_Checks because after
       --  expansion there is no aggregate left to check.
@@ -3677,10 +3668,19 @@ package body Exp_Aggr is
          return True;
       end Discriminants_Ok;
 
+      --  Local variables
+
+      Has_Transient_Scope : Boolean;
+      Occ                 : Node_Id;
+      Param               : Node_Id;
+      Stmt                : Node_Id;
+      Stmts               : List_Id;
+
    --  Start of processing for Convert_Aggr_In_Object_Decl
 
    begin
-      Set_Assignment_OK (Occ);
+      --  First generate discriminant checks if need be, and bail out if one
+      --  of them fails statically.
 
       if Has_Discriminants (Typ)
         and then Typ /= Etype (Obj)
@@ -3706,61 +3706,59 @@ package body Exp_Aggr is
       then
          Establish_Transient_Scope (Aggr, Manage_Sec_Stack => False);
          Has_Transient_Scope := True;
+      else
+         Has_Transient_Scope := False;
       end if;
 
-      declare
-         Stmts : constant List_Id := Late_Expansion (Aggr, Typ, Occ);
-         Stmt  : Node_Id;
-         Param : Node_Id;
+      Occ := New_Occurrence_Of (Obj, Loc);
+      Set_Assignment_OK (Occ);
+      Stmts := Late_Expansion (Aggr, Typ, Occ);
 
-      begin
-         --  If Obj is already frozen or if N is wrapped in a transient scope,
-         --  Stmts do not need to be saved in Initialization_Statements since
-         --  there is no freezing issue.
+      --  If Obj is already frozen or if N is wrapped in a transient scope,
+      --  Stmts do not need to be saved in Initialization_Statements since
+      --  there is no freezing issue.
 
-         if Is_Frozen (Obj) or else Has_Transient_Scope then
-            Insert_Actions_After (N, Stmts);
-         else
-            Stmt := Make_Compound_Statement (Sloc (N), Actions => Stmts);
-            Insert_Action_After (N, Stmt);
+      if Is_Frozen (Obj) or else Has_Transient_Scope then
+         Insert_Actions_After (N, Stmts);
 
-            --  Insert_Action_After may freeze Obj in which case we should
-            --  remove the compound statement just created and simply insert
-            --  Stmts after N.
+      else
+         Stmt := Make_Compound_Statement (Sloc (N), Actions => Stmts);
+         Insert_Action_After (N, Stmt);
 
-            if Is_Frozen (Obj) then
-               Remove (Stmt);
-               Insert_Actions_After (N, Stmts);
-            else
-               Set_Initialization_Statements (Obj, Stmt);
-            end if;
-         end if;
+         --  Insert_Action_After may freeze Obj in which case we should
+         --  remove the compound statement just created and simply insert
+         --  Stmts after N.
 
-         --  If Typ has controlled components and a call to a Slice_Assign
-         --  procedure is part of the initialization statements, then we
-         --  need to initialize the array component since Slice_Assign will
-         --  need to adjust it.
+         if Is_Frozen (Obj) then
+            Remove (Stmt);
+            Insert_Actions_After (N, Stmts);
 
-         if Has_Controlled_Component (Typ) then
-            Stmt := First (Stmts);
+         else
+            Set_Initialization_Statements (Obj, Stmt);
+         end if;
+      end if;
 
-            while Present (Stmt) loop
-               if Nkind (Stmt) = N_Procedure_Call_Statement
-                 and then Is_TSS (Entity (Name (Stmt)), TSS_Slice_Assign)
-               then
-                  Param := First (Parameter_Associations (Stmt));
-                  Insert_Actions
-                    (Stmt,
-                     Build_Initialization_Call (N,
-                       New_Copy_Tree (Param), Etype (Param)));
-               end if;
+      --  If Typ has controlled components and a call to a Slice_Assign
+      --  procedure is part of the initialization statements, then we
+      --  need to initialize the array component since Slice_Assign will
+      --  need to adjust it.
 
-               Next (Stmt);
-            end loop;
-         end if;
-      end;
+      if Has_Controlled_Component (Typ) then
+         Stmt := First (Stmts);
 
-      Set_No_Initialization (N);
+         while Present (Stmt) loop
+            if Nkind (Stmt) = N_Procedure_Call_Statement
+              and then Is_TSS (Entity (Name (Stmt)), TSS_Slice_Assign)
+            then
+               Param := First (Parameter_Associations (Stmt));
+               Insert_Actions (Stmt,
+                 Build_Initialization_Call (N,
+                   New_Copy_Tree (Param), Etype (Param)));
+            end if;
+
+            Next (Stmt);
+         end loop;
+      end if;
 
       --  After expansion the expression can be removed from the declaration
       --  except if the object is class-wide, in which case the aggregate
@@ -3770,6 +3768,8 @@ package body Exp_Aggr is
          Set_Expression (N, Empty);
       end if;
 
+      Set_No_Initialization (N);
+
       Initialize_Discriminants (N, Typ);
    end Convert_Aggr_In_Object_Decl;
 
@@ -3777,13 +3777,11 @@ package body Exp_Aggr is
    -- Convert_Array_Aggr_In_Allocator --
    -------------------------------------
 
-   procedure Convert_Array_Aggr_In_Allocator
-     (N      : Node_Id;
-      Aggr   : Node_Id;
-      Target : Node_Id)
-   is
-      Typ       : constant Entity_Id := Etype (Aggr);
-      Ctyp      : constant Entity_Id := Component_Type (Typ);
+   procedure Convert_Array_Aggr_In_Allocator (N : Node_Id; Target : Node_Id) is
+      Aggr : constant Node_Id   := Unqualify (Expression (N));
+      Typ  : constant Entity_Id := Etype (Aggr);
+      Ctyp : constant Entity_Id := Component_Type (Typ);
+
       Aggr_Code : List_Id;
       New_Aggr  : Node_Id;
 
@@ -3846,13 +3844,6 @@ package body Exp_Aggr is
    is
       Is_Array : constant Boolean := Is_Array_Type (Etype (N));
 
-      Aggr_In     : Node_Id;
-      Aggr_Bounds : Range_Nodes;
-      Obj_In      : Node_Id;
-      Obj_Bounds  : Range_Nodes;
-      Parent_Kind : Node_Kind;
-      Parent_Node : Node_Id;
-
       function Safe_Aggregate (Aggr : Node_Id) return Boolean;
       --  Check recursively that each component of a (sub)aggregate does not
       --  depend on the variable being assigned to.
@@ -4106,6 +4097,15 @@ package body Exp_Aggr is
          end if;
       end Safe_Component;
 
+      --  Local variables
+
+      Aggr_In     : Node_Id;
+      Aggr_Bounds : Range_Nodes;
+      Obj_In      : Node_Id;
+      Obj_Bounds  : Range_Nodes;
+      Parent_Kind : Node_Kind;
+      Parent_Node : Node_Id;
+
    --  Start of processing for In_Place_Assign_OK
 
    begin
@@ -4214,16 +4214,16 @@ package body Exp_Aggr is
    ----------------------------
 
    procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is
-      Loc  : constant Source_Ptr := Sloc (N);
-      T    : Entity_Id;
-      Temp : Entity_Id;
+      Loc : constant Source_Ptr := Sloc (N);
 
       Aggr_Code   : List_Id;
+      Full_Typ    : Entity_Id;
       Instr       : Node_Id;
-      Target_Expr : Node_Id;
       Parent_Kind : Node_Kind;
-      Unc_Decl    : Boolean := False;
       Parent_Node : Node_Id;
+      Target_Expr : Node_Id;
+      Temp        : Entity_Id;
+      Unc_Decl    : Boolean := False;
 
    begin
       pragma Assert (Nkind (N) in N_Aggregate | N_Extension_Aggregate);
@@ -4275,7 +4275,7 @@ package body Exp_Aggr is
 
          or else (Parent_Kind = N_Object_Declaration and then not Unc_Decl)
 
-         --  Safe assignment (see Convert_Aggr_Assignments). So far only the
+         --  Safe assignment (see Convert_Aggr_In_Assignment). So far only the
          --  assignments in init procs are taken into account.
 
          or else (Parent_Kind = N_Assignment_Statement
@@ -4304,14 +4304,12 @@ package body Exp_Aggr is
          Establish_Transient_Scope (N, Manage_Sec_Stack => False);
       end if;
 
-      --  If the aggregate is nonlimited, create a temporary, since aggregates
-      --  have "by copy" semantics. If it is limited and context is an
-      --  assignment, this is a subaggregate for an enclosing aggregate being
-      --  expanded. It must be built in place, so use target of the current
-      --  assignment.
+      --  If the context is an assignment and the aggregate is limited, this
+      --  is a subaggregate of an enclosing aggregate being expanded; it must
+      --  be built in place, so use the target of the current assignment.
 
-      if Is_Limited_Type (Typ)
-        and then Parent_Kind = N_Assignment_Statement
+      if Parent_Kind = N_Assignment_Statement
+        and then Is_Limited_Type (Typ)
       then
          Target_Expr := New_Copy_Tree (Name (Parent_Node));
          Insert_Actions (Parent_Node,
@@ -4320,7 +4318,7 @@ package body Exp_Aggr is
 
       --  Do not declare a temporary to initialize an aggregate assigned to
       --  a target when in-place assignment is possible, i.e. preserving the
-      --  by-copy semantic of aggregates. This avoids large stack usage and
+      --  by-copy semantics of aggregates. This avoids large stack usage and
       --  generates more efficient code.
 
       elsif Parent_Kind = N_Assignment_Statement
@@ -4345,6 +4343,8 @@ package body Exp_Aggr is
             end if;
          end;
 
+      --  Otherwise, create a temporary since aggregates have by-copy semantics
+
       else
          Temp := Make_Temporary (Loc, 'A', N);
 
@@ -4354,35 +4354,35 @@ package body Exp_Aggr is
          if Has_Unknown_Discriminants (Typ)
            and then Present (Underlying_Record_View (Typ))
          then
-            T := Underlying_Record_View (Typ);
+            Full_Typ := Underlying_Record_View (Typ);
          else
-            T := Typ;
+            Full_Typ := Typ;
          end if;
 
          Instr :=
            Make_Object_Declaration (Loc,
              Defining_Identifier => Temp,
-             Object_Definition   => New_Occurrence_Of (T, Loc));
+             Object_Definition   => New_Occurrence_Of (Full_Typ, Loc));
 
          Set_No_Initialization (Instr);
          Insert_Action (N, Instr);
-         Initialize_Discriminants (Instr, T);
+         Initialize_Discriminants (Instr, Full_Typ);
 
          Target_Expr := New_Occurrence_Of (Temp, Loc);
-         Aggr_Code   := Build_Record_Aggr_Code (N, T, Target_Expr);
+         Aggr_Code   := Build_Record_Aggr_Code (N, Full_Typ, Target_Expr);
 
          --  Save the last assignment statement associated with the aggregate
          --  when building a controlled object. This reference is utilized by
          --  the finalization machinery when marking an object as successfully
          --  initialized.
 
-         if Needs_Finalization (T) then
+         if Needs_Finalization (Full_Typ) then
             Set_Last_Aggregate_Assignment (Temp, Last (Aggr_Code));
          end if;
 
          Insert_Actions (N, Aggr_Code);
          Rewrite (N, New_Occurrence_Of (Temp, Loc));
-         Analyze_And_Resolve (N, T);
+         Analyze_And_Resolve (N, Full_Typ);
       end if;
    end Convert_To_Assignments;
 
diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads
index 30765efe944..a9eb0518d7a 100644
--- a/gcc/ada/exp_aggr.ads
+++ b/gcc/ada/exp_aggr.ads
@@ -31,14 +31,12 @@ package Exp_Aggr is
    procedure Expand_N_Delta_Aggregate     (N : Node_Id);
    procedure Expand_N_Extension_Aggregate (N : Node_Id);
 
-   procedure Convert_Aggr_In_Allocator
-     (N    : Node_Id;
-      Aggr : Node_Id;
-      Temp : Entity_Id);
-   --  N is an N_Allocator whose (ultimate) expression is the aggregate Aggr.
+   procedure Convert_Aggr_In_Allocator (N : Node_Id; Temp : Entity_Id);
+   --  N is an N_Allocator whose (ultimate) expression must be an N_Aggregate
+   --  or N_Extension_Aggregate with Expansion_Delayed.
    --  This procedure performs an in-place aggregate assignment into an object
-   --  allocated with the subtype of Aggr and designated by Temp, so that N
-   --  can be rewritten as a mere occurrence of Temp.
+   --  allocated with the subtype of the aggregate and designated by Temp, so
+   --  that N can be rewritten as a mere occurrence of Temp.
 
    procedure Convert_Aggr_In_Assignment (N : Node_Id);
    --  If the right-hand side of an assignment is an aggregate, expand the
@@ -48,9 +46,9 @@ package Exp_Aggr is
    --  backend.
 
    procedure Convert_Aggr_In_Object_Decl (N : Node_Id);
-   --  N is an N_Object_Declaration with an expression which must be an
-   --  N_Aggregate or N_Extension_Aggregate with Expansion_Delayed.
-   --  This procedure performs in-place aggregate assignment.
+   --  N is an N_Object_Declaration whose expression must be an N_Aggregate or
+   --  N_Extension_Aggregate with Expansion_Delayed.
+   --  This procedure performs an in-place aggregate assignment.
 
    function Is_Delayed_Aggregate (N : Node_Id) return Boolean;
    --  Returns True if N is an aggregate of some kind whose Expansion_Delayed
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 29249eb4c18..69a042115c9 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -555,7 +555,7 @@ package body Exp_Ch4 is
 
    procedure Expand_Allocator_Expression (N : Node_Id) is
       Loc            : constant Source_Ptr := Sloc (N);
-      Exp            : constant Node_Id    := Expression (Expression (N));
+      Exp            : constant Node_Id    := Unqualify (Expression (N));
       Indic          : constant Node_Id    := Subtype_Mark (Expression (N));
       T              : constant Entity_Id  := Entity (Indic);
       PtrT           : constant Entity_Id  := Etype (N);
@@ -595,7 +595,7 @@ package body Exp_Ch4 is
          --  Insert the declaration and generate the in-place assignment
 
          Insert_Action (N, Temp_Decl);
-         Convert_Aggr_In_Allocator (N, Exp, Temp);
+         Convert_Aggr_In_Allocator (N, Temp);
       end Build_Aggregate_In_Place;
 
       --  Local variables
-- 
2.43.2