re PR libfortran/19032 (modulo generates wrong result for divisor 1 and -1)

fortran/
PR fortran/19032
* trans-intrinsic.c (gfc_conv_intrinsic_mod): Update comment
in front of function to match the standard.  Correct handling
of MODULO.

testsuite/
PR fortran/19032
* gfortran.dg/intrinsic_modulo_1.f90: New.
* gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90: Add
tests with divisor -1.

From-SVN: r92645

gcc/fortran/ChangeLog

-2004-12-27  Andrew Pinski  <pinskia@physics.uc.edu>
-
-	* trans-expr.c (gfc_conv_cst_int_power): Only check for
-	flag_unsafe_math_optimizations if we have a float type.
-
 2004-12-27  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de> 
 
 	* trans-intrinsic.c (gfc_conv_intrinsic_ishft): Change to
@@ -11,6 +6,16 @@
 	4 bytes bits.  Convert 2nd and 3rd argument to 4 bytes.  Convert
 	result if width(arg 1) < 4 bytes.  Call fold.
 
+	PR fortran/19032
+	* trans-intrinsic.c (gfc_conv_intrinsic_mod): Update comment
+	in front of function to match the standard.  Correct handling
+	of MODULO.
+
+2004-12-27  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	* trans-expr.c (gfc_conv_cst_int_power): Only check for
+	flag_unsafe_math_optimizations if we have a float type.
+
 2004-12-23  Steven G. Kargl  <kargls@comcast.net>
 
 	* gfortran.texi: Fix typo.

gcc/fortran/trans-intrinsic.c

@@ -771,8 +771,8 @@ gfc_conv_intrinsic_cmplx (gfc_se * se, gfc_expr * expr, int both)
   se->expr = fold (build2 (COMPLEX_EXPR, type, real, imag));
 }
 
-/* Remainder function MOD(A, P) = A - INT(A / P) * P.
-   MODULO(A, P) = (A==0 .or. !(A>0 .xor. P>0))? MOD(A,P):MOD(A,P)+P.  */
+/* Remainder function MOD(A, P) = A - INT(A / P) * P
+                      MODULO(A, P) = A - FLOOR (A / P) * P  */
 /* TODO: MOD(x, 0)  */
 
 static void
@@ -783,7 +783,6 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
   tree type;
   tree itype;
   tree tmp;
-  tree zero;
   tree test;
   tree test2;
   mpfr_t huge;
@@ -798,7 +797,10 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
     {
     case BT_INTEGER:
       /* Integer case is easy, we've got a builtin op.  */
-      se->expr = build2 (TRUNC_MOD_EXPR, type, arg, arg2);
+      if (modulo)
+       se->expr = build2 (FLOOR_MOD_EXPR, type, arg, arg2);
+      else
+       se->expr = build2 (TRUNC_MOD_EXPR, type, arg, arg2);
       break;
 
     case BT_REAL:
@@ -821,7 +823,10 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
       test2 = build2 (TRUTH_AND_EXPR, boolean_type_node, test, test2);
 
       itype = gfc_get_int_type (expr->ts.kind);
-      tmp = build_fix_expr (&se->pre, tmp, itype, FIX_TRUNC_EXPR);
+      if (modulo)
+       tmp = build_fix_expr (&se->pre, tmp, itype, FIX_FLOOR_EXPR);
+      else
+       tmp = build_fix_expr (&se->pre, tmp, itype, FIX_TRUNC_EXPR);
       tmp = convert (type, tmp);
       tmp = build3 (COND_EXPR, type, test2, tmp, arg);
       tmp = build2 (MULT_EXPR, type, tmp, arg2);
@@ -832,22 +837,6 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
     default:
       gcc_unreachable ();
     }
