https://gcc.gnu.org/g:b7e10f86d5cbd95ac38a1141f3e0a95424ede281
commit r15-9772-gb7e10f86d5cbd95ac38a1141f3e0a95424ede281
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Fri Jan 24 10:26:13 2025 +0100
ada: Implement built-in-place expansion of two-pass array aggregates
These are array aggregates containing only component associations that are
iterated with iterator specifications, as per RM 4.3.3(20.2/5-20.4/5).
It is implemented for the array aggregates that are used to initialize an
object, as specified by RM 7.6(17.2/3-17.3/3) for immutably limited types
and types that need finalization, but for all types like other aggregates.
gcc/ada/ChangeLog:
* exp_aggr.adb (Build_Two_Pass_Aggr_Code): New function containing
most of the code initially present in Two_Pass_Aggregate_Expansion.
(Two_Pass_Aggregate_Expansion): Remove redundant N parameter.
Implement built-in-place expansion for (static) object declarations
and allocators, using Build_Two_Pass_Aggr_Code for the main work.
(Expand_Array_Aggregate): Adjust Two_Pass_Aggregate_Expansion call.
Replace Etype (N) by Typ in a couple of places.
* exp_ch3.adb (Expand_Freeze_Array_Type): Remove special case for
two-pass array aggregates.
(Expand_N_Object_Declaration): Do not adjust the object when it is
initialized by a two-pass array aggregate.
* exp_ch4.adb (Expand_Allocator_Expression): Apply the processing
used for container aggregates to two-pass array aggregates.
* exp_ch6.adb (Validate_Subprogram_Calls): Skip calls present in
initialization expressions of N_Object_Declaration nodes that have
No_Initialization set.
* sem_ch3.adb (Analyze_Object_Declaration): Detect the cases of an
array originally initialized by an aggregate consistently.
Diff:
---
gcc/ada/exp_aggr.adb | 498 +++++++++++++++++++++++++++++++--------------------
gcc/ada/exp_ch3.adb | 11 +-
gcc/ada/exp_ch4.adb | 13 +-
gcc/ada/exp_ch6.adb | 7 +
gcc/ada/sem_ch3.adb | 11 +-
5 files changed, 324 insertions(+), 216 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 3c4576df3b83..f2e7ad76e98f 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4956,6 +4956,14 @@ package body Exp_Aggr is
-- type using the computable sizes of the aggregate and its sub-
-- aggregates.
+ function Build_Two_Pass_Aggr_Code
+ (Lhs : Node_Id;
+ Aggr_Typ : out Entity_Id) return List_Id;
+ -- The aggregate consists only of iterated associations and Lhs is an
+ -- expression containing the location of the anonymous object, which
+ -- may be built in place. Returns the dynamic subtype of the aggregate
+ -- in Aggr_Typ and the list of statements needed to build it.
+
procedure Check_Bounds (Aggr_Bounds_Node, Index_Bounds_Node : Node_Id);
-- Checks that the bounds of Aggr_Bounds are within the bounds defined
-- by Index_Bounds. For null array aggregate (Ada 2022) check that the
@@ -4983,7 +4991,7 @@ package body Exp_Aggr is
-- built directly into the target of an assignment, the target must
-- be free of side effects. N is the target of the assignment.
- procedure Two_Pass_Aggregate_Expansion (N : Node_Id);
+ procedure Two_Pass_Aggregate_Expansion;
-- If the aggregate consists only of iterated associations then the
-- aggregate is constructed in two steps:
-- a) Build an expression to compute the number of elements
@@ -5053,6 +5061,221 @@ package body Exp_Aggr is
Freeze_Itype (Agg_Type, N);
end Build_Constrained_Type;
+ ------------------------------
+ -- Build_Two_Pass_Aggr_Code --
+ ------------------------------
+
+ function Build_Two_Pass_Aggr_Code
+ (Lhs : Node_Id;
+ Aggr_Typ : out Entity_Id) return List_Id
+ is
+ Index_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N);
+ Index_Type : constant Entity_Id := Etype (First_Index (Typ));
+ Index_Base : constant Entity_Id := Base_Type (Index_Type);
+ Size_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N);
+ Size_Type : constant Entity_Id :=
+ Integer_Type_For
+ (Esize (Index_Base), Is_Unsigned_Type (Index_Base));
+
+ Assoc : Node_Id;
+ Incr : Node_Id;
+ Iter : Node_Id;
+ New_Comp : Node_Id;
+ One_Loop : Node_Id;
+ Iter_Id : Entity_Id;
+
+ Aggr_Code : List_Id;
+ Size_Expr_Code : List_Id;
+
+ begin
+ Size_Expr_Code := New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Size_Id,
+ Object_Definition => New_Occurrence_Of (Size_Type, Loc),
+ Expression => Make_Integer_Literal (Loc, 0)));
+
+ -- First pass: execute the iterators to count the number of elements
+ -- that will be generated.
+
+ Assoc := First (Component_Associations (N));
+ while Present (Assoc) loop
+ Iter := Iterator_Specification (Assoc);
+ Iter_Id := Defining_Identifier (Iter);
+ Incr :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Size_Id, Loc),
+ Expression =>
+ Make_Op_Add (Loc,
+ Left_Opnd => New_Occurrence_Of (Size_Id, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, 1)));
+
+ -- Avoid using the same iterator definition in both loops by
+ -- creating a new iterator for each loop and mapping it over the
+ -- original iterator references.
+
+ One_Loop :=
+ Make_Implicit_Loop_Statement (N,
+ Iteration_Scheme =>
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification =>
+ New_Copy_Tree (Iter,
+ Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))),
+ Statements => New_List (Incr));
+
+ Append (One_Loop, Size_Expr_Code);
+ Next (Assoc);
+ end loop;
+
+ Insert_Actions (N, Size_Expr_Code);
+
+ -- Build a constrained subtype with the bounds deduced from
+ -- the size computed above and declare the aggregate object.
+ -- The index type is some discrete type, so the bounds of the
+ -- constrained subtype are computed as T'Val (integer bounds).
+
+ declare
+ -- Pos_Lo := Index_Type'Pos (Index_Type'First)
+
+ Pos_Lo : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions => New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_First)));
+
+ -- Corresponding index value, i.e. Index_Type'First
+
+ Aggr_Lo : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_First);
+
+ -- Pos_Hi := Pos_Lo + Size - 1
+
+ Pos_Hi : constant Node_Id :=
+ Make_Op_Add (Loc,
+ Left_Opnd => Pos_Lo,
+ Right_Opnd =>
+ Make_Op_Subtract (Loc,
+ Left_Opnd => New_Occurrence_Of (Size_Id, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, 1)));
+
+ -- Corresponding index value
+
+ Aggr_Hi : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_Val,
+ Expressions => New_List (Pos_Hi));
+
+ begin
+ Aggr_Typ := Make_Temporary (Loc, 'T');
+
+ Insert_Action (N,
+ Make_Subtype_Declaration (Loc,
+ Defining_Identifier => Aggr_Typ,
+ Subtype_Indication =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Base_Type (Typ), Loc),
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint
+ (Loc,
+ Constraints =>
+ New_List (Make_Range (Loc, Aggr_Lo, Aggr_Hi))))));
+ end;
+
+ -- Second pass: use the iterators to generate the elements of the
+ -- aggregate. We assume that the second evaluation of each iterator
+ -- generates the same number of elements as the first pass, and thus
+ -- consider that the execution is erroneous (even if the RM does not
+ -- state this explicitly) if the number of elements generated differs
+ -- between first and second pass.
+
+ Assoc := First (Component_Associations (N));
+
+ -- Initialize insertion position to first array component
+
+ Aggr_Code := New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Index_Id,
+ Object_Definition =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Copy_Tree (Lhs),
+ Attribute_Name => Name_First)));
+
+ while Present (Assoc) loop
+ Iter := Iterator_Specification (Assoc);
+ Iter_Id := Defining_Identifier (Iter);
+ New_Comp :=
+ Make_OK_Assignment_Statement (Loc,
+ Name =>
+ Make_Indexed_Component (Loc,
+ Prefix => New_Copy_Tree (Lhs),
+ Expressions =>
+ New_List (New_Occurrence_Of (Index_Id, Loc))),
+ Expression => Copy_Separate_Tree (Expression (Assoc)));
+
+ -- Arrange for the component to be adjusted if need be (the call
+ -- will be generated by Make_Tag_Ctrl_Assignment).
+
+ if Needs_Finalization (Ctyp)
+ and then not Is_Inherently_Limited_Type (Ctyp)
+ then
+ Set_No_Finalize_Actions (New_Comp);
+ else
+ Set_No_Ctrl_Actions (New_Comp);
+ end if;
+
+ -- Advance index position for insertion
+
+ Incr :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Index_Id, Loc),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_Succ,
+ Expressions =>
+ New_List (New_Occurrence_Of (Index_Id, Loc))));
+
+ -- Add guard to skip last increment when upper bound is reached
+
+ Incr :=
+ Make_If_Statement (Loc,
+ Condition =>
+ Make_Op_Ne (Loc,
+ Left_Opnd => New_Occurrence_Of (Index_Id, Loc),
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Index_Type, Loc),
+ Attribute_Name => Name_Last)),
+ Then_Statements => New_List (Incr));
+
+ -- Avoid using the same iterator definition in both loops by
+ -- creating a new iterator for each loop and mapping it over
+ -- the original iterator references.
+
+ One_Loop :=
+ Make_Implicit_Loop_Statement (N,
+ Iteration_Scheme =>
+ Make_Iteration_Scheme (Loc,
+ Iterator_Specification =>
+ New_Copy_Tree (Iter,
+ Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))),
+ Statements => New_List (New_Comp, Incr));
+
+ Append (One_Loop, Aggr_Code);
+ Next (Assoc);
+ end loop;
+
+ return Aggr_Code;
+ end Build_Two_Pass_Aggr_Code;
+
------------------
-- Check_Bounds --
------------------
@@ -5596,214 +5819,98 @@ package body Exp_Aggr is
-- Two_Pass_Aggregate_Expansion --
----------------------------------
- procedure Two_Pass_Aggregate_Expansion (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Comp_Type : constant Entity_Id := Etype (N);
- Index_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N);
- Index_Type : constant Entity_Id := Etype (First_Index (Etype (N)));
- Index_Base : constant Entity_Id := Base_Type (Index_Type);
- Size_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N);
- Size_Type : constant Entity_Id :=
- Integer_Type_For
- (Esize (Index_Base), Is_Unsigned_Type (Index_Base));
- TmpE : constant Entity_Id := Make_Temporary (Loc, 'A', N);
-
- Assoc : Node_Id := First (Component_Associations (N));
- Incr : Node_Id;
- Iter : Node_Id;
- New_Comp : Node_Id;
- One_Loop : Node_Id;
- Iter_Id : Entity_Id;
-
- Size_Expr_Code : List_Id;
- Insertion_Code : List_Id := New_List;
+ procedure Two_Pass_Aggregate_Expansion is
+ Aggr_Code : List_Id;
+ Aggr_Typ : Entity_Id;
+ Lhs : Node_Id;
+ Obj_Id : Entity_Id;
+ Par : Node_Id;
begin
- Size_Expr_Code := New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => Size_Id,
- Object_Definition => New_Occurrence_Of (Size_Type, Loc),
- Expression => Make_Integer_Literal (Loc, 0)));
-
- -- First pass: execute the iterators to count the number of elements
- -- that will be generated.
-
- while Present (Assoc) loop
- Iter := Iterator_Specification (Assoc);
- Iter_Id := Defining_Identifier (Iter);
- Incr := Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Size_Id, Loc),
- Expression =>
- Make_Op_Add (Loc,
- Left_Opnd => New_Occurrence_Of (Size_Id, Loc),
- Right_Opnd => Make_Integer_Literal (Loc, 1)));
-
- -- Avoid using the same iterator definition in both loops by
- -- creating a new iterator for each loop and mapping it over the
- -- original iterator references.
-
- One_Loop := Make_Implicit_Loop_Statement (N,
- Iteration_Scheme =>
- Make_Iteration_Scheme (Loc,
- Iterator_Specification =>
- New_Copy_Tree (Iter,
- Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))),
- Statements => New_List (Incr));
-
- Append (One_Loop, Size_Expr_Code);
- Next (Assoc);
+ Par := Parent (N);
+ while Nkind (Par) = N_Qualified_Expression loop
+ Par := Parent (Par);
end loop;
- Insert_Actions (N, Size_Expr_Code);
-
- -- Build a constrained subtype with the bounds deduced from
- -- the size computed above and declare the aggregate object.
- -- The index type is some discrete type, so the bounds of the
- -- constrained subtype are computed as T'Val (integer bounds).
-
- declare
- -- Pos_Lo := Index_Type'Pos (Index_Type'First)
-
- Pos_Lo : constant Node_Id :=
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Index_Type, Loc),
- Attribute_Name => Name_Pos,
- Expressions => New_List (
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Index_Type, Loc),
- Attribute_Name => Name_First)));
-
- -- Corresponding index value, i.e. Index_Type'First
+ -- If the aggregate is the initialization expression of an object
+ -- declaration, we always build the aggregate in place, although
+ -- this is required only for immutably limited types and types
+ -- that need finalization, see RM 7.6(17.2/3-17.3/3).
- Aggr_Lo : constant Node_Id :=
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Index_Type, Loc),
- Attribute_Name => Name_First);
-
- -- Pos_Hi := Pos_Lo + Size - 1
-
- Pos_Hi : constant Node_Id :=
- Make_Op_Add (Loc,
- Left_Opnd => Pos_Lo,
- Right_Opnd =>
- Make_Op_Subtract (Loc,
- Left_Opnd => New_Occurrence_Of (Size_Id, Loc),
- Right_Opnd => Make_Integer_Literal (Loc, 1)));
-
- -- Corresponding index value
-
- Aggr_Hi : constant Node_Id :=
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Index_Type, Loc),
- Attribute_Name => Name_Val,
- Expressions => New_List (Pos_Hi));
-
- SubE : constant Entity_Id := Make_Temporary (Loc, 'T');
- SubD : constant Node_Id :=
- Make_Subtype_Declaration (Loc,
- Defining_Identifier => SubE,
- Subtype_Indication =>
- Make_Subtype_Indication (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (Etype (Comp_Type), Loc),
- Constraint =>
- Make_Index_Or_Discriminant_Constraint
- (Loc,
- Constraints =>
- New_List (Make_Range (Loc, Aggr_Lo, Aggr_Hi)))));
-
- -- Create a temporary array of the above subtype which
- -- will be used to capture the aggregate assignments.
-
- TmpD : constant Node_Id :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => TmpE,
- Object_Definition => New_Occurrence_Of (SubE, Loc));
-
- begin
- Insert_Actions (N, New_List (SubD, TmpD));
- end;
-
- -- Second pass: use the iterators to generate the elements of the
- -- aggregate. Insertion index starts at Index_Type'First. We
- -- assume that the second evaluation of each iterator generates
- -- the same number of elements as the first pass, and consider
- -- that the execution is erroneous (even if the RM does not state
- -- this explicitly) if the number of elements generated differs
- -- between first and second pass.
-
- Assoc := First (Component_Associations (N));
+ if Nkind (Par) = N_Object_Declaration then
+ Obj_Id := Defining_Identifier (Par);
+ Lhs := New_Occurrence_Of (Obj_Id, Loc);
+ Set_Assignment_OK (Lhs);
+ Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ);
- -- Initialize insertion position to first array component.
+ -- Save the last assignment statement associated with the
+ -- aggregate when building a controlled object. This last
+ -- assignment is used by the finalization machinery when
+ -- marking an object as successfully initialized.
- Insertion_Code := New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => Index_Id,
- Object_Definition =>
- New_Occurrence_Of (Index_Type, Loc),
- Expression =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Index_Type, Loc),
- Attribute_Name => Name_First)));
+ if Needs_Finalization (Typ) then
+ Mutate_Ekind (Obj_Id, E_Variable);
+ Set_Last_Aggregate_Assignment (Obj_Id, Last (Aggr_Code));
+ end if;
- while Present (Assoc) loop
- Iter := Iterator_Specification (Assoc);
- Iter_Id := Defining_Identifier (Iter);
- New_Comp := Make_OK_Assignment_Statement (Loc,
- Name =>
- Make_Indexed_Component (Loc,
- Prefix => New_Occurrence_Of (TmpE, Loc),
- Expressions =>
- New_List (New_Occurrence_Of (Index_Id, Loc))),
- Expression => Copy_Separate_Tree (Expression (Assoc)));
+ -- If a transient scope has been created around the declaration,
+ -- we need to attach the code to it so that finalization actions
+ -- of the declaration will be inserted after it; otherwise, we
+ -- directly insert it after the declaration. In both cases, the
+ -- code will be analyzed after the declaration is processed, i.e.
+ -- once the actual subtype of the object is established.
- -- Advance index position for insertion.
+ if Scope_Is_Transient and then Par = Node_To_Be_Wrapped then
+ Store_After_Actions_In_Scope_Without_Analysis (Aggr_Code);
+ else
+ Insert_List_After (Par, Aggr_Code);
+ end if;
- Incr := Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Index_Id, Loc),
- Expression =>
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Index_Type, Loc),
- Attribute_Name => Name_Succ,
- Expressions =>
- New_List (New_Occurrence_Of (Index_Id, Loc))));
+ Set_Etype (N, Aggr_Typ);
+ Set_No_Initialization (Par);
- -- Add guard to skip last increment when upper bound is reached.
+ -- Likewise if it is the qualified expression of an allocator but,
+ -- in this case, we wait until after Expand_Allocator_Expression
+ -- rewrites the allocator as the initialization expression of an
+ -- object declaration, so that we have the left-hand side.
- Incr := Make_If_Statement (Loc,
- Condition =>
- Make_Op_Ne (Loc,
- Left_Opnd => New_Occurrence_Of (Index_Id, Loc),
- Right_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Index_Type, Loc),
- Attribute_Name => Name_Last)),
- Then_Statements => New_List (Incr));
+ elsif Nkind (Par) = N_Allocator then
+ if Nkind (Parent (Par)) = N_Object_Declaration
+ and then
+ not Comes_From_Source (Defining_Identifier (Parent (Par)))
+ then
+ Obj_Id := Defining_Identifier (Parent (Par));
+ Lhs :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Obj_Id, Loc));
+ Set_Assignment_OK (Lhs);
+ Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ);
- -- Avoid using the same iterator definition in both loops by
- -- creating a new iterator for each loop and mapping it over the
- -- original iterator references.
+ Insert_Actions_After (Parent (Par), Aggr_Code);
- One_Loop := Make_Implicit_Loop_Statement (N,
- Iteration_Scheme =>
- Make_Iteration_Scheme (Loc,
- Iterator_Specification =>
- New_Copy_Tree (Iter,
- Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))),
- Statements => New_List (New_Comp, Incr));
+ Set_Expression (Par, New_Occurrence_Of (Aggr_Typ, Loc));
+ Set_No_Initialization (Par);
+ end if;
- Append (One_Loop, Insertion_Code);
- Next (Assoc);
- end loop;
+ -- Otherwise we create a temporary for the anonymous object and
+ -- replace the aggregate with the temporary.
- Insert_Actions (N, Insertion_Code);
+ else
+ Obj_Id := Make_Temporary (Loc, 'A', N);
+ Lhs := New_Occurrence_Of (Obj_Id, Loc);
+ Set_Assignment_OK (Lhs);
- -- Depending on context this may not work for build-in-place
- -- arrays ???
+ Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ);
+ Prepend_To (Aggr_Code,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Obj_Id,
+ Object_Definition => New_Occurrence_Of (Aggr_Typ, Loc)));
- Rewrite (N, New_Occurrence_Of (TmpE, Loc));
+ Insert_Actions (N, Aggr_Code);
+ Rewrite (N, Lhs);
+ Analyze_And_Resolve (N, Aggr_Typ);
+ end if;
end Two_Pass_Aggregate_Expansion;
-- Local variables
@@ -5829,7 +5936,7 @@ package body Exp_Aggr is
-- Aggregates that require a two-pass expansion are handled separately
elsif Is_Two_Pass_Aggregate (N) then
- Two_Pass_Aggregate_Expansion (N);
+ Two_Pass_Aggregate_Expansion;
return;
-- Do not attempt expansion if error already detected. We may reach this
@@ -6002,12 +6109,11 @@ package body Exp_Aggr is
-- static type imposed by the context.
declare
- Itype : constant Entity_Id := Etype (N);
Index : Node_Id;
Needs_Type : Boolean := False;
begin
- Index := First_Index (Itype);
+ Index := First_Index (Typ);
while Present (Index) loop
if not Is_OK_Static_Subtype (Etype (Index)) then
Needs_Type := True;
@@ -6019,7 +6125,7 @@ package body Exp_Aggr is
if Needs_Type then
Build_Constrained_Type (Positional => True);
- Rewrite (N, Unchecked_Convert_To (Itype, N));
+ Rewrite (N, Unchecked_Convert_To (Typ, N));
Analyze (N);
end if;
end;
@@ -6147,7 +6253,7 @@ package body Exp_Aggr is
then
Tmp := Name (Parent_Node);
- if Etype (Tmp) /= Etype (N) then
+ if Etype (Tmp) /= Typ then
Apply_Length_Check (N, Etype (Tmp));
if Nkind (N) = N_Raise_Constraint_Error then
@@ -7362,7 +7468,7 @@ package body Exp_Aggr is
-- Likewise if the aggregate is the qualified expression of an allocator
-- but, in this case, we wait until after Expand_Allocator_Expression
-- rewrites the allocator as the initialization expression of an object
- -- declaration to have the left hand side.
+ -- declaration, so that we have the left-hand side.
elsif Nkind (Par) = N_Allocator then
if Nkind (Parent (Par)) = N_Object_Declaration
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index bc46fd37e0c6..fa87149aec05 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5423,18 +5423,12 @@ package body Exp_Ch3 is
-- with an initial value, its Init_Proc will never be called. The
-- initial value itself may have been expanded into assignments,
-- in which case the declaration has the No_Initialization flag.
- -- The exception is when the initial value is a 2-pass aggregate,
- -- because the special expansion used for it creates a temporary
- -- that needs a fully-fledged initialization.
if Is_Itype (Base)
and then Nkind (Associated_Node_For_Itype (Base)) =
N_Object_Declaration
and then
- ((Present (Expression (Associated_Node_For_Itype (Base)))
- and then not
- Is_Two_Pass_Aggregate
- (Expression (Associated_Node_For_Itype (Base))))
+ (Present (Expression (Associated_Node_For_Itype (Base)))
or else No_Initialization (Associated_Node_For_Itype (Base)))
then
null;
@@ -8293,12 +8287,15 @@ package body Exp_Ch3 is
-- where the object has been initialized by a call to a function
-- returning on the primary stack (see Expand_Ctrl_Function_Call)
-- since no copy occurred, given that the type is by-reference.
+ -- Likewise if it is initialized by a 2-pass aggregate, since the
+ -- actual initialization will only occur during the second pass.
-- Similarly, no adjustment is needed if we are going to rewrite
-- the object declaration into a renaming declaration.
if Needs_Finalization (Typ)
and then not Is_Inherently_Limited_Type (Typ)
and then Nkind (Expr_Q) /= N_Function_Call
+ and then not Is_Two_Pass_Aggregate (Expr_Q)
and then not Rewrite_As_Renaming
then
Adj_Call :=
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 82978c775cf2..8c724844eb32 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -769,7 +769,6 @@ package body Exp_Ch4 is
-- Local variables
Aggr_In_Place : Boolean;
- Container_Aggr : Boolean;
Delayed_Cond_Expr : Boolean;
TagT : Entity_Id := Empty;
@@ -865,13 +864,15 @@ package body Exp_Ch4 is
Aggr_In_Place := Is_Delayed_Aggregate (Exp);
Delayed_Cond_Expr := Is_Delayed_Conditional_Expression (Exp);
- Container_Aggr := Nkind (Exp) = N_Aggregate
- and then Has_Aspect (T, Aspect_Aggregate);
- -- An allocator with a container aggregate as qualified expression must
- -- be rewritten into the form expected by Expand_Container_Aggregate.
+ -- An allocator with a container aggregate, resp. a 2-pass aggregate,
+ -- as qualified expression must be rewritten into the form expected by
+ -- Expand_Container_Aggregate, resp. Two_Pass_Aggregate_Expansion.
- if Container_Aggr then
+ if Nkind (Exp) = N_Aggregate
+ and then (Has_Aspect (T, Aspect_Aggregate)
+ or else Is_Two_Pass_Aggregate (Exp))
+ then
Temp := Make_Temporary (Loc, 'P', N);
Set_Analyzed (Exp, False);
Insert_Action (N,
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index d5667b423deb..f85d977d0d80 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -9857,6 +9857,13 @@ package body Exp_Ch6 is
return Skip;
end if;
+ -- Skip calls placed in unexpanded initialization expressions
+
+ when N_Object_Declaration =>
+ if No_Initialization (Nod) then
+ return Skip;
+ end if;
+
-- Skip calls placed in subprogram specifications since function
-- calls initializing default parameter values will be processed
-- when the call to the subprogram is found (if the default actual
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 74eac9c9789c..4b5c5b1a41ee 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4991,7 +4991,7 @@ package body Sem_Ch3 is
if Is_Array_Type (T)
and then No_Initialization (N)
- and then Nkind (Original_Node (E)) = N_Aggregate
+ and then Nkind (Unqualify (Original_Node (E))) = N_Aggregate
then
Act_T := Etype (E);
@@ -5137,10 +5137,7 @@ package body Sem_Ch3 is
elsif Is_Array_Type (T)
and then No_Initialization (N)
- and then (Nkind (Original_Node (E)) = N_Aggregate
- or else (Nkind (Original_Node (E)) = N_Qualified_Expression
- and then Nkind (Original_Node (Expression
- (Original_Node (E)))) = N_Aggregate))
+ and then Nkind (Unqualify (Original_Node (E))) = N_Aggregate
then
if not Is_Entity_Name (Object_Definition (N)) then
Act_T := Etype (E);
@@ -6633,8 +6630,6 @@ package body Sem_Ch3 is
end;
end if;
- -- Constrained array case
-
if No (T) then
-- We might be creating more than one itype with the same Related_Id,
-- e.g. for an array object definition and its initial value. Give
@@ -6644,6 +6639,8 @@ package body Sem_Ch3 is
T := Create_Itype (E_Void, P, Related_Id, 'T', Suffix_Index => -1);
end if;
+ -- Constrained array case
+
if Nkind (Def) = N_Constrained_Array_Definition then
Index := First (Discrete_Subtype_Definitions (Def));
