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
This commit is contained in:
Tobias Schlüter 2004-12-27 18:13:07 +01:00 committed by Tobias Schlüter
parent 201a97b479
commit e98a8b5b62
5 changed files with 65 additions and 26 deletions

View File

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

View File

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

View File

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

View File

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

View File

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