diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2024-09-05 00:19:25 +0200 |
---|---|---|
committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-10-08 10:37:12 +0200 |
commit | 45131b851522180c532bebb3521865e488025af0 (patch) | |
tree | 3f4da2b0c854cef05d10a69d843f70c8a48d3c1f /gcc | |
parent | b4629ccf3c15b7eafe73beb8b4393419b9968e82 (diff) | |
download | gcc-45131b851522180c532bebb3521865e488025af0.zip gcc-45131b851522180c532bebb3521865e488025af0.tar.gz gcc-45131b851522180c532bebb3521865e488025af0.tar.bz2 |
ada: Fix wrong finalization of anonymous array aggregate
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/exp_aggr.adb | 22 | ||||
-rw-r--r-- | gcc/ada/exp_aggr.ads | 4 | ||||
-rw-r--r-- | 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 846665e..86d886a 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 17fa38b..aa79616 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 ff808aa..139fce8 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; |