diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d1b20a73650f8760b88c035a605e7db00e86b027..7654b04ba8292207c120066f225e531dc5cd8b46 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,8 +1,3 @@
-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.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 56def1a7373d4d568f428c3682e8d990629aad9a..455dfb8c360db212569bb0136fe4258d10dfdcfd 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/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. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 929a3261fa9ac5e03632f0a3fbdfc539bc6cac11..7a23ee9368e991f6873ff2f67f1575813e224e96 100644
--- a/gcc/testsuite/ChangeLog
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6d44f451abe6e6bda1ccfe1d67c187e4f9b72f3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90
@@ -0,0 +1,37 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90
index 7050c2ccd5356c5cf48dc8e51eba8eadbe262169..4fdf42c37d7909c4c62397949f7bcc66b28a645b 100644
--- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mod_ulo.f90
+++ b/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/))