[PATCH] ada: Evaluate argument of optimized operators

[Samuel Tardieu]

The optimization of the "**" operator replaces the expression by
1 if the right operand is 0. It means that the left operand is
not evaluated in this case. The same thing happens with multiplication
by 0 on either side, and with "x mod 1" and "x rem 1".

This patch forces the evaluation of the non-zero operand in any case.
If the value being evaluated is side-effect-free, "Remove_Side_Effect"
called through "Force_Evaluation" will notice it and not generate any
code anyway so there is no penalty on doing this.

The accompanying test program must execute without raising an exception.

Tested on i686-pc-linux-gnu. Ok for trunk?

    gcc/ada/
	* exp_ch4.adb (Expand_N_Op_Expon): Force evaluation of
	left argument even when right argument is 0.
	(Expand_N_Op_Mod): Ditto when right argument is 1.
	(Expand_N_Op_Multiply): Ditto when any argument is 0.
	(Expand_N_Op_Rem): Ditto when right argument is 1.

    gcc/testsuite/
	* gnat.dg/exp0_eval.adb: New.
---
 gcc/ada/exp_ch4.adb                 |   20 +++++++++++++++-----
 gcc/testsuite/gnat.dg/exp0_eval.adb |   31 +++++++++++++++++++++++++++++++
 2 files changed, 46 insertions(+), 5 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/exp0_eval.adb

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d0b60f3..0a1cd26 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5466,6 +5466,7 @@ package body Exp_Ch4 is
             --  X ** 0 = 1 (or 1.0)
 
             if Expv = 0 then
+               Force_Evaluation (Base);
                if Ekind (Typ) in Integer_Kind then
                   Xnode := Make_Integer_Literal (Loc, Intval => 1);
                else
@@ -5940,6 +5941,7 @@ package body Exp_Ch4 is
            and then Compile_Time_Known_Value (Right)
            and then Expr_Value (Right) = Uint_1
          then
+            Force_Evaluation (Left);
             Rewrite (N, Make_Integer_Literal (Loc, 0));
             Analyze_And_Resolve (N, Typ);
             return;
@@ -6013,12 +6015,19 @@ package body Exp_Ch4 is
 
          --  N * 0 = 0 * N = 0 for integer types
 
-         if (Compile_Time_Known_Value (Rop)
-              and then Expr_Value (Rop) = Uint_0)
-           or else
-            (Compile_Time_Known_Value (Lop)
-              and then Expr_Value (Lop) = Uint_0)
+         if Compile_Time_Known_Value (Rop)
+           and then Expr_Value (Rop) = Uint_0
+         then
+            Force_Evaluation (Lop);
+            Rewrite (N, Make_Integer_Literal (Loc, Uint_0));
+            Analyze_And_Resolve (N, Typ);
+            return;
+         end if;
+
+         if Compile_Time_Known_Value (Lop)
+           and then Expr_Value (Lop) = Uint_0
          then
+            Force_Evaluation (Rop);
             Rewrite (N, Make_Integer_Literal (Loc, Uint_0));
             Analyze_And_Resolve (N, Typ);
             return;
@@ -6497,6 +6506,7 @@ package body Exp_Ch4 is
         and then Compile_Time_Known_Value (Right)
         and then Expr_Value (Right) = Uint_1
       then
+         Force_Evaluation (Left);
          Rewrite (N, Make_Integer_Literal (Loc, 0));
          Analyze_And_Resolve (N, Typ);
          return;
diff --git a/gcc/testsuite/gnat.dg/exp0_eval.adb b/gcc/testsuite/gnat.dg/exp0_eval.adb
new file mode 100644
index 0000000..11edd7d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/exp0_eval.adb
@@ -0,0 +1,31 @@
+-- { dg-do run }
+with Interfaces; use Interfaces;
+procedure Exp0_Eval is
+
+   F_Count : Natural := 0;
+
+   function F return Integer is
+   begin
+      F_Count := F_Count + 1;
+      return 1;
+   end F;
+
+   function F return Unsigned_32 is
+   begin
+      F_Count := F_Count + 1;
+      return 1;
+   end F;
+
+   R : constant Integer :=
+     F ** 0 +
+     F * 0 +
+     0 * F +
+     Integer (Unsigned_32'(F) mod 1) +
+     Integer (Unsigned_32'(F) rem 1);
+   pragma Warnings (Off, R);
+begin
+   if F_Count /= 5 then
+      raise Program_Error
+        with "incorrect numbers of calls to F:" & F_Count'Img;
+   end if;
+end Exp0_Eval;
-- 
1.6.0.rc0.182.gb96c7