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:
parent
201a97b479
commit
e98a8b5b62
@ -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.
|
||||
|
@ -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. */
|
||||
|
@ -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
|
||||
|
37
gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90
Normal file
37
gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90
Normal 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
|
@ -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/))
|
||||
|
Loading…
Reference in New Issue
Block a user