[Bug fortran/52413] Incorrect behavior of FRACTION when applied to a constant

[fxcoudert at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52413

--- Comment #6 from Francois-Xavier Coudert <fxcoudert at gcc dot gnu.org> ---
The current patch is also lacking handling of the sign if signed zero is used.
This should do the trick:


   if (mpfr_sgn (x->value.real) == 0)
     {
-      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
       return result;
     }


Using mpfr_frexp() is a good idea, and probably a gain in the long term (easier
maintenance), so we may wrap it inside version checks. Tentative patch:


Index: simplify.c
===================================================================
--- simplify.c    (revision 200350)
+++ simplify.c    (working copy)
@@ -2342,16 +2342,25 @@ gfc_expr *
 gfc_simplify_fraction (gfc_expr *x)
 {
   gfc_expr *result;
+
+#if MPFR_VERSION < MPFR_VERSION_NUM(3,1,0)
   mpfr_t absv, exp, pow2;
+#else
+  mpfr_exp_t e;
+#endif

   if (x->expr_type != EXPR_CONSTANT)
     return NULL;

   result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);

+#if MPFR_VERSION < MPFR_VERSION_NUM(3,1,0)
+
+  /* MPFR versions before 3.1.0 do not include mpfr_frexp.  */
+
   if (mpfr_sgn (x->value.real) == 0)
     {
-      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
       return result;
     }

@@ -2369,9 +2378,17 @@ gfc_simplify_fraction (gfc_expr *x)
   mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);

   mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE);
+  mpfr_copysign (result->value.real, result->value.real,
+         x->value.real, GFC_RND_MODE);

   mpfr_clears (exp, absv, pow2, NULL);

+#else
+
+  mpfr_frexp (&e, result->value.real, x->value.real, GFC_RND_MODE);
+
+#endif
+
   return range_check (result, "FRACTION");
 }



However, I don't have a machine set up for bootstrapping (and regtesting) this
change. I just happened to pass by here :)