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 <kirtc...@adacore.com>
* exp_aggr.adb (Initialize_Ctrl_Array_Component):
Create a copy of the initialization expression to avoid sharing
it between multiple components.
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 241024)
+++ exp_aggr.adb (working copy)
@@ -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
