diff options
author | Harald Anlauf <anlauf@gmx.de> | 2023-03-19 21:29:46 +0100 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2023-03-20 18:42:54 +0100 |
commit | 4410a08b80cc40342eeaa5b6af824cd4352b218c (patch) | |
tree | 71dfec6b27a7ed02ba053c3d69bff2ef9290a33b /gcc | |
parent | fbd50e867e6a782c7b56c9727bf7e1e74dae4b94 (diff) | |
download | gcc-4410a08b80cc40342eeaa5b6af824cd4352b218c.zip gcc-4410a08b80cc40342eeaa5b6af824cd4352b218c.tar.gz gcc-4410a08b80cc40342eeaa5b6af824cd4352b218c.tar.bz2 |
Fortran: simplification of NEAREST for large argument [PR109186]
gcc/fortran/ChangeLog:
PR fortran/109186
* simplify.cc (gfc_simplify_nearest): Fix off-by-one error in setting
up real kind-specific maximum exponent for mpfr.
gcc/testsuite/ChangeLog:
PR fortran/109186
* gfortran.dg/nearest_6.f90: New test.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/simplify.cc | 2 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/nearest_6.f90 | 26 |
2 files changed, 27 insertions, 1 deletions
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 20ea38e..ecf0e35 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -6114,7 +6114,7 @@ gfc_simplify_nearest (gfc_expr *x, gfc_expr *s) kind = gfc_validate_kind (BT_REAL, x->ts.kind, 0); mpfr_set_emin ((mpfr_exp_t) gfc_real_kinds[kind].min_exponent - mpfr_get_prec(result->value.real) + 1); - mpfr_set_emax ((mpfr_exp_t) gfc_real_kinds[kind].max_exponent - 1); + mpfr_set_emax ((mpfr_exp_t) gfc_real_kinds[kind].max_exponent); mpfr_check_range (result->value.real, 0, MPFR_RNDU); if (mpfr_sgn (s->value.real) > 0) diff --git a/gcc/testsuite/gfortran.dg/nearest_6.f90 b/gcc/testsuite/gfortran.dg/nearest_6.f90 new file mode 100644 index 0000000..00d1ebe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/nearest_6.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! PR fortran/109186 - Verify that NEAREST produces same results at +! compile-time and run-time for corner cases +! Reported by John Harper + +program p + implicit none + integer, parameter :: sp = selected_real_kind (6) + integer, parameter :: dp = selected_real_kind (13) + real(sp), parameter :: x1 = huge (1._sp), t1 = tiny (1._sp) + real(dp), parameter :: x2 = huge (1._dp), t2 = tiny (1._dp) + real(sp), volatile :: y1, z1 + real(dp), volatile :: y2, z2 + y1 = x1 + z1 = nearest (y1, -1._sp) + if (nearest (x1, -1._sp) /= z1) stop 1 + y2 = x2 + z2 = nearest (y2, -1._dp) + if (nearest (x2, -1._dp) /= z2) stop 2 + y1 = t1 + z1 = nearest (y1, 1._sp) + if (nearest (t1, 1._sp) /= z1) stop 3 + y2 = t2 + z2 = nearest (y2, 1._dp) + if (nearest (t2, 1._dp) /= z2) stop 4 +end |