[gcc r10-11265] Fortran: simplification of NEAREST for large argument [PR109186]

[gcc r10-11265] Fortran: simplification of NEAREST for large argument [PR109186]

[Harald Anlauf]

https://gcc.gnu.org/g:b9f6e7e234bab6ef8b5425c3e8b88bf8dfbc5089

commit r10-11265-gb9f6e7e234bab6ef8b5425c3e8b88bf8dfbc5089
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Sun Mar 19 21:29:46 2023 +0100

    Fortran: simplification of NEAREST for large argument [PR109186]
    
    gcc/fortran/ChangeLog:
    
            PR fortran/109186
            * simplify.c (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.
    
    (cherry picked from commit 4410a08b80cc40342eeaa5b6af824cd4352b218c)

Diff:
---
 gcc/fortran/simplify.c                  |  2 +-
 gcc/testsuite/gfortran.dg/nearest_6.f90 | 26 ++++++++++++++++++++++++++
 2 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index fe4fee897f0..2cac5a4e168 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5958,7 +5958,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 00000000000..00d1ebe618c
--- /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