From 8ca25eacaa326022bd2f3e2ffc8a690a9d7363d0 Mon Sep 17 00:00:00 2001
From: Gary Dismukes <dismukes@adacore.com>
Date: Tue, 12 Dec 2023 22:10:37 +0000
Subject: [PATCH] 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.
---
gcc/ada/exp_aggr.adb | 151 ++++++++++++++++++++++---------------------
1 file changed, 77 insertions(+), 74 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 50063ed819ed..6fceda3ceff2 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;
--
GitLab