Commit 6951cbc9 by Eric Botcazou Committed by Pierre-Marie de Rodat

[Ada] Fix sharing of expression in array aggregate with others choice

This change fixes a long-standing issue in the compiler that is
generally silent but may lead to wrong code generation in specific
circumstances.  When an others choice in an array aggregate spans
multiple ranges, the compiler may generate multiple (groups of)
assignments for the ranges.

The problem is that it internally reuses the original expression for all
the ranges, which is problematic if this expression gets rewritten
during the processing of one of the ranges and typically causes a new
temporary to be shared between different ranges.

The solution is to duplicate the original expression for each range.

2019-09-18  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_aggr.adb (Build_Array_Aggr_Code): In STEP 1 (c), duplicate
	the expression and reset the Loop_Actions for each loop
	generated for an others choice.

gcc/testsuite/

	* gnat.dg/aggr28.adb: New testcase.

From-SVN: r275859
parent 43b26411
2019-09-18 Eric Botcazou <ebotcazou@adacore.com>
* exp_aggr.adb (Build_Array_Aggr_Code): In STEP 1 (c), duplicate
the expression and reset the Loop_Actions for each loop
generated for an others choice.
2019-09-18 Justin Squirek <squirek@adacore.com>
* einfo.adb, einfo.ads (Minimum_Accessibility): Added new field.
......
......@@ -2075,7 +2075,6 @@ package body Exp_Aggr is
Choice := First (Choice_List (Assoc));
while Present (Choice) loop
if Nkind (Choice) = N_Others_Choice then
Set_Loop_Actions (Assoc, New_List);
Others_Assoc := Assoc;
exit;
end if;
......@@ -2122,7 +2121,8 @@ package body Exp_Aggr is
if Present (Others_Assoc) then
declare
First : Boolean := True;
First : Boolean := True;
Dup_Expr : Node_Id;
begin
for J in 0 .. Nb_Choices loop
......@@ -2160,9 +2160,19 @@ package body Exp_Aggr is
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);
Set_Parent (Dup_Expr, Parent (Expr));
Set_Loop_Actions (Others_Assoc, New_List);
Append_List
(Gen_Loop (Low, High,
Get_Assoc_Expr (Others_Assoc)), To => New_Code);
(Gen_Loop (Low, High, Dup_Expr), To => New_Code);
end if;
end loop;
end;
......
2019-09-18 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/aggr28.adb: New testcase.
2019-09-18 Steve Baird <baird@adacore.com>
* gnat.dg/ai12_0086_example.adb: New testcase.
......
-- { dg-do run }
procedure Aggr28 is
Count : Natural := 0;
function Get (S: String) return String is
begin
Count := Count + 1;
return S;
end;
Max_Error_Length : constant := 8;
subtype Error_Type is String (1 .. Max_Error_Length);
type Rec is record
Text : Error_Type;
end record;
type Arr is array (1 .. 16) of Rec;
Table : constant Arr :=
(3 => (Text => Get ("INVALID ")), others => (Text => Get ("OTHERS ")));
begin
if Count /= Table'Length then
raise Program_Error;
end if;
end;
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment