re PR fortran/28276 (EXPONENT() broken for real constants)

	* configure.in: Check for GMP 4.1 or newer.  Check for MPFR 2.2.0 
	or newer.
	* configure: Regenerated.
	* doc/install.texi: Document required versions of GMP and MPFR.
	* fortran/arith.c: Conditionally include arctangent2().
	(gfc_check_real_range): Use mpfr_subnormalize in preference to local
	hack.
	* fortran/trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Append
	l for long double functions.
	* fortran/simplify.c: Wrap Copyright to new line.
	(gfc_simplify_atan2): Use mpfr_atan2 in preference to arctangent2().
        (gfc_simplify_log): Ditto.


	PR fortran/28276
	* fortran/simplify.c (gfc_simplify_exponent): Use mpfr_get_exp in
	preference to broken local hack.

	PR fortran/27021
	* fortran/simplify.c (gfc_simplify_nearest): Use mpfr_nexttoward and
	mpfr_subnormalize to handle numbers near zero in preference to broken
	 local hack.

	PR fortran/28276
	* testsuite/gfortran.dg/exponent_1.f90: New test.

	PR fortran/27021
	* testsuite/gfortran.dg/nearest_1.f90: New test.

From-SVN: r117257

1 files changed, 23 insertions, 4 deletions

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 766169f..53f1262 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -75,6 +75,7 @@ gfc_set_model (mpfr_t x)
   mpfr_set_default_prec (mpfr_get_prec (x));
 }
 
+#if !defined(MPFR_VERSION_MAJOR)
 /* Calculate atan2 (y, x)
 
 atan2(y, x) = atan(y/x)				if x > 0,
@@ -124,7 +125,7 @@ arctangent2 (mpfr_t y, mpfr_t x, mpfr_t result)
 
   mpfr_clear (t);
 }
-
+#endif
 
 /* Given an arithmetic error code, return a pointer to a string that
    explains the error.  */
@@ -407,6 +408,7 @@ gfc_check_real_range (mpfr_t p, int kind)
     }
   else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0)
     {
+#if !defined(MPFR_VERSION_MAJOR)
       /* MPFR operates on a number with a given precision and enormous
 	exponential range.  To represent subnormal numbers, the exponent is
 	allowed to become smaller than emin, but always retains the full
@@ -428,14 +430,31 @@ gfc_check_real_range (mpfr_t p, int kind)
       sprintf (s, "0.%sE%d", bin, (int) e);
       mpfr_set_str (q, s, gfc_real_kinds[i].radix, GMP_RNDN);
 
+      gfc_free (s);
+      gfc_free (bin);
+#else
+      mp_exp_t emin, emax;
+
+      /* Save current values of emin and emax.  */
+      emin = mpfr_get_emin ();
+      emax = mpfr_get_emax ();
+
+      /* Set emin and emax for the current model number.  */
+      mpfr_set_emin ((mp_exp_t) gfc_real_kinds[i].min_exponent - 1);
+      mpfr_set_emax ((mp_exp_t) gfc_real_kinds[i].max_exponent - 1);
+      mpfr_subnormalize (q, 0, GFC_RND_MODE);
+
+      /* Reset emin and emax.  */
+      mpfr_set_emin (emin);
+      mpfr_set_emax (emax);
+#endif
+
+      /* Copy sign if needed.  */
       if (mpfr_sgn (p) < 0)
 	mpfr_neg (p, q, GMP_RNDN);
       else
 	mpfr_set (p, q, GMP_RNDN);
 
-      gfc_free (s);
-      gfc_free (bin);
-
       retval = ARITH_OK;
     }
   else