From: Eric Botcazou <ebotca...@adacore.com>
The issue arises when the aggregate consists only of iterated associations
because, in this case, its expansion uses a 2-pass mechanism which creates
a temporary that needs a fully-fledged initialization, thus running afoul
of the optimization that avoids building the initialization procedure in
the anonymous array case.
gcc/ada/ChangeLog:
* exp_aggr.ads (Is_Two_Pass_Aggregate): New function declaration.
* exp_aggr.adb (Is_Two_Pass_Aggregate): New function body.
(Expand_Array_Aggregate): Call Is_Two_Pass_Aggregate to detect the
aggregates that need the 2-pass expansion.
* exp_ch3.adb (Expand_Freeze_Array_Type): In the anonymous array
case, build the initialization procedure if the initial value in
the object declaration is a 2-pass aggregate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 22 ++++++++++++++++------
gcc/ada/exp_aggr.ads | 4 ++++
gcc/ada/exp_ch3.adb | 15 ++++++++++-----
3 files changed, 30 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 846665eae20..86d886a302c 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5946,12 +5946,7 @@ package body Exp_Aggr is
then
return;
- elsif Present (Component_Associations (N))
- and then Nkind (First (Component_Associations (N))) =
- N_Iterated_Component_Association
- and then
- Present (Iterator_Specification (First (Component_Associations (N))))
- then
+ elsif Is_Two_Pass_Aggregate (N) then
Two_Pass_Aggregate_Expansion (N);
return;
@@ -8872,6 +8867,21 @@ package body Exp_Aggr is
and then C in Uint_1 | Uint_2 | Uint_4; -- False if No_Uint
end Is_Two_Dim_Packed_Array;
+ ---------------------------
+ -- Is_Two_Pass_Aggregate --
+ ---------------------------
+
+ function Is_Two_Pass_Aggregate (N : Node_Id) return Boolean is
+ begin
+ return Nkind (N) = N_Aggregate
+ and then Present (Component_Associations (N))
+ and then Nkind (First (Component_Associations (N))) =
+ N_Iterated_Component_Association
+ and then
+ Present
+ (Iterator_Specification (First (Component_Associations (N))));
+ end Is_Two_Pass_Aggregate;
+
--------------------
-- Late_Expansion --
--------------------
diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads
index 17fa38b7ca3..aa79616c609 100644
--- a/gcc/ada/exp_aggr.ads
+++ b/gcc/ada/exp_aggr.ads
@@ -58,6 +58,10 @@ package Exp_Aggr is
-- Returns True if N is a conditional expression whose Expansion_Delayed
-- flag is set (see sinfo for meaning of flag).
+ function Is_Two_Pass_Aggregate (N : Node_Id) return Boolean;
+ -- Return True if N is an aggregate that is to be expanded in two passes.
+ -- This is the case if it consists only of iterated associations.
+
function Static_Array_Aggregate (N : Node_Id) return Boolean;
-- N is an array aggregate that may have a component association with
-- an others clause and a range. If bounds are static and the expressions
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index ff808aadea8..139fce8b288 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5429,17 +5429,22 @@ package body Exp_Ch3 is
if not Is_Bit_Packed_Array (Typ) then
if No (Init_Proc (Base)) then
- -- If this is an anonymous array created for a declaration with
- -- an initial value, its init_proc will never be called. The
+ -- If this is an anonymous array built for an object declaration
+ -- 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 object declaration is carries the
- -- No_Initialization flag.
+ -- 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)))
+ ((Present (Expression (Associated_Node_For_Itype (Base)))
+ and then not
+ Is_Two_Pass_Aggregate
+ (Expression (Associated_Node_For_Itype (Base))))
or else No_Initialization (Associated_Node_For_Itype (Base)))
then
null;
--
2.43.0
