This patch completes the handling of predefined bounded containers,
including indexed containers with iterated_component_associations. The
size of the constructed object is taken from the size of the aggregate
if it can be determined statically, and otherwise uses the default value
for the given predefined constructor. The patch also adds a static
semantic check that an aggregate for an indexed container is either
fully positional of fully named, unlike array aggregates.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_aggr.adb: (Resolve_Container_Aggregate): For an indexed
container, verify that expressions and component associations
are not both present.
* exp_aggr.adb: Code reorganization, additional comments.
(Expand_Container_Aggregate): Use Aggregate_Size for Iterated_
Component_Associations for indexed aggregates. If present, the
default value of the formal in the constructor function is used
when the size of the aggregate cannot be determined statically.diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6909,7 +6909,15 @@ package body Exp_Aggr is
Comp : Node_Id;
Decl : Node_Id;
+ Default : Node_Id;
Init_Stat : Node_Id;
+ Siz : Int;
+
+ function Aggregate_Size return Int;
+ -- Compute number of entries in aggregate, including choices
+ -- that cover a range, as well as iterated constructs.
+ -- Return -1 if the size is not known statically, in which case
+ -- we allocate a default size for the aggregate.
procedure Expand_Iterated_Component (Comp : Node_Id);
-- Handle iterated_component_association and iterated_Element
@@ -6917,6 +6925,86 @@ package body Exp_Aggr is
-- given either by a loop parameter specification or an iterator
-- specification.
+ --------------------
+ -- Aggregate_Size --
+ --------------------
+
+ function Aggregate_Size return Int is
+ Comp : Node_Id;
+ Choice : Node_Id;
+ Lo, Hi : Node_Id;
+ Siz : Int := 0;
+
+ procedure Add_Range_Size;
+ -- Compute size of component association given by
+ -- range or subtype name.
+
+ procedure Add_Range_Size is
+ begin
+ if Nkind (Lo) = N_Integer_Literal then
+ Siz := Siz + UI_To_Int (Intval (Hi))
+ - UI_To_Int (Intval (Lo)) + 1;
+ end if;
+ end Add_Range_Size;
+
+ begin
+ if Present (Expressions (N)) then
+ Siz := List_Length (Expressions (N));
+ end if;
+
+ if Present (Component_Associations (N)) then
+ Comp := First (Component_Associations (N));
+ while Present (Comp) loop
+ Choice := First (Choice_List (Comp));
+
+ while Present (Choice) loop
+ Analyze (Choice);
+
+ if Nkind (Choice) = N_Range then
+ Lo := Low_Bound (Choice);
+ Hi := High_Bound (Choice);
+ if Nkind (Lo) /= N_Integer_Literal
+ or else Nkind (Hi) /= N_Integer_Literal
+ then
+ return -1;
+ else
+ Add_Range_Size;
+ end if;
+
+ elsif Is_Entity_Name (Choice)
+ and then Is_Type (Entity (Choice))
+ then
+ Lo := Type_Low_Bound (Entity (Choice));
+ Hi := Type_High_Bound (Entity (Choice));
+ if Nkind (Lo) /= N_Integer_Literal
+ or else Nkind (Hi) /= N_Integer_Literal
+ then
+ return -1;
+ else
+ Add_Range_Size;
+ end if;
+
+ Rewrite (Choice,
+ Make_Range (Loc,
+ New_Copy_Tree (Lo),
+ New_Copy_Tree (Hi)));
+
+ else
+ -- Single choice (syntax excludes a subtype
+ -- indication).
+
+ Siz := Siz + 1;
+ end if;
+
+ Next (Choice);
+ end loop;
+ Next (Comp);
+ end loop;
+ end if;
+
+ return Siz;
+ end Aggregate_Size;
+
-------------------------------
-- Expand_Iterated_Component --
-------------------------------
@@ -7040,35 +7128,78 @@ package body Exp_Aggr is
end Expand_Iterated_Component;
+ -- Start of processing for Expand_Container_Aggregate
+
begin
Parse_Aspect_Aggregate (Asp,
Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp,
New_Indexed_Subp, Assign_Indexed_Subp);
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Temp,
- Object_Definition => New_Occurrence_Of (Typ, Loc));
-
- Insert_Action (N, Decl);
- if Ekind (Entity (Empty_Subp)) = E_Function then
- Init_Stat := Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Temp, Loc),
- Expression => Make_Function_Call (Loc,
- Name => New_Occurrence_Of (Entity (Empty_Subp), Loc)));
- else
- Init_Stat := Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Temp, Loc),
- Expression => New_Occurrence_Of (Entity (Empty_Subp), Loc));
+
+ -- The constructor for bounded containers is a function with
+ -- a parameter that sets the size of the container. If the
+ -- size cannot be determined statically we use a default value.
+
+ Siz := Aggregate_Size;
+ if Siz < 0 then
+ Siz := 10;
end if;
- Append (Init_Stat, Aggr_Code);
+ if Ekind (Entity (Empty_Subp)) = E_Function
+ and then Present (First_Formal (Entity (Empty_Subp)))
+ then
+ Default := Default_Value (First_Formal (Entity (Empty_Subp)));
+ -- If aggregate size is not static, use default value of
+ -- formal parameter for allocation. We assume that this
+ -- (implementation-dependent) value is static, even though
+ -- the AI does not require it ???.
+
+ if Siz < 0 then
+ Siz := UI_To_Int (Intval (Default));
+ end if;
+
+ Init_Stat :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp,
+ Object_Definition => New_Occurrence_Of (Typ, Loc),
+ Expression => Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Entity (Empty_Subp), Loc),
+ Parameter_Associations =>
+ New_List (Make_Integer_Literal (Loc, Siz))));
+
+ Append (Init_Stat, Aggr_Code);
+
+ -- Use default value when aggregate size is not static.
+
+ else
+ Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp,
+ Object_Definition => New_Occurrence_Of (Typ, Loc));
+
+ Insert_Action (N, Decl);
+ if Ekind (Entity (Empty_Subp)) = E_Function then
+ Init_Stat := Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Temp, Loc),
+ Expression => Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Entity (Empty_Subp), Loc)));
+ else
+ Init_Stat := Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Temp, Loc),
+ Expression => New_Occurrence_Of (Entity (Empty_Subp), Loc));
+ end if;
+
+ Append (Init_Stat, Aggr_Code);
+ end if;
---------------------------
-- Positional aggregate --
---------------------------
+ -- If the aggregate is positional the aspect must include
+ -- an Add_Unnamed subprogram.
+
if Present (Add_Unnamed_Subp)
- and then No (Assign_Indexed_Subp)
+ and then No (Component_Associations (N))
then
if Present (Expressions (N)) then
declare
@@ -7137,21 +7268,25 @@ package body Exp_Aggr is
Next (Comp);
end loop;
end;
+ end if;
-----------------------
-- Indexed_Aggregate --
-----------------------
- elsif Present (Assign_Indexed_Subp) then
+ -- For an indexed aggregate there must be an Assigned_Indexeed
+ -- 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.
+
+ if Present (Assign_Indexed_Subp)
+ and then Present (Component_Associations (N))
+ then
declare
Insert : constant Entity_Id := Entity (Assign_Indexed_Subp);
Index_Type : constant Entity_Id :=
Etype (Next_Formal (First_Formal (Insert)));
- function Aggregate_Size return Int;
- -- Compute number of entries in aggregate, including choices
- -- that cover a range, as well as iterated constructs.
-
function Expand_Range_Component
(Rng : Node_Id;
Expr : Node_Id) return Node_Id;
@@ -7165,7 +7300,6 @@ package body Exp_Aggr is
Pos : Int := 0;
Stat : Node_Id;
Key : Node_Id;
- Size : Int := 0;
-----------------------------
-- Expand_Raange_Component --
@@ -7205,74 +7339,8 @@ package body Exp_Aggr is
Statements => Stats);
end Expand_Range_Component;
- --------------------
- -- Aggregate_Size --
- --------------------
-
- function Aggregate_Size return Int is
- Comp : Node_Id;
- Choice : Node_Id;
- Lo, Hi : Node_Id;
- Siz : Int := 0;
-
- procedure Add_Range_Size;
- -- Compute size of component association given by
- -- range or subtype name.
-
- procedure Add_Range_Size is
- begin
- if Nkind (Lo) = N_Integer_Literal then
- Siz := Siz + UI_To_Int (Intval (Hi))
- - UI_To_Int (Intval (Lo)) + 1;
- end if;
- end Add_Range_Size;
-
- begin
- if Present (Expressions (N)) then
- Siz := List_Length (Expressions (N));
- end if;
-
- if Present (Component_Associations (N)) then
- Comp := First (Component_Associations (N));
- while Present (Comp) loop
- Choice := First (Choices (Comp));
-
- while Present (Choice) loop
- Analyze (Choice);
-
- if Nkind (Choice) = N_Range then
- Lo := Low_Bound (Choice);
- Hi := High_Bound (Choice);
- Add_Range_Size;
-
- elsif Is_Entity_Name (Choice)
- and then Is_Type (Entity (Choice))
- then
- Lo := Type_Low_Bound (Entity (Choice));
- Hi := Type_High_Bound (Entity (Choice));
- Add_Range_Size;
- Rewrite (Choice,
- Make_Range (Loc,
- New_Copy_Tree (Lo),
- New_Copy_Tree (Hi)));
-
- else
- Resolve (Choice, Index_Type);
- Siz := Siz + 1;
- end if;
-
- Next (Choice);
- end loop;
- Next (Comp);
- end loop;
- end if;
-
- return Siz;
- end Aggregate_Size;
-
begin
- Size := Aggregate_Size;
- if Size > 0 then
+ if Siz > 0 then
-- Modify the call to the constructor to allocate the
-- required size for the aggregwte : call the provided
@@ -7280,7 +7348,7 @@ package body Exp_Aggr is
Index := Make_Op_Add (Loc,
Left_Opnd => New_Copy_Tree (Type_Low_Bound (Index_Type)),
- Right_Opnd => Make_Integer_Literal (Loc, Size - 1));
+ Right_Opnd => Make_Integer_Literal (Loc, Siz - 1));
Set_Expression (Init_Stat,
Make_Function_Call (Loc,
@@ -7359,9 +7427,16 @@ package body Exp_Aggr is
<<Next_Key>>
Next (Key);
end loop;
+
else
- Error_Msg_N ("iterated associations peding", N);
+ -- Iterated component association. Discard
+ -- positional insertion procedure.
+
+ Add_Named_Subp := Assign_Indexed_Subp;
+ Add_Unnamed_Subp := Empty;
+ Expand_Iterated_Component (Comp);
end if;
+
Next (Comp);
end loop;
end if;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2930,9 +2930,9 @@ package body Sem_Aggr is
end;
else
- -- Indexed Aggregate. Both positional and indexed component
- -- can be present. Choices must be static values or ranges
- -- with static bounds.
+ -- Indexed Aggregate. Positional or indexed component
+ -- can be present, but not both. Choices must be static
+ -- values or ranges with static bounds.
declare
Container : constant Entity_Id :=
@@ -2953,6 +2953,12 @@ package body Sem_Aggr is
end if;
if Present (Component_Associations (N)) then
+ if Present (Expressions (N)) then
+ Error_Msg_N ("Container aggregate cannot be "
+ & "both positional and named", N);
+ return;
+ end if;
+
Comp := First (Expressions (N));
while Present (Comp) loop
