[Ada] Do not remove side-effects in an others_clause with function calls

An aggregate can be handled by the backend if it consists of static
constants of an elementary type, or null. If a component is a type
conversion we must preanalyze and resolve it to determine whether the
ultimate value is in one of these categories.  Previously we did a full
analysis and resolution of the expression for the component, which could
lead to a removal of side-effects, which is semantically incorrect if
the expression includes functions with side-effects (e.g. a call to a
random generator).

2019-08-13  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend):  Preanalyze
	expression, rather do a full analysis, to prevent unwanted
	removal of side effects which mask the intent of the expression.

gcc/testsuite/

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

From-SVN: r274355

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a6672d9..dfc30f2 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2019-08-13  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_aggr.adb (Aggr_Assignment_OK_For_Backend):  Preanalyze
+       expression, rather do a full analysis, to prevent unwanted
+       removal of side effects which mask the intent of the expression.
+
 2019-08-13  Eric Botcazou  <ebotcazou@adacore.com>
 
        * impunit.adb (Non_Imp_File_Names_95): Add

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 925d6ae..8668188 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5321,6 +5321,16 @@ package body Exp_Aggr is
             return False;
          end if;
 
+         --  If the expression has side effects (e.g. contains calls with
+         --  potential side effects) reject as well. We only preanalyze the
+         --  expression to prevent the removal of intended side effects.
+
+         Preanalyze_And_Resolve (Expr, Ctyp);
+
+         if not Side_Effect_Free (Expr) then
+            return False;
+         end if;
+
          --  The expression needs to be analyzed if True is returned
 
          Analyze_And_Resolve (Expr, Ctyp);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 824fcc8..c1e28aa 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-08-13  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/aggr27.adb: New testcase.
+
 2019-08-13  Gary Dismukes  <dismukes@adacore.com>
 
        * gnat.dg/aggr26.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/aggr27.adb b/gcc/testsuite/gnat.dg/aggr27.adb
new file mode 100644 (file)
index 0000000..43b6206
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr27.adb
@@ -0,0 +1,26 @@
+--  { dg-do run }
+--  { dg-options "-gnatws -gnata" }
+
+with GNAT.Random_Numbers;
+
+procedure Aggr27 is
+
+   Gen: GNAT.Random_Numbers.Generator;
+
+   function Random return Long_Long_Integer is
+      Rand : Integer := GNAT.Random_Numbers.Random(Gen);
+   begin
+      return Long_Long_Integer(Rand);
+   end Random;
+
+   type Values is range 1 .. 4;
+
+   Seq_LLI : array (Values) of Long_Long_Integer := (others => Random);
+   Seq_I   : array (Values) of Integer           := (others => Integer(Random));
+
+begin
+   --  Verify that there is at least two  different entries in each.
+
+   pragma Assert (For some E of Seq_LLI => E /= Seq_LLI (Values'First));
+   pragma Assert (For some E of Seq_I => E /= Seq_I (Values'First));
+end Aggr27;