ada: Small cleanup about allocators and aggregates

This eliminates a few oddities present in the expander for allocators and
aggregates present in allocators:

  - Convert_Array_Aggr_In_Allocator takes both a Decl and Alloc parameters,
    and inserts new code before Alloc for records and after Decl for arrays
    through Convert_Array_Aggr_In_Allocator.  Now, for the 3 (duplicated)
    calls to the procedure, that's the same place.  It also creates a new
    list that it does not use in most cases.

  - Expand_Allocator_Expression uses the same code sequence in 3 places
    when the expression is an aggregate to build in place.

  - Build_Allocate_Deallocate_Proc takes an Is_Allocate parameter that is
    entirely determined by the N parameter: if N is an allocator, it must
    be true; if N is a free statement, it must be false.  Barring that,
    the procedure either raises an assertion or Program_Error.  It also
    contains useless pattern matching code in the second part.

No functional changes.

gcc/ada/

	* exp_aggr.ads (Convert_Aggr_In_Allocator): Rename Alloc into N,
	replace Decl with Temp and adjust description.
	(Convert_Aggr_In_Object_Decl): Alphabetize.
	(Is_Delayed_Aggregate): Likewise.
	* exp_aggr.adb (Convert_Aggr_In_Allocator): Rename Alloc into N
	and replace Decl with Temp.  Allocate a list only when neeeded.
	(Convert_Array_Aggr_In_Allocator): Replace N with Decl and insert
	new code before it.
	* exp_ch4.adb (Build_Aggregate_In_Place): New procedure nested in
	Expand_Allocator_Expression.
	(Expand_Allocator_Expression): Call it to build aggregates in place.
	Remove second parameter in calls to Build_Allocate_Deallocate_Proc.
	(Expand_N_Allocator): Likewise.
	* exp_ch13.adb (Expand_N_Free_Statement): Likewise.
	* exp_util.ads (Build_Allocate_Deallocate_Proc): Remove Is_Allocate
	parameter.
	* exp_util.adb (Build_Allocate_Deallocate_Proc): Remove Is_Allocate
	parameter and replace it with local variable of same name.  Delete
	useless pattern matching.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index a4e4d81f0a8f7b5df1aef7d948fa104896aaf9bc..27a7f3d2b49548e7b692717db141caaf2180fd46 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -283,7 +283,7 @@ package body Exp_Aggr is
    --    are writing into.
 
    procedure Convert_Array_Aggr_In_Allocator
-     (Decl   : Node_Id;
+     (N      : Node_Id;
       Aggr   : Node_Id;
       Target : Node_Id);
    --  If the aggregate appears within an allocator and can be expanded in
@@ -3542,13 +3542,12 @@ package body Exp_Aggr is
    -------------------------------
 
    procedure Convert_Aggr_In_Allocator
-     (Alloc :  Node_Id;
-      Decl  :  Node_Id;
-      Aggr  :  Node_Id)
+     (N    : Node_Id;
+      Aggr : Node_Id;
+      Temp : Entity_Id)
    is
       Loc  : constant Source_Ptr := Sloc (Aggr);
       Typ  : constant Entity_Id  := Etype (Aggr);
-      Temp : constant Entity_Id  := Defining_Identifier (Decl);
 
       Occ  : constant Node_Id :=
         Unchecked_Convert_To (Typ,
@@ -3556,26 +3555,29 @@ package body Exp_Aggr is
 
    begin
       if Is_Array_Type (Typ) then
-         Convert_Array_Aggr_In_Allocator (Decl, Aggr, Occ);
+         Convert_Array_Aggr_In_Allocator (N, Aggr, Occ);
 
       elsif Has_Default_Init_Comps (Aggr) then
          declare
-            L          : constant List_Id := New_List;
-            Init_Stmts : List_Id;
+            Init_Stmts : constant List_Id := Late_Expansion (Aggr, Typ, Occ);
 
          begin
-            Init_Stmts := Late_Expansion (Aggr, Typ, Occ);
-
             if Has_Task (Typ) then
-               Build_Task_Allocate_Block (L, Aggr, Init_Stmts);
-               Insert_Actions (Alloc, L);
+               declare
+                  Actions : constant List_Id := New_List;
+
+               begin
+                  Build_Task_Allocate_Block (Actions, Aggr, Init_Stmts);
+                  Insert_Actions (N, Actions);
+               end;
+
             else
-               Insert_Actions (Alloc, Init_Stmts);
+               Insert_Actions (N, Init_Stmts);
             end if;
          end;
 
       else
-         Insert_Actions (Alloc, Late_Expansion (Aggr, Typ, Occ));
+         Insert_Actions (N, Late_Expansion (Aggr, Typ, Occ));
       end if;
    end Convert_Aggr_In_Allocator;
 
@@ -3774,7 +3776,7 @@ package body Exp_Aggr is
    -------------------------------------
 
    procedure Convert_Array_Aggr_In_Allocator
-     (Decl   : Node_Id;
+     (N      : Node_Id;
       Aggr   : Node_Id;
       Target : Node_Id)
    is
@@ -3829,7 +3831,7 @@ package body Exp_Aggr is
              Scalar_Comp => Is_Scalar_Type (Ctyp));
       end if;
 
-      Insert_Actions_After (Decl, Aggr_Code);
+      Insert_Actions (N, Aggr_Code);
    end Convert_Array_Aggr_In_Allocator;
 
    ------------------------

diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads
index 0b92e98370a04fa96b1136a6a048b6b5b4b771e4..30765efe944c597b3757114f70dea056d198160b 100644 (file)
--- a/gcc/ada/exp_aggr.ads
+++ b/gcc/ada/exp_aggr.ads
@@ -31,24 +31,14 @@ package Exp_Aggr is
    procedure Expand_N_Delta_Aggregate     (N : Node_Id);
    procedure Expand_N_Extension_Aggregate (N : Node_Id);
 
-   function Is_Delayed_Aggregate (N : Node_Id) return Boolean;
-   --  Returns True if N is an aggregate of some kind whose Expansion_Delayed
-   --  flag is set (see sinfo for meaning of flag).
-
-   procedure Convert_Aggr_In_Object_Decl (N : Node_Id);
-   --  N is a 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.
-
    procedure Convert_Aggr_In_Allocator
-     (Alloc : Node_Id;
-      Decl  : Node_Id;
-      Aggr  : Node_Id);
-   --  Alloc is the allocator whose expression is the aggregate Aggr.
-   --  Decl is an N_Object_Declaration created during allocator expansion.
-   --  This procedure performs in-place aggregate assignment into the
-   --  temporary declared in Decl, and the allocator becomes an access to
-   --  that temporary.
+     (N    : Node_Id;
+      Aggr : Node_Id;
+      Temp : Entity_Id);
+   --  N is an N_Allocator whose (ultimate) expression is the aggregate Aggr.
+   --  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.
 
    procedure Convert_Aggr_In_Assignment (N : Node_Id);
    --  If the right-hand side of an assignment is an aggregate, expand the
@@ -57,6 +47,15 @@ package Exp_Aggr is
    --  the components, and the aggregate cannot be handled as a whole by the
    --  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.
+
+   function Is_Delayed_Aggregate (N : Node_Id) return Boolean;
+   --  Returns True if N is an aggregate of some kind whose Expansion_Delayed
+   --  flag is set (see sinfo for meaning of flag).
+
    function Static_Array_Aggregate (N : Node_Id) return Boolean;
    --  N is an array aggregate that may have a component association with
    --  an others clause and a range. If bounds are static and the expressions

diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 6399524a517c0ad80e4149629c3fbe14deec3423..2d5ee9b6e80347b7df5e8f150ebff41da93a627d 100644 (file)
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -380,7 +380,7 @@ package body Exp_Ch13 is
       --  ensures that the hidden list header will be deallocated along with
       --  the actual object.
 
-      Build_Allocate_Deallocate_Proc (N, Is_Allocate => False);
+      Build_Allocate_Deallocate_Proc (N);
    end Expand_N_Free_Statement;
 
    ----------------------------

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d8895d648d4c0470ccbcc49a283059f8eabd2d08..342828aa6724d527d669836666c72d64023ea7e8 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -562,6 +562,45 @@ package body Exp_Ch4 is
       DesigT         : constant Entity_Id  := Designated_Type (PtrT);
       Special_Return : constant Boolean    := For_Special_Return_Object (N);
 
+      procedure Build_Aggregate_In_Place (Temp : Entity_Id; Typ : Entity_Id);
+      --  If Exp is an aggregate to build in place, build the declaration of
+      --  Temp with Typ and with expression an uninitialized allocator for
+      --  Etype (Exp), then perform an in-place aggregate assignment of Exp
+      --  into the allocated memory.
+
+      ------------------------------
+      -- Build_Aggregate_In_Place --
+      ------------------------------
+
+      procedure Build_Aggregate_In_Place (Temp : Entity_Id; Typ : Entity_Id) is
+         Temp_Decl : constant Node_Id :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Temp,
+             Object_Definition   => New_Occurrence_Of (Typ, Loc),
+             Expression          =>
+               Make_Allocator (Loc,
+                 Expression => New_Occurrence_Of (Etype (Exp), Loc)));
+
+      begin
+         --  Prevent default initialization of the allocator
+
+         Set_No_Initialization (Expression (Temp_Decl));
+
+         --  Copy the Comes_From_Source flag onto the allocator since logically
+         --  this allocator is a replacement of the original allocator. This is
+         --  for proper handling of restriction No_Implicit_Heap_Allocations.
+
+         Preserve_Comes_From_Source (Expression (Temp_Decl), N);
+
+         --  Insert declaration, assignment and build the allocation procedure
+
+         Insert_Action (N, Temp_Decl);
+         Convert_Aggr_In_Allocator (N, Exp, Temp);
+         Build_Allocate_Deallocate_Proc (Temp_Decl);
+      end Build_Aggregate_In_Place;
+
+      --  Local variables
+
       Adj_Call      : Node_Id;
       Aggr_In_Place : Boolean;
       Node          : Node_Id;
@@ -753,28 +792,7 @@ package body Exp_Ch4 is
 
          if not Is_Interface (DesigT) then
             if Aggr_In_Place then
-               Temp_Decl :=
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Temp,
-                   Object_Definition   => New_Occurrence_Of (PtrT, Loc),
-                   Expression          =>
-                     Make_Allocator (Loc,
-                       Expression =>
-                         New_Occurrence_Of (Etype (Exp), Loc)));
-
-               --  Copy the Comes_From_Source flag for the allocator we just
-               --  built, since logically this allocator is a replacement of
-               --  the original allocator node. This is for proper handling of
-               --  restriction No_Implicit_Heap_Allocations.
-
-               Preserve_Comes_From_Source
-                 (Expression (Temp_Decl), N);
-
-               Set_No_Initialization (Expression (Temp_Decl));
-               Insert_Action (N, Temp_Decl);
-
-               Build_Allocate_Deallocate_Proc (Temp_Decl, True);
-               Convert_Aggr_In_Allocator (N, Temp_Decl, Exp);
+               Build_Aggregate_In_Place (Temp, PtrT);
 
             else
                Node := Relocate_Node (N);
@@ -788,7 +806,7 @@ package body Exp_Ch4 is
                    Expression          => Node);
 
                Insert_Action (N, Temp_Decl);
-               Build_Allocate_Deallocate_Proc (Temp_Decl, True);
+               Build_Allocate_Deallocate_Proc (Temp_Decl);
             end if;
 
          --  Ada 2005 (AI-251): Handle allocators whose designated type is an
@@ -827,27 +845,7 @@ package body Exp_Ch4 is
                --  Declare the object using the previous type declaration
 
                if Aggr_In_Place then
-                  Temp_Decl :=
-                    Make_Object_Declaration (Loc,
-                      Defining_Identifier => Temp,
-                      Object_Definition   => New_Occurrence_Of (Def_Id, Loc),
-                      Expression          =>
-                        Make_Allocator (Loc,
-                          New_Occurrence_Of (Etype (Exp), Loc)));
-
-                  --  Copy the Comes_From_Source flag for the allocator we just
-                  --  built, since logically this allocator is a replacement of
-                  --  the original allocator node. This is for proper handling
-                  --  of restriction No_Implicit_Heap_Allocations.
-
-                  Set_Comes_From_Source
-                    (Expression (Temp_Decl), Comes_From_Source (N));
-
-                  Set_No_Initialization (Expression (Temp_Decl));
-                  Insert_Action (N, Temp_Decl);
-
-                  Build_Allocate_Deallocate_Proc (Temp_Decl, True);
-                  Convert_Aggr_In_Allocator (N, Temp_Decl, Exp);
+                  Build_Aggregate_In_Place (Temp, Def_Id);
 
                else
                   Node := Relocate_Node (N);
@@ -861,7 +859,7 @@ package body Exp_Ch4 is
                       Expression          => Node);
 
                   Insert_Action (N, Temp_Decl);
-                  Build_Allocate_Deallocate_Proc (Temp_Decl, True);
+                  Build_Allocate_Deallocate_Proc (Temp_Decl);
                end if;
 
                --  Generate an additional object containing the address of the
@@ -992,28 +990,7 @@ package body Exp_Ch4 is
         or else (Modify_Tree_For_C and then Nkind (Exp) = N_Aggregate)
       then
          Temp := Make_Temporary (Loc, 'P', N);
-         Temp_Decl :=
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Temp,
-             Object_Definition   => New_Occurrence_Of (PtrT, Loc),
-             Expression          =>
-               Make_Allocator (Loc,
-                 Expression => New_Occurrence_Of (Etype (Exp), Loc)));
-
-         --  Copy the Comes_From_Source flag for the allocator we just built,
-         --  since logically this allocator is a replacement of the original
-         --  allocator node. This is for proper handling of restriction
-         --  No_Implicit_Heap_Allocations.
-
-         Set_Comes_From_Source
-           (Expression (Temp_Decl), Comes_From_Source (N));
-
-         Set_No_Initialization (Expression (Temp_Decl));
-         Insert_Action (N, Temp_Decl);
-
-         Build_Allocate_Deallocate_Proc (Temp_Decl, True);
-         Convert_Aggr_In_Allocator (N, Temp_Decl, Exp);
-
+         Build_Aggregate_In_Place (Temp, PtrT);
          Rewrite (N, New_Occurrence_Of (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
 
@@ -1041,7 +1018,7 @@ package body Exp_Ch4 is
          end if;
 
       else
-         Build_Allocate_Deallocate_Proc (N, True);
+         Build_Allocate_Deallocate_Proc (N);
 
          --  For an access-to-unconstrained-packed-array type, build an
          --  expression with a constrained subtype in order for the code
@@ -2589,7 +2566,7 @@ package body Exp_Ch4 is
          end if;
       end To_Ityp;
 
-      --  Local Declarations
+      --  Local variables
 
       Opnd_Typ   : Entity_Id;
       Slice_Rng  : Node_Id;
@@ -4626,7 +4603,7 @@ package body Exp_Ch4 is
       --  the context requires it.
 
       elsif No_Initialization (N) then
-         Build_Allocate_Deallocate_Proc (N, True);
+         Build_Allocate_Deallocate_Proc (N);
 
       --  If the allocator is for a type which requires initialization, and
       --  there is no initial value (i.e. operand is a subtype indication
@@ -4685,7 +4662,7 @@ package body Exp_Ch4 is
                    Expression          => Relocate_Node (N));
 
                Insert_Action (N, Temp_Decl, Suppress => All_Checks);
-               Build_Allocate_Deallocate_Proc (Temp_Decl, True);
+               Build_Allocate_Deallocate_Proc (Temp_Decl);
 
                --  Generate:
                --    Temp.all := ...
@@ -4822,7 +4799,7 @@ package body Exp_Ch4 is
                    Expression          => Relocate_Node (N));
 
                Insert_Action (N, Temp_Decl, Suppress => All_Checks);
-               Build_Allocate_Deallocate_Proc (Temp_Decl, True);
+               Build_Allocate_Deallocate_Proc (Temp_Decl);
 
                --  If the designated type is a task type or contains tasks,
                --  create a specific block to activate the created tasks.
@@ -4875,7 +4852,7 @@ package body Exp_Ch4 is
             --  No initialization required
 
             else
-               Build_Allocate_Deallocate_Proc (N, True);
+               Build_Allocate_Deallocate_Proc (N);
             end if;
          end if;
       end if;

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index d9623e2ea40a123a1ffdc0961750185617128598..d3d0132cfd8b158db441458dc72307215e05effb 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -721,10 +721,9 @@ package body Exp_Util is
    -- Build_Allocate_Deallocate_Proc --
    ------------------------------------
 
-   procedure Build_Allocate_Deallocate_Proc
-     (N           : Node_Id;
-      Is_Allocate : Boolean)
-   is
+   procedure Build_Allocate_Deallocate_Proc (N : Node_Id) is
+      Is_Allocate : constant Boolean := Nkind (N) /= N_Free_Statement;
+
       function Find_Object (E : Node_Id) return Node_Id;
       --  Given an arbitrary expression of an allocator, try to find an object
       --  reference in it, otherwise return the original expression.
@@ -827,14 +826,9 @@ package body Exp_Util is
    --  Start of processing for Build_Allocate_Deallocate_Proc
 
    begin
-      --  Obtain the attributes of the allocation / deallocation
-
-      if Nkind (N) = N_Free_Statement then
-         Expr := Expression (N);
-         Ptr_Typ := Base_Type (Etype (Expr));
-         Proc_To_Call := Procedure_To_Call (N);
+      --  Obtain the attributes of the allocation
 
-      else
+      if Is_Allocate then
          if Nkind (N) = N_Object_Declaration then
             Expr := Expression (N);
          else
@@ -862,7 +856,7 @@ package body Exp_Util is
            and then Nkind (Parent (Entity (Expr))) = N_Object_Declaration
            and then Nkind (Expression (Parent (Entity (Expr)))) = N_Allocator
          then
-            Build_Allocate_Deallocate_Proc (Parent (Entity (Expr)), True);
+            Build_Allocate_Deallocate_Proc (Parent (Entity (Expr)));
             return;
          end if;
 
@@ -870,6 +864,13 @@ package body Exp_Util is
 
          Ptr_Typ := Base_Type (Etype (Expr));
          Proc_To_Call := Procedure_To_Call (Expr);
+
+      --  Obtain the attributes of the deallocation
+
+      else
+         Expr := Expression (N);
+         Ptr_Typ := Base_Type (Etype (Expr));
+         Proc_To_Call := Procedure_To_Call (N);
       end if;
 
       Pool_Id := Associated_Storage_Pool (Ptr_Typ);
@@ -968,7 +969,6 @@ package body Exp_Util is
          Size_Id : constant Entity_Id := Make_Temporary (Loc, 'S');
 
          Actuals      : List_Id;
-         Alloc_Nod    : Node_Id := Empty;
          Alloc_Expr   : Node_Id := Empty;
          Fin_Addr_Id  : Entity_Id;
          Fin_Coll_Act : Node_Id;
@@ -981,29 +981,11 @@ package body Exp_Util is
          --  node for later processing and calculation of alignment.
 
          if Is_Allocate then
-
-            if Nkind (Expr) = N_Allocator then
-               Alloc_Nod := Expr;
-
-            --  When Expr is an object declaration we have to examine its
-            --  expression.
-
-            elsif Nkind (Expr) = N_Object_Declaration
-              and then Nkind (Expression (Expr)) = N_Allocator
-            then
-               Alloc_Nod := Expression (Expr);
-
-            --  Otherwise, we raise an error because we should have found one
-
-            else
-               raise Program_Error;
-            end if;
-
             --  Extract the qualified expression if there is one from the
             --  allocator.
 
-            if Nkind (Expression (Alloc_Nod)) = N_Qualified_Expression then
-               Alloc_Expr := Expression (Alloc_Nod);
+            if Nkind (Expression (Expr)) = N_Qualified_Expression then
+               Alloc_Expr := Expression (Expr);
             end if;
          end if;
 

diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 3fd3a151ddbe93fc5cc9e447d7f99132a20b474f..4e7a4bba2cf1ab24beda7ce80f324ecbf656ccf1 100644 (file)
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -234,9 +234,7 @@ package Exp_Util is
    --  Return the static value of a statically known attribute reference
    --  Pref'Constrained.
 
-   procedure Build_Allocate_Deallocate_Proc
-     (N           : Node_Id;
-      Is_Allocate : Boolean);
+   procedure Build_Allocate_Deallocate_Proc (N : Node_Id);
    --  Create a custom Allocate/Deallocate to be associated with an allocation
    --  or deallocation:
    --
@@ -246,8 +244,7 @@ package Exp_Util is
    --
    --  N must be an allocator or the declaration of a temporary variable which
    --  represents the expression of the original allocator node, otherwise N
-   --  must be a free statement. If flag Is_Allocate is set, the generated
-   --  routine is allocate, deallocate otherwise.
+   --  must be a free statement.
 
    function Build_Abort_Undefer_Block
      (Loc     : Source_Ptr;