[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
This commit is contained in:
Ed Schonberg 2019-08-13 08:08:22 +00:00 committed by Pierre-Marie de Rodat
parent 5b3b4d6089
commit 5efb712503
4 changed files with 46 additions and 0 deletions

View File

@ -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

View File

@ -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);

View File

@ -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.

View File

@ -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;