This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Fortran, Patch] PR 34192 - Fix compile-time evaluation of NEAREST
- From: Tobias Burnus <burnus at net-b dot de>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 23 Nov 2007 21:00:47 +0100
- Subject: [Fortran, Patch] PR 34192 - Fix compile-time evaluation of NEAREST
:ADDPATCH fortran:
We had several problems with the compile-time evaluation for NEAREST for
0.0 and subnormal numbers.
>From the standard:
-------------------- cut ---------------
"NEAREST (X, S)
Description. Returns the nearest different machine-representable number in a
given direction.
X shall be of type real.
S shall be of type real and not equal to zero.
Result Characteristics. Same as X.
Result Value. The result has a value equal to the machine-representable number
distinct from X and nearest to it in the direction of the infinity with the
same sign as S.
NOTE 13.16 Unlike other floating-point manipulation functions, NEAREST operates
on machine-representable numbers rather than model numbers. On many systems
there are machine-representable numbers that lie between adjacent model
numbers."
-------------------- cut ---------------
Problems:
a) gfortran gave an range error for the returned subnormal number
b) gfortran returned 0.0 as nearest number of 0.0, which is plainly wrong.
To (a): With the current patch, only for NaN an error is printed; one
might extend it to +/-INF if it is regarded as useful.
To (b): The fix was done in three steps:
1. Reverting to Steve's old patch
2. Fixing the returned result using Steve's suggestion
3. Fixing rounding of subnormal numbers
Thanks to Steve for the help! And to Paul Zimmermann, who send a similar
suggestion as Steve's for (2).
Build and regression tested on x86-64. OK for the trunk?
Tobias
PS: Any idea how to test for INF and NAN? If I do "0.0/0.0" I get a
compile-time error and -fno-range-check does not help. I cannot assign
to a variable first as otherwise NEAREST is not evaluated at compile time.
PPS: There seems to be a problem with the REAL(8) run-time version,
which returns wrong results for "NEAREST(subnormal, -1.0)". At least on
x86-64 Linux with glibc 2.6.1. See PR 34209.
2007-11-23 Tobias Burnus <burnus@net-b.de>
Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/34192
* simplify.c (gfc_simplify_nearest): Fix NEAREST for
subnormal numbers.
2007-11-23 Tobias Burnus <burnus@net-b.de>
PR fortran/34192
* gfortran.dg/nearest_2.f90: New.
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (Revision 130366)
+++ gcc/fortran/simplify.c (Arbeitskopie)
@@ -2691,8 +2691,8 @@ gfc_expr *
gfc_simplify_nearest (gfc_expr *x, gfc_expr *s)
{
gfc_expr *result;
- mpfr_t tmp;
- int sgn;
+ mp_exp_t emin, emax;
+ int kind;
if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
return NULL;
@@ -2707,13 +2707,39 @@ gfc_simplify_nearest (gfc_expr *x, gfc_e
gfc_set_model_kind (x->ts.kind);
result = gfc_copy_expr (x);
- sgn = mpfr_sgn (s->value.real);
- mpfr_init (tmp);
- mpfr_set_inf (tmp, sgn);
- mpfr_nexttoward (result->value.real, tmp);
- mpfr_clear (tmp);
+ /* Save current values of emin and emax. */
+ emin = mpfr_get_emin ();
+ emax = mpfr_get_emax ();
+
+ /* Set emin and emax for the current model number. */
+ kind = gfc_validate_kind (BT_REAL, x->ts.kind, 0);
+ mpfr_set_emin ((mp_exp_t) gfc_real_kinds[kind].min_exponent -
+ mpfr_get_prec(result->value.real) + 1);
+ mpfr_set_emax ((mp_exp_t) gfc_real_kinds[kind].max_exponent - 1);
+
+ if (mpfr_sgn (s->value.real) > 0)
+ {
+ mpfr_nextabove (result->value.real);
+ mpfr_subnormalize (result->value.real, 0, GMP_RNDU);
+ }
+ else
+ {
+ mpfr_nextbelow (result->value.real);
+ mpfr_subnormalize (result->value.real, 0, GMP_RNDD);
+ }
- return range_check (result, "NEAREST");
+ mpfr_set_emin (emin);
+ mpfr_set_emax (emax);
+
+ /* Only NaN can occur. Do not use range check as it gives an
+ error for denormal numbers. */
+ if (mpfr_nan_p (result->value.real) && gfc_option.flag_range_check)
+ {
+ gfc_error ("Result of NEAREST is NaN at %L", &result->where);
+ return &gfc_bad_expr;
+ }
+
+ return result;
}
Index: gcc/testsuite/gfortran.dg/nearest_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nearest_2.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/nearest_2.f90 (Revision 0)
@@ -0,0 +1,147 @@
+! { dg-do run }
+!
+! PR fortran/34192
+!
+! Test compile-time implementation of NEAREST
+!
+program test
+ implicit none
+
+! Single precision
+
+ ! 0+ > 0
+ if (nearest(0.0, 1.0) &
+ <= 0.0) &
+ call abort()
+ ! 0++ > 0+
+ if (nearest(nearest(0.0, 1.0), 1.0) &
+ <= nearest(0.0, 1.0)) &
+ call abort()
+ ! 0+++ > 0++
+ if (nearest(nearest(nearest(0.0, 1.0), 1.0), 1.0) &
+ <= nearest(nearest(0.0, 1.0), 1.0)) &
+ call abort()
+ ! 0+- = 0
+ if (nearest(nearest(0.0, 1.0), -1.0) &
+ /= 0.0) &
+ call abort()
+ ! 0++- = 0+
+ if (nearest(nearest(nearest(0.0, 1.0), 1.0), -1.0) &
+ /= nearest(0.0, 1.0)) &
+ call abort()
+ ! 0++-- = 0
+ if (nearest(nearest(nearest(nearest(0.0, 1.0), 1.0), -1.0), -1.0) &
+ /= 0.0) &
+ call abort()
+
+ ! 0- < 0
+ if (nearest(0.0, -1.0) &
+ >= 0.0) &
+ call abort()
+ ! 0-- < 0+
+ if (nearest(nearest(0.0, -1.0), -1.0) &
+ >= nearest(0.0, -1.0)) &
+ call abort()
+ ! 0--- < 0--
+ if (nearest(nearest(nearest(0.0, -1.0), -1.0), -1.0) &
+ >= nearest(nearest(0.0, -1.0), -1.0)) &
+ call abort()
+ ! 0-+ = 0
+ if (nearest(nearest(0.0, -1.0), 1.0) &
+ /= 0.0) &
+ call abort()
+ ! 0--+ = 0-
+ if (nearest(nearest(nearest(0.0, -1.0), -1.0), 1.0) &
+ /= nearest(0.0, -1.0)) &
+ call abort()
+ ! 0--++ = 0
+ if (nearest(nearest(nearest(nearest(0.0, -1.0), -1.0), 1.0), 1.0) &
+ /= 0.0) &
+ call abort()
+
+ ! 42++ > 42+
+ if (nearest(nearest(42.0, 1.0), 1.0) &
+ <= nearest(42.0, 1.0)) &
+ call abort()
+ ! 42-- < 42-
+ if (nearest(nearest(42.0, -1.0), -1.0) &
+ >= nearest(42.0, -1.0)) &
+ call abort()
+ ! 42-+ = 42
+ if (nearest(nearest(42.0, -1.0), 1.0) &
+ /= 42.0) &
+ call abort()
+ ! 42+- = 42
+ if (nearest(nearest(42.0, 1.0), -1.0) &
+ /= 42.0) &
+ call abort()
+
+! Double precision
+
+ ! 0+ > 0
+ if (nearest(0.0d0, 1.0) &
+ <= 0.0d0) &
+ call abort()
+ ! 0++ > 0+
+ if (nearest(nearest(0.0d0, 1.0), 1.0) &
+ <= nearest(0.0d0, 1.0)) &
+ call abort()
+ ! 0+++ > 0++
+ if (nearest(nearest(nearest(0.0d0, 1.0), 1.0), 1.0) &
+ <= nearest(nearest(0.0d0, 1.0), 1.0)) &
+ call abort()
+ ! 0+- = 0
+ if (nearest(nearest(0.0d0, 1.0), -1.0) &
+ /= 0.0d0) &
+ call abort()
+ ! 0++- = 0+
+ if (nearest(nearest(nearest(0.0d0, 1.0), 1.0), -1.0) &
+ /= nearest(0.0d0, 1.0)) &
+ call abort()
+ ! 0++-- = 0
+ if (nearest(nearest(nearest(nearest(0.0d0, 1.0), 1.0), -1.0), -1.0) &
+ /= 0.0d0) &
+ call abort()
+
+ ! 0- < 0
+ if (nearest(0.0d0, -1.0) &
+ >= 0.0d0) &
+ call abort()
+ ! 0-- < 0+
+ if (nearest(nearest(0.0d0, -1.0), -1.0) &
+ >= nearest(0.0d0, -1.0)) &
+ call abort()
+ ! 0--- < 0--
+ if (nearest(nearest(nearest(0.0d0, -1.0), -1.0), -1.0) &
+ >= nearest(nearest(0.0d0, -1.0), -1.0)) &
+ call abort()
+ ! 0-+ = 0
+ if (nearest(nearest(0.0d0, -1.0), 1.0) &
+ /= 0.0d0) &
+ call abort()
+ ! 0--+ = 0-
+ if (nearest(nearest(nearest(0.0d0, -1.0), -1.0), 1.0) &
+ /= nearest(0.0d0, -1.0)) &
+ call abort()
+ ! 0--++ = 0
+ if (nearest(nearest(nearest(nearest(0.0d0, -1.0), -1.0), 1.0), 1.0) &
+ /= 0.0d0) &
+ call abort()
+
+ ! 42++ > 42+
+ if (nearest(nearest(42.0d0, 1.0), 1.0) &
+ <= nearest(42.0d0, 1.0)) &
+ call abort()
+ ! 42-- < 42-
+ if (nearest(nearest(42.0d0, -1.0), -1.0) &
+ >= nearest(42.0d0, -1.0)) &
+ call abort()
+ ! 42-+ = 42
+ if (nearest(nearest(42.0d0, -1.0), 1.0) &
+ /= 42.0d0) &
+ call abort()
+ ! 42+- = 42
+ if (nearest(nearest(42.0d0, 1.0), -1.0) &
+ /= 42.0d0) &
+ call abort()
+end program test