aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2019-09-18 08:33:12 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-09-18 08:33:12 +0000
commit6951cbc9e7646bca1c99c973815e6838a6e1fe25 (patch)
tree8dfe7973960559f51dccdec8f4e2cb72721875f7
parent43b264110f5581af0cc93308f9433fe8053f01cc (diff)
downloadgcc-6951cbc9e7646bca1c99c973815e6838a6e1fe25.zip
gcc-6951cbc9e7646bca1c99c973815e6838a6e1fe25.tar.gz
gcc-6951cbc9e7646bca1c99c973815e6838a6e1fe25.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/exp_aggr.adb18
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/aggr28.adb29
4 files changed, 53 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 384f982..5c17f81 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+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.
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 7f11b41..5b2e0a5 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fd0efb1..32297d1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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.
diff --git a/gcc/testsuite/gnat.dg/aggr28.adb b/gcc/testsuite/gnat.dg/aggr28.adb
new file mode 100644
index 0000000..3375b71
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr28.adb
@@ -0,0 +1,29 @@
+-- { 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