[gcc r10-11289] Fortran: fix compile-time simplification of SET_EXPONENT [PR109511]

[gcc r10-11289] Fortran: fix compile-time simplification of SET_EXPONENT [PR109511]

[Harald Anlauf]

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

commit r10-11289-gdd2cd1e70509aaeb3db3e7b322d8357bac817632
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Fri Apr 14 20:45:19 2023 +0200

    Fortran: fix compile-time simplification of SET_EXPONENT [PR109511]
    
    gcc/fortran/ChangeLog:
    
            PR fortran/109511
            * simplify.c (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.
    
    (cherry picked from commit fa4cb42870df60deb8888dbd51e2ddc6d6ab9e6a)

Diff:
---
 gcc/fortran/simplify.c                       | 12 +++++-----
 gcc/testsuite/gfortran.dg/set_exponent_1.f90 | 36 ++++++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 2cac5a4e168..cb6f2404c0b 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -7196,7 +7196,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;
@@ -7228,19 +7228,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 00000000000..4c063e8330b
--- /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