===================================================================
@@ -1277,6 +1277,7 @@
is
Act_Aggr : Node_Id;
Act_Stmts : List_Id;
+ Expr : Node_Id;
Fin_Call : Node_Id;
Hook_Clear : Node_Id;
@@ -1285,20 +1286,29 @@
-- in-place expansion.
begin
+ -- Duplicate the initialization expression in case the context is
+ -- a multi choice list or an "others" choice which plugs various
+ -- holes in the aggregate. As a result the expression is no longer
+ -- shared between the various components and is reevaluated for
+ -- each such component.
+
+ Expr := New_Copy_Tree (Init_Expr);
+ Set_Parent (Expr, Parent (Init_Expr));
+
-- Perform a preliminary analysis and resolution to determine what
-- the initialization expression denotes. An unanalyzed function
-- call may appear as an identifier or an indexed component.
- if Nkind_In (Init_Expr, N_Function_Call,
- N_Identifier,
- N_Indexed_Component)
- and then not Analyzed (Init_Expr)
+ if Nkind_In (Expr, N_Function_Call,
+ N_Identifier,
+ N_Indexed_Component)
+ and then not Analyzed (Expr)
then
- Preanalyze_And_Resolve (Init_Expr, Comp_Typ);
+ Preanalyze_And_Resolve (Expr, Comp_Typ);
end if;
In_Place_Expansion :=
- Nkind (Init_Expr) = N_Function_Call
+ Nkind (Expr) = N_Function_Call
and then not Is_Limited_Type (Comp_Typ);
-- The initialization expression is a controlled function call.
@@ -1315,7 +1325,7 @@
-- generation of a transient scope, which leads to out-of-order
-- adjustment and finalization.
- Set_No_Side_Effect_Removal (Init_Expr);
+ Set_No_Side_Effect_Removal (Expr);
-- When the transient component initialization is related to a
-- range or an "others", keep all generated statements within
@@ -1341,7 +1351,7 @@
Process_Transient_Component
(Loc => Loc,
Comp_Typ => Comp_Typ,
- Init_Expr => Init_Expr,
+ Init_Expr => Expr,
Fin_Call => Fin_Call,
Hook_Clear => Hook_Clear,
Aggr => Act_Aggr,
@@ -1356,7 +1366,7 @@
Initialize_Array_Component
(Arr_Comp => Arr_Comp,
Comp_Typ => Comp_Typ,
- Init_Expr => Init_Expr,
+ Init_Expr => Expr,
Stmts => Stmts);
-- At this point the array element is fully initialized. Complete
This patch modifies the processing of transient array components to properly handle the finalization of the temporary controlled function result when the call initializes a component choice list or an "others" choice. ------------ -- Source -- ------------ -- aggregates.adb with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Text_IO; use Ada.Text_IO; procedure Aggregates is begin declare Arr : array (1 .. 3) of Unbounded_String := (2 => To_Unbounded_String ("two"), others => To_Unbounded_String ("others")); begin Put ("others "); Put_Line (To_String (Arr (1))); Put ("two "); Put_Line (To_String (Arr (2))); Put ("others "); Put_Line (To_String (Arr (3))); end; declare Arr : array (1 .. 4) of Unbounded_String := (1 | 3 | 4 => To_Unbounded_String ("one_three_four"), 2 => To_Unbounded_String ("two")); begin Put ("one_three_four "); Put_Line (To_String (Arr (1))); Put ("two "); Put_Line (To_String (Arr (2))); Put ("one_three_four "); Put_Line (To_String (Arr (3))); Put ("one_three_four "); Put_Line (To_String (Arr (4))); end; declare Arr : array (1 .. 3) of Unbounded_String := (1 .. 2 => To_Unbounded_String ("one_two"), others => To_Unbounded_String ("others")); begin Put ("one_two "); Put_Line (To_String (Arr (1))); Put ("one_two "); Put_Line (To_String (Arr (2))); Put ("others "); Put_Line (To_String (Arr (3))); end; declare Arr : array (1 .. 4) of Unbounded_String := (1 => To_Unbounded_String ("one"), 2 .. 4 => To_Unbounded_String ("two_four")); begin Put ("one "); Put_Line (To_String (Arr (1))); Put ("two_four "); Put_Line (To_String (Arr (2))); Put ("two_four "); Put_Line (To_String (Arr (3))); Put ("two_four "); Put_Line (To_String (Arr (4))); end; declare Arr : array (1 .. 5) of Unbounded_String := (1 .. 2 => To_Unbounded_String ("one_two"), 4 | 5 => To_Unbounded_String ("four_five"), others => To_Unbounded_String ("others")); begin Put ("one_two "); Put_Line (To_String (Arr (1))); Put ("one_two "); Put_Line (To_String (Arr (2))); Put ("others "); Put_Line (To_String (Arr (3))); Put ("four_five "); Put_Line (To_String (Arr (4))); Put ("four_five "); Put_Line (To_String (Arr (5))); end; end Aggregates; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q aggregates.adb $ ./aggregates others others two two others others one_three_four one_three_four two two one_three_four one_three_four one_three_four one_three_four one_two one_two one_two one_two others others one one two_four two_four two_four two_four two_four two_four one_two one_two one_two one_two others others four_five four_five four_five four_five Tested on x86_64-pc-linux-gnu, committed on trunk 2016-10-12 Hristian Kirtchev <kirtchev@adacore.com> * exp_aggr.adb (Initialize_Ctrl_Array_Component): Create a copy of the initialization expression to avoid sharing it between multiple components.