aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2024-09-05 00:19:25 +0200
committerMarc Poulhiès <dkm@gcc.gnu.org>2024-10-08 10:37:12 +0200
commit45131b851522180c532bebb3521865e488025af0 (patch)
tree3f4da2b0c854cef05d10a69d843f70c8a48d3c1f /gcc
parentb4629ccf3c15b7eafe73beb8b4393419b9968e82 (diff)
downloadgcc-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.adb22
-rw-r--r--gcc/ada/exp_aggr.ads4
-rw-r--r--gcc/ada/exp_ch3.adb15
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;