exp_ch4.adb (Expand_N_Op_Expon): Force evaluation of left argument even when right argument is 0.

2008-08-10  Samuel Tardieu  <sam@rfc1149.net>
            Robert Dewar <dewar@adacore.com>
    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.

2008-08-10  Samuel Tardieu  <sam@rfc1149.net>
    gcc/testsuite/
	* gnat.dg/exp0_eval.adb: New.

Co-Authored-By: Robert Dewar <dewar@adacore.com>

From-SVN: r138934

4 files changed, 92 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bcdcda7..41a7647 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2008-08-10  Samuel Tardieu  <sam@rfc1149.net>
+            Robert Dewar <dewar@adacore.com>
+
+	* 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.
+
 2008-08-09  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
 
 	* gcc-interface/misc.c (gnat_handle_option): Replace set_Wunused
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d4c0407..2f95a84 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5471,6 +5471,13 @@ package body Exp_Ch4 is
             --  X ** 0 = 1 (or 1.0)
 
             if Expv = 0 then
+
+               --  Call Remove_Side_Effects to ensure that any side effects
+               --  in the ignored left operand (in particular function calls
+               --  to user defined functions) are properly executed.
+
+               Remove_Side_Effects (Base);
+
                if Ekind (Typ) in Integer_Kind then
                   Xnode := Make_Integer_Literal (Loc, Intval => 1);
                else
@@ -5945,6 +5952,12 @@ package body Exp_Ch4 is
            and then Compile_Time_Known_Value (Right)
            and then Expr_Value (Right) = Uint_1
          then
+            --  Call Remove_Side_Effects to ensure that any side effects in
+            --  the ignored left operand (in particular function calls to
+            --  user defined functions) are properly executed.
+
+            Remove_Side_Effects (Left);
+
             Rewrite (N, Make_Integer_Literal (Loc, 0));
             Analyze_And_Resolve (N, Typ);
             return;
@@ -5993,17 +6006,17 @@ package body Exp_Ch4 is
    --------------------------
 
    procedure Expand_N_Op_Multiply (N : Node_Id) is
-      Loc  : constant Source_Ptr := Sloc (N);
-      Lop  : constant Node_Id    := Left_Opnd (N);
-      Rop  : constant Node_Id    := Right_Opnd (N);
+      Loc : constant Source_Ptr := Sloc (N);
+      Lop : constant Node_Id    := Left_Opnd (N);
+      Rop : constant Node_Id    := Right_Opnd (N);
 
-      Lp2  : constant Boolean :=
-               Nkind (Lop) = N_Op_Expon
-                 and then Is_Power_Of_2_For_Shift (Lop);
+      Lp2 : constant Boolean :=
+              Nkind (Lop) = N_Op_Expon
+                and then Is_Power_Of_2_For_Shift (Lop);
 
-      Rp2  : constant Boolean :=
-               Nkind (Rop) = N_Op_Expon
-                 and then Is_Power_Of_2_For_Shift (Rop);
+      Rp2 : constant Boolean :=
+              Nkind (Rop) = N_Op_Expon
+                and then Is_Power_Of_2_For_Shift (Rop);
 
       Ltyp : constant Entity_Id  := Etype (Lop);
       Rtyp : constant Entity_Id  := Etype (Rop);
@@ -6016,14 +6029,28 @@ package body Exp_Ch4 is
 
       if Is_Integer_Type (Typ) then
 
-         --  N * 0 = 0 * N = 0 for integer types
+         --  N * 0 = 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
+            --  Call Remove_Side_Effects to ensure that any side effects in
+            --  the ignored left operand (in particular function calls to
+            --  user defined functions) are properly executed.
+
+            Remove_Side_Effects (Lop);
+
+            Rewrite (N, Make_Integer_Literal (Loc, Uint_0));
+            Analyze_And_Resolve (N, Typ);
+            return;
+         end if;
+
+         --  Similar handling for 0 * N = 0
+
+         if Compile_Time_Known_Value (Lop)
+           and then Expr_Value (Lop) = Uint_0
+         then
+            Remove_Side_Effects (Rop);
             Rewrite (N, Make_Integer_Literal (Loc, Uint_0));
             Analyze_And_Resolve (N, Typ);
             return;
@@ -6502,6 +6529,12 @@ package body Exp_Ch4 is
         and then Compile_Time_Known_Value (Right)
         and then Expr_Value (Right) = Uint_1
       then
+         --  Call Remove_Side_Effects to ensure that any side effects in the
+         --  ignored left operand (in particular function calls to user defined
+         --  functions) are properly executed.
+
+         Remove_Side_Effects (Left);
+
          Rewrite (N, Make_Integer_Literal (Loc, 0));
          Analyze_And_Resolve (N, Typ);
          return;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2ebd473..002ffaf 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2008-08-10  Samuel Tardieu  <sam@rfc1149.net>
+
+	* gnat.dg/exp0_eval.adb: New.
+
 2008-08-10  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
 
 	PR middle-end/20644
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;