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

["kargl at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>]

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

kargl at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Priority|P3                          |P4
             Status|UNCONFIRMED                 |ASSIGNED
   Last reconfirmed|                            |2012-02-28
                 CC|                            |kargl at gcc dot gnu.org
         AssignedTo|unassigned at gcc dot       |kargl at gcc dot gnu.org
                   |gnu.org                     |
     Ever Confirmed|0                           |1
      Known to fail|                            |4.2.5, 4.3.6, 4.4.7, 4.5.4,
                   |                            |4.6.3, 4.7.0

--- Comment #1 from kargl at gcc dot gnu.org 2012-02-28 16:11:10 UTC ---
Confirmed.  This fails on all versions of gfortran 4.2 and up.
I don't have a 4.1 version for testing.  I have a patch, but
as this is not a regression, I will not apply it until after
4.7.0 is released.

Tentative patch. Not regression tested, yet.

Index: simplify.c
===================================================================
--- simplify.c  (revision 184485)
+++ simplify.c  (working copy)
@@ -2331,35 +2331,16 @@ gfc_expr *
 gfc_simplify_fraction (gfc_expr *x)
 {
   gfc_expr *result;
-  mpfr_t absv, exp, pow2;
+  mpfr_exp_t e;

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

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

-  if (mpfr_sgn (x->value.real) == 0)
-    {
-      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
-      return result;
-    }
-
   gfc_set_model_kind (x->ts.kind);
-  mpfr_init (exp);
-  mpfr_init (absv);
-  mpfr_init (pow2);
-
-  mpfr_abs (absv, x->value.real, GFC_RND_MODE);
-  mpfr_log2 (exp, absv, GFC_RND_MODE);
-
-  mpfr_trunc (exp, exp);
-  mpfr_add_ui (exp, exp, 1, GFC_RND_MODE);
-
-  mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);
-
-  mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE);

-  mpfr_clears (exp, absv, pow2, NULL);
+  mpfr_frexp (&e, result->value.real, x->value.real, GFC_RND_MODE);

   return range_check (result, "FRACTION");
 }