https://gcc.gnu.org/g:60b352cd6608727a6c24a2cb1b08b3159a865637
commit r13-9096-g60b352cd6608727a6c24a2cb1b08b3159a865637
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Thu Sep 5 00:19:25 2024 +0200
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.
Diff:
---
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 306f17bb5bfa..bb58613128b8 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6684,12 +6684,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;
@@ -9227,6 +9222,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 4babf2ec54c3..00591aedc6bb 100644
--- a/gcc/ada/exp_aggr.ads
+++ b/gcc/ada/exp_aggr.ads
@@ -35,6 +35,10 @@ package Exp_Aggr is
-- Returns True if N is an aggregate of some kind 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.
+
procedure Convert_Aggr_In_Object_Decl (N : Node_Id);
-- N is a N_Object_Declaration with an expression which must be an
-- N_Aggregate or N_Extension_Aggregate with Expansion_Delayed.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 715f87fc796d..cfc2970a5f77 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4896,17 +4896,22 @@ package body Exp_Ch3 is
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;
