diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2023-04-14 20:45:19 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2023-04-14 20:50:02 +0200 |
| commit | fa4cb42870df60deb8888dbd51e2ddc6d6ab9e6a (patch) | |
| tree | 59e44f0a3f40031dd7c72d9aa5b3af0359e567ca | |
| parent | 94a21e008c4778e446321b1355f61abc75a076be (diff) | |
| download | gcc-fa4cb42870df60deb8888dbd51e2ddc6d6ab9e6a.zip gcc-fa4cb42870df60deb8888dbd51e2ddc6d6ab9e6a.tar.gz gcc-fa4cb42870df60deb8888dbd51e2ddc6d6ab9e6a.tar.bz2 | |
Fortran: fix compile-time simplification of SET_EXPONENT [PR109511]
gcc/fortran/ChangeLog:
PR fortran/109511
* simplify.cc (gfc_simplify_set_exponent): Fix implementation of
compile-time simplification of intrinsic SET_EXPONENT for argument
X < 1 and for I < 0.
gcc/testsuite/ChangeLog:
PR fortran/109511
* gfortran.dg/set_exponent_1.f90: New test.
| -rw-r--r-- | gcc/fortran/simplify.cc | 12 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/set_exponent_1.f90 | 36 |
2 files changed, 42 insertions, 6 deletions
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index ecf0e35..b65854c 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -7364,7 +7364,7 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) { gfc_expr *result; mpfr_t exp, absv, log2, pow2, frac; - unsigned long exp2; + long exp2; if (x->expr_type != EXPR_CONSTANT || i->expr_type != EXPR_CONSTANT) return NULL; @@ -7396,19 +7396,19 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) mpfr_abs (absv, x->value.real, GFC_RND_MODE); mpfr_log2 (log2, absv, GFC_RND_MODE); - mpfr_trunc (log2, log2); + mpfr_floor (log2, log2); mpfr_add_ui (exp, log2, 1, GFC_RND_MODE); /* Old exponent value, and fraction. */ mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE); - mpfr_div (frac, absv, pow2, GFC_RND_MODE); + mpfr_div (frac, x->value.real, pow2, GFC_RND_MODE); /* New exponent. */ - exp2 = (unsigned long) mpz_get_d (i->value.integer); - mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE); + exp2 = mpz_get_si (i->value.integer); + mpfr_mul_2si (result->value.real, frac, exp2, GFC_RND_MODE); - mpfr_clears (absv, log2, pow2, frac, NULL); + mpfr_clears (absv, log2, exp, pow2, frac, NULL); return range_check (result, "SET_EXPONENT"); } diff --git a/gcc/testsuite/gfortran.dg/set_exponent_1.f90 b/gcc/testsuite/gfortran.dg/set_exponent_1.f90 new file mode 100644 index 0000000..4c063e8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/set_exponent_1.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! PR fortran/109511 +! Check compile-time simplification of SET_EXPONENT against runtime + +program exponent + implicit none + integer :: i + i = 0 + print *, i, set_exponent(1., 0), set_exponent(1., i) + if (set_exponent(1., 0) /= set_exponent(1., i)) stop 1 + i = 1 + print *, i, set_exponent(1., 1), set_exponent(1., i) + if (set_exponent(1., 1) /= set_exponent(1., i)) stop 2 + i = 2 + print *, i, set_exponent(-1.75, 2), set_exponent(-1.75, i) + if (set_exponent(-1.75, 2) /= set_exponent(-1.75, i)) stop 3 + print *, i, set_exponent(0.1875, 2), set_exponent(0.1875, i) + if (set_exponent(0.1875, 2) /= set_exponent(0.1875, i)) stop 4 + i = 3 + print *, i, set_exponent(0.75, 3), set_exponent(0.75, i) + if (set_exponent(0.75, 3) /= set_exponent(0.75, i)) stop 5 + i = 4 + print *, i, set_exponent(-2.5, 4), set_exponent(-2.5, i) + if (set_exponent(-2.5, 4) /= set_exponent(-2.5, i)) stop 6 + i = -1 + print *, i, set_exponent(1., -1), set_exponent(1., i) + if (set_exponent(1., -1) /= set_exponent(1., i)) stop 7 + i = -2 + print *, i, set_exponent(1.125, -2), set_exponent(1.125, i) + if (set_exponent(1.125, -2) /= set_exponent(1.125, i)) stop 8 + print *, i, set_exponent(-0.25, -2), set_exponent(-0.25, i) + if (set_exponent(-0.25, -2) /= set_exponent(-0.25, i)) stop 9 + i = -3 + print *, i, set_exponent(0.75, -3), set_exponent(0.75, i) + if (set_exponent(0.75, -3) /= set_exponent(0.75, i)) stop 10 +end program exponent |