diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 50063ed819edb9868ad5a32becd23f52a5c69f53..6fceda3ceff2df24d8241ff8b125548276c0f7be 100644
--- 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;