ada: Excess elements created for indexed aggregates with iterator_specifications

In the case of an indexed aggregate of a container type with both Add_Unnamed
and New_Indexed specified in the Aggregate aspect of the type (such as for
the Vector type in Ada.Containers.Vectors), in cases where a component
association is given by an iterator_specification, the compiler could end
up generating a call to the New_Indexed operation rather than the Empty
operation. For example, in the case of a Vector type, this could result
in allocating a container of the size of the defaulted Capacity formal of
the New_Vector function (with uninitialized components), and elements added
in the aggregate would append to that preallocated Vector. The compiler is
corrected so that the Empty function is called to initialize the implicit
aggregate object, rather than the New_Indexed function.

gcc/ada/

	* exp_aggr.adb (Expand_Container_Aggregate): Add code to determine
	whether the aggregate is an indexed aggregate, setting a flag
	(Is_Indexed_Aggregate), which is tested to have proper separation
	of treatment for the Add_Unnamed
	(for positional aggregates) and New_Indexed (for indexed
	aggregates) cases. In the code generating associations for indexed
	aggregates, remove the code for Expressions cases entirely, since
	the code for indexed aggregates is governed by the presence of
	Component_Associations, and add an assertion that Expressions must
	be Empty. Also, exclude empty aggregates from entering that code.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 50063ed819edb9868ad5a32becd23f52a5c69f53..6fceda3ceff2df24d8241ff8b125548276c0f7be 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6606,6 +6606,8 @@ package body Exp_Aggr is
       Siz_Exp    : Node_Id := Empty;
       Count_Type : Entity_Id;
 
+      Is_Indexed_Aggregate : Boolean := False;
+
       function Aggregate_Size return Int;
       --  Compute number of entries in aggregate, including choices
       --  that cover a range or subtype, as well as iterated constructs.
@@ -7042,6 +7044,35 @@ package body Exp_Aggr is
            ("\this will result in infinite recursion??", Parent (N));
       end if;
 
+      --  Determine whether this is an indexed aggregate (see RM 4.3.5(25/5)).
+
+      if Present (New_Indexed_Subp) then
+         if not Present (Add_Unnamed_Subp) then
+            Is_Indexed_Aggregate := True;
+
+         else
+            declare
+               Comp_Assns : constant List_Id := Component_Associations (N);
+               Comp_Assn  : Node_Id;
+
+            begin
+               if Present (Comp_Assns)
+                 and then not Is_Empty_List (Comp_Assns)
+               then
+                  Comp_Assn := First (Comp_Assns);
+
+                  if Nkind (Comp_Assn) = N_Component_Association
+                    or else
+                      (Nkind (Comp_Assn) = N_Iterated_Component_Association
+                        and then Present (Defining_Identifier (Comp_Assn)))
+                  then
+                     Is_Indexed_Aggregate := True;
+                  end if;
+               end if;
+            end;
+         end if;
+      end if;
+
       ---------------------------
       --  Positional aggregate --
       ---------------------------
@@ -7068,12 +7099,11 @@ package body Exp_Aggr is
                   Next (Comp);
                end loop;
             end;
-         end if;
 
          --  Indexed aggregates are handled below. Unnamed aggregates
          --  such as sets may include iterated component associations.
 
-         if No (New_Indexed_Subp) then
+         elsif not Is_Indexed_Aggregate then
             Comp := First (Component_Associations (N));
             while Present (Comp) loop
                if Nkind (Comp) = N_Iterated_Component_Association then
@@ -7128,15 +7158,16 @@ package body Exp_Aggr is
       -- Indexed_Aggregate --
       -----------------------
 
-      --  For an indexed aggregate there must be an Assigned_Indexeed
+      --  For an indexed aggregate there must be an Assigned_Indexed
       --  subprogram. Note that unlike array aggregates, a container
       --  aggregate must be fully positional or fully indexed. In the
       --  first case the expansion has already taken place.
       --  TBA: the keys for an indexed aggregate must provide a dense
       --  range with no repetitions.
 
-      if Present (Assign_Indexed_Subp)
+      if Is_Indexed_Aggregate
         and then Present (Component_Associations (N))
+        and then not Is_Empty_List (Component_Associations (N))
       then
          declare
             Insert : constant Entity_Id := Entity (Assign_Indexed_Subp);
@@ -7153,7 +7184,6 @@ package body Exp_Aggr is
 
             Comp   : Node_Id;
             Index  : Node_Id;
-            Pos    : Int := 0;
             Stat   : Node_Id;
             Key    : Node_Id;
 
@@ -7196,6 +7226,8 @@ package body Exp_Aggr is
             end Expand_Range_Component;
 
          begin
+            pragma Assert (not Present (Expressions (N)));
+
             if Siz > 0 then
 
                --  Modify the call to the constructor to allocate the
@@ -7216,89 +7248,60 @@ package body Exp_Aggr is
                          Index)));
             end if;
 
-            if Present (Expressions (N)) then
-               Comp := First (Expressions (N));
-
-               while Present (Comp) loop
-
-                  --  Compute index position for successive components
-                  --  in the list of expressions, and use the indexed
-                  --  assignment procedure for each.
-
-                  Index := Make_Op_Add (Loc,
-                    Left_Opnd => Type_Low_Bound (Index_Type),
-                    Right_Opnd => Make_Integer_Literal (Loc, Pos));
-
-                  Stat := Make_Procedure_Call_Statement (Loc,
-                    Name => New_Occurrence_Of (Insert, Loc),
-                    Parameter_Associations =>
-                      New_List (New_Occurrence_Of (Temp, Loc),
-                      Index,
-                      New_Copy_Tree (Comp)));
-
-                  Pos := Pos + 1;
-
-                  Append (Stat, Aggr_Code);
-                  Next (Comp);
-               end loop;
-            end if;
-
-            if Present (Component_Associations (N)) then
-               Comp := First (Component_Associations (N));
-
-               --  The choice may be a static value, or a range with
-               --  static bounds.
+            Comp := First (Component_Associations (N));
 
-               while Present (Comp) loop
-                  if Nkind (Comp) = N_Component_Association then
-                     Key := First (Choices (Comp));
-                     while Present (Key) loop
+            --  The choice may be a static value, or a range with
+            --  static bounds.
 
-                        --  If the expression is a box, the corresponding
-                        --  component (s) is left uninitialized.
+            while Present (Comp) loop
+               if Nkind (Comp) = N_Component_Association then
+                  Key := First (Choices (Comp));
+                  while Present (Key) loop
 
-                        if Box_Present (Comp) then
-                           goto Next_Key;
+                     --  If the expression is a box, the corresponding
+                     --  component (s) is left uninitialized.
 
-                        elsif Nkind (Key) = N_Range then
+                     if Box_Present (Comp) then
+                        goto Next_Key;
 
-                           --  Create loop for tne specified range,
-                           --  with copies of the expression.
+                     elsif Nkind (Key) = N_Range then
 
-                           Stat :=
-                             Expand_Range_Component (Key, Expression (Comp));
+                        --  Create loop for tne specified range,
+                        --  with copies of the expression.
 
-                        else
-                           Stat := Make_Procedure_Call_Statement (Loc,
-                             Name => New_Occurrence_Of
-                                (Entity (Assign_Indexed_Subp), Loc),
-                                Parameter_Associations =>
-                                  New_List (New_Occurrence_Of (Temp, Loc),
-                                  New_Copy_Tree (Key),
-                                  New_Copy_Tree (Expression (Comp))));
-                        end if;
+                        Stat :=
+                          Expand_Range_Component (Key, Expression (Comp));
 
-                        Append (Stat, Aggr_Code);
+                     else
+                        Stat := Make_Procedure_Call_Statement (Loc,
+                          Name => New_Occurrence_Of
+                             (Entity (Assign_Indexed_Subp), Loc),
+                             Parameter_Associations =>
+                               New_List (New_Occurrence_Of (Temp, Loc),
+                               New_Copy_Tree (Key),
+                               New_Copy_Tree (Expression (Comp))));
+                     end if;
 
-                        <<Next_Key>>
-                        Next (Key);
-                     end loop;
+                     Append (Stat, Aggr_Code);
 
-                  else
-                     --  Iterated component association. Discard
-                     --  positional insertion procedure.
+                     <<Next_Key>>
+                     Next (Key);
+                  end loop;
 
-                     if No (Iterator_Specification (Comp)) then
-                        Add_Named_Subp := Assign_Indexed_Subp;
-                        Add_Unnamed_Subp := Empty;
-                     end if;
+               else
+                  --  Iterated component association. Discard
+                  --  positional insertion procedure.
 
-                     Expand_Iterated_Component (Comp);
+                  if No (Iterator_Specification (Comp)) then
+                     Add_Named_Subp := Assign_Indexed_Subp;
+                     Add_Unnamed_Subp := Empty;
                   end if;
 
-                  Next (Comp);
-               end loop;
-            end if;
+                  Expand_Iterated_Component (Comp);
+               end if;
+
+               Next (Comp);
+            end loop;
          end;
       end if;