-
-  if (modulo)
-    {
-     zero = gfc_build_const (type, integer_zero_node);
-     /* Build !(A > 0 .xor. P > 0).  */
-     test = build2 (GT_EXPR, boolean_type_node, arg, zero);
-     test2 = build2 (GT_EXPR, boolean_type_node, arg2, zero);
-     test = build2 (TRUTH_XOR_EXPR, boolean_type_node, test, test2);
-     test = build1 (TRUTH_NOT_EXPR, boolean_type_node, test);
-     /* Build (A == 0) .or. !(A > 0 .xor. P > 0).  */
-     test2 = build2 (EQ_EXPR, boolean_type_node, arg, zero);
-     test = build2 (TRUTH_OR_EXPR, boolean_type_node, test, test2);
-
-     se->expr = build3 (COND_EXPR, type, test, se->expr, 
-			build2 (PLUS_EXPR, type, se->expr, arg2));
-    }
 }
 
 /* Positive difference DIM (x, y) = ((x - y) < 0) ? 0 : x - y.  */

gcc/testsuite/ChangeLog

@@ -2,6 +2,11 @@
 
 	* gfortran.dg/g77/f90-intrinsic-bit.f: New.
 
+	PR fortran/19032
+	* gfortran.dg/intrinsic_modulo_1.f90: New.
+	* gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90: Add
+	tests with divisor -1.
+
 2004-12-27  Mark Mitchell  <mark@codesourcery.com>
 
 	PR c++/19148

gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90

+! { dg-do run }
+! testcase from PR 19032 adapted for testsuite
+! Our implementation of modulo was wrong for P = 1 and P = -1,
+! both in the real and the integer case
+program main
+  integer, parameter :: n=16
+  real, dimension(n) :: ar, br, modulo_result, floor_result
+  integer, dimension(n) :: ai, bi , imodulo_result, ifloor_result
+
+  ai(1:4) = 5
+  ai(5:8) = -5
+  ai(9:12) = 1
+  ai(13:16) = -1
+  bi(1:4) = (/ 3,-3, 1, -1/)
+  bi(5:8) = bi(1:4)
+  bi(9:12) = bi(1:4)
+  bi(13:16) = bi(1:4)
+  ar = ai
+  br = bi
+  modulo_result = modulo(ar,br)
+  imodulo_result = modulo(ai,bi)
+  floor_result = ar-floor(ar/br)*br
+  ifloor_result = nint(real(ai-floor(real(ai)/real(bi))*bi))
+
+  do i=1,n
+     if (modulo_result(i) /= floor_result(i) ) then
+!        print "(A,4F5.0)" ,"real case failed: ", &
+!             ar(i),br(i), modulo_result(i), floor_result(i)
+        call abort()
+    end if
+    if (imodulo_result(i) /= ifloor_result(i)) then
+!       print "(A,4I5)", "int case failed: ", &
+!            ai(i), bi(i), imodulo_result(i), ifloor_result(i)
+       call abort ()
+     end if
+  end do
+end program main

gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90

@@ -47,16 +47,19 @@ program mod_modulotest
    call integertest ((/-8, 5/), (/-3, 2/))
    call integertest ((/8, -5/), (/3, -2/))
    call integertest ((/-8, -5/), (/-3, -3/))
+   call integertest ((/ 2, -1/), (/0, 0/))
 
    call real4test ((/3.0, 2.5/), (/0.5, 0.5/))
    call real4test ((/-3.0, 2.5/), (/-0.5, 2.0/))
    call real4test ((/3.0, -2.5/), (/0.5, -2.0/))
    call real4test ((/-3.0, -2.5/), (/-0.5, -0.5/))
+   call real4test ((/ 2.0, -1.0/), (/ 0.0, 0.0 /))
 
    call real8test ((/3.0_8, 2.5_8/), (/0.5_8, 0.5_8/))
    call real8test ((/-3.0_8, 2.5_8/), (/-0.5_8, 2.0_8/))
    call real8test ((/3.0_8, -2.5_8/), (/0.5_8, -2.0_8/))
    call real8test ((/-3.0_8, -2.5_8/), (/-0.5_8, -0.5_8/))
+   call real8test ((/ 2.0_8, -1.0_8/), (/ 0.0_8, 0.0_8 /))
    
    ! Check large numbers
    call real4test ((/2e34, 1.0/), (/0.0, 0.0/))