From fa4cb42870df60deb8888dbd51e2ddc6d6ab9e6a Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 14 Apr 2023 20:45:19 +0200
Subject: [PATCH] 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.
---
 gcc/fortran/simplify.cc                      | 12 +++----
 gcc/testsuite/gfortran.dg/set_exponent_1.f90 | 36 ++++++++++++++++++++
 2 files changed, 42 insertions(+), 6 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/set_exponent_1.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index ecf0e3558df..b65854c1021 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 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
--
2.35.3