[Bug fortran/28276] EXPONENT() broken for real constants

["sgk at troutmask dot apl dot washington dot edu" <gcc-bugzilla at gcc dot gnu dot org>]

------- Comment #4 from sgk at troutmask dot apl dot washington dot edu  2006-07-17 18:11 -------
Subject: Re:  EXPONENT() broken for real constants

On Mon, Jul 17, 2006 at 05:54:46PM -0000, tobias dot burnus at physik dot
fu-berlin dot de wrote:
> 
> I see the same problem for real(8) and for real(10) as for real = real(4),
> except for
>    print *, scale (fraction (a),   exponent (a))   / a
> where I get "NaN" with real(10) instead of the correct "1.0", which one gets
> for real and real(8).
> 

Can you try this patch?  It required MPFR 2.2.0.


Index: gcc4x/gcc/fortran/simplify.c
===================================================================
--- gcc4x/gcc/fortran/simplify.c        (revision 115505)
+++ gcc4x/gcc/fortran/simplify.c        (working copy)
@@ -1049,12 +1049,10 @@ gfc_simplify_exp (gfc_expr * x)
   return range_check (result, "EXP");
 }

-/* FIXME:  MPFR should be able to do this better */
 gfc_expr *
 gfc_simplify_exponent (gfc_expr * x)
 {
   int i;
-  mpfr_t tmp;
   gfc_expr *result;

   if (x->expr_type != EXPR_CONSTANT)
@@ -1071,20 +1069,9 @@ gfc_simplify_exponent (gfc_expr * x)
       return result;
     }

-  mpfr_init (tmp);
-
-  mpfr_abs (tmp, x->value.real, GFC_RND_MODE);
-  mpfr_log2 (tmp, tmp, GFC_RND_MODE);
-
-  gfc_mpfr_to_mpz (result->value.integer, tmp);
-
-  /* The model number for tiny(x) is b**(emin - 1) where b is the base and
emin
-     is the smallest exponent value.  So, we need to add 1 if x is tiny(x). 
*/
-  i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
-  if (mpfr_cmp (x->value.real, gfc_real_kinds[i].tiny) == 0)
-    mpz_add_ui (result->value.integer,result->value.integer, 1);
-
-  mpfr_clear (tmp);
+  /* Requires MPFR 2.2.0 or newer.  */
+  i = (int) mpfr_get_exp (x->value.real);
+  mpz_set_si (result->value.integer, i);

   return range_check (result, "EXPONENT");
 }


-- 


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