@@ -2215,21 +2215,32 @@ package body Exp_Aggr is
-- Get_Assoc_Expr --
--------------------
+ -- Duplicate the expression in case we will be generating several loops.
+ -- As a result the expression is no longer shared between the loops and
+ -- is reevaluated for each such loop.
+
function Get_Assoc_Expr (Assoc : Node_Id) return Node_Id is
Typ : constant Entity_Id := Base_Type (Etype (N));
begin
if Box_Present (Assoc) then
if Present (Default_Aspect_Component_Value (Typ)) then
- return Default_Aspect_Component_Value (Typ);
+ return New_Copy_Tree (Default_Aspect_Component_Value (Typ));
elsif Needs_Simple_Initialization (Ctype) then
- return Get_Simple_Init_Val (Ctype, N);
+ return New_Copy_Tree (Get_Simple_Init_Val (Ctype, N));
else
return Empty;
end if;
else
- return Expression (Assoc);
+ -- The expression will be passed to Gen_Loop, which immediately
+ -- calls Parent_Kind on it, so we set Parent when it matters.
+
+ return
+ Expr : constant Node_Id := New_Copy_Tree (Expression (Assoc))
+ do
+ Copy_Parent (To => Expr, From => Expression (Assoc));
+ end return;
end if;
end Get_Assoc_Expr;
@@ -2394,8 +2405,7 @@ package body Exp_Aggr is
if Present (Others_Assoc) then
declare
- First : Boolean := True;
- Dup_Expr : Node_Id;
+ First : Boolean := True;
begin
for J in 0 .. Nb_Choices loop
@@ -2429,23 +2439,11 @@ package body Exp_Aggr is
end if;
end if;
- if First
- or else not Empty_Range (Low, High)
- then
+ if First or else not Empty_Range (Low, High) then
First := False;
-
- -- Duplicate the expression in case we will be generating
- -- several loops. As a result the expression is no longer
- -- shared between the loops and is reevaluated for each
- -- such loop.
-
- Expr := Get_Assoc_Expr (Others_Assoc);
- Dup_Expr := New_Copy_Tree (Expr);
- Copy_Parent (To => Dup_Expr, From => Expr);
-
Set_Loop_Actions (Others_Assoc, New_List);
- Append_List
- (Gen_Loop (Low, High, Dup_Expr), To => New_Code);
+ Expr := Get_Assoc_Expr (Others_Assoc);
+ Append_List (Gen_Loop (Low, High, Expr), To => New_Code);
end if;
end loop;
end;
From: Eric Botcazou <ebotcazou@adacore.com> This extends an earlier fix done for the others choice of an array aggregate to all the choices of the aggregate, since the same sharing issue may happen when the choices are not contiguous. gcc/ada/ * exp_aggr.adb (Build_Array_Aggr_Code.Get_Assoc_Expr): Duplicate the expression here instead of... (Build_Array_Aggr_Code): ...here. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 38 ++++++++++++++++++-------------------- 1 file changed, 18 insertions(+), 20 deletions(-)