[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 384f98205420d8d25ae45d97dbdb0bba3c9524d8..5c17f81e7c031fe920020d33087841b9b66b0465 100644 (file)
--- 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 7f11b4105bd0bf08bcd43c3dd18359956e2df58e..5b2e0a554c00e0e7b46dfb86747b19ac76e3dc94 100644 (file)
--- 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 fd0efb176e6c9261df94adc96848c144891cd044..32297d12789c705428184540e8b6221fccc6947e 100644 (file)
--- 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 (file)
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