* 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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@117257 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 116 insertions, 27 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e6860a63b7b..08de524a63d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,24 @@
+2006-09-27  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* arith.c: Conditionally include arctangent2().
+	(gfc_check_real_range): Use mpfr_subnormalize in preference to local
+	hack.
+	* trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Append
+	l for long double functions.
+	* simplify.c: Wrap Copyright to new line.
+	(gfc_simplify_atan2): Use mpfr_atan2 in preference to arctangent2().
+        (gfc_simplify_log): Ditto.
+
+
+	PR fortran/28276
+	* simplify.c (gfc_simplify_exponent): Use mpfr_get_exp in
+	preference to broken local hack.
+
+	PR fortran/27021
+	* simplify.c (gfc_simplify_nearest): Use mpfr_nexttoward and
+	mpfr_subnormalize to handle numbers near zero in preference to broken
+	 local hack.
+
 2006-09-26  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/29097
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 766169fa6e1..53f1262f9af 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
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 48d8e6beab9..c448db6f8b7 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -1,6 +1,6 @@
 /* Simplify intrinsic functions at compile-time.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
-   Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught & Katherine Holcomb
 
 This file is part of GCC.
@@ -607,7 +607,11 @@ gfc_simplify_atan2 (gfc_expr * y, gfc_expr * x)
       return &gfc_bad_expr;
     }
 
+#if !defined(MPFR_VERSION_MAJOR)
   arctangent2 (y->value.real, x->value.real, result->value.real);
+#else
+  mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE);
+#endif
 
   return range_check (result, "ATAN2");
 }
@@ -1054,9 +1058,12 @@ gfc_expr *
 gfc_simplify_exponent (gfc_expr * x)
 {
   int i;
-  mpfr_t tmp;
   gfc_expr *result;
 
+#if !defined(MPFR_VERSION_MAJOR)
+  mpfr_t tmp;
+#endif
+
   if (x->expr_type != EXPR_CONSTANT)
     return NULL;
 
@@ -1071,6 +1078,9 @@ gfc_simplify_exponent (gfc_expr * x)
       return result;
     }
 
+#if !defined(MPFR_VERSION_MAJOR)
+  /* PR fortran/28276 suffers from a buggy MPFR, and this block of code
+     does not function correctly.  */
   mpfr_init (tmp);
 
   mpfr_abs (tmp, x->value.real, GFC_RND_MODE);
@@ -1085,6 +1095,11 @@ gfc_simplify_exponent (gfc_expr * x)
     mpz_add_ui (result->value.integer,result->value.integer, 1);
 
   mpfr_clear (tmp);
+#else
+  /* Requires MPFR 2.2.0 or newer.  */
+  i = (int) mpfr_get_exp (x->value.real);
+  mpz_set_si (result->value.integer, i);
+#endif
 
   return range_check (result, "EXPONENT");
 }
@@ -2146,8 +2161,13 @@ gfc_simplify_log (gfc_expr * x)
       mpfr_init (xr);
       mpfr_init (xi);
 
-      arctangent2 (x->value.complex.i, x->value.complex.r,
-	           result->value.complex.i);
+#if !defined(MPFR_VERSION_MAJOR)
+      arctangent2 (x->value.complex.i, x->value.complex.r, result->value.complex.i);
+#else
+      mpfr_atan2 (result->value.complex.i, x->value.complex.i, x->value.complex.r,
+		  GFC_RND_MODE);
+#endif
+
 
       mpfr_mul (xr, x->value.complex.r, x->value.complex.r, GFC_RND_MODE);
       mpfr_mul (xi, x->value.complex.i, x->value.complex.i, GFC_RND_MODE);
@@ -2474,27 +2494,28 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
 {
   gfc_expr *result;
   mpfr_t tmp;
-  int direction, sgn;
+  int sgn;
+#if !defined(MPFR_VERSION_MAJOR)
+  int direction;
+#else
+  mp_exp_t emin, emax;
+#endif
 
   if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  gfc_set_model_kind (x->ts.kind);
-  result = gfc_copy_expr (x);
-
-  direction = mpfr_sgn (s->value.real);
-
-  if (direction == 0)
+  if (mpfr_sgn (s->value.real) == 0)
     {
-      gfc_error ("Second argument of NEAREST at %L may not be zero",
-		 &s->where);
-      gfc_free (result);
+      gfc_error ("Second argument of NEAREST at %L shall not be zero", &s->where);
       return &gfc_bad_expr;
     }
 
-  /* TODO: Use mpfr_nextabove and mpfr_nextbelow once we move to a
-     newer version of mpfr.  */
+  gfc_set_model_kind (x->ts.kind);
+  result = gfc_copy_expr (x);
+
+#if !defined(MPFR_VERSION_MAJOR)
 
+  direction = mpfr_sgn (s->value.real);
   sgn = mpfr_sgn (x->value.real);
 
   if (sgn == 0)
@@ -2539,6 +2560,28 @@ gfc_simplify_nearest (gfc_expr * x, gfc_expr * s)
       if (sgn < 0)
 	mpfr_neg (result->value.real, result->value.real, GFC_RND_MODE);
     }
+#else
+
+  /* Save current values of emin and emax.  */
+  emin = mpfr_get_emin ();
+  emax = mpfr_get_emax ();
+
+  /* Set emin and emax for the current model number.  */
+  sgn = gfc_validate_kind (BT_REAL, x->ts.kind, 0);
+  mpfr_set_emin ((mp_exp_t) gfc_real_kinds[sgn].min_exponent - 1);
+  mpfr_set_emax ((mp_exp_t) gfc_real_kinds[sgn].max_exponent - 1);
+
+  sgn = mpfr_sgn (s->value.real); 
+  mpfr_init (tmp);
+  mpfr_set_inf (tmp, sgn);
+  mpfr_nexttoward (result->value.real, tmp);
+  mpfr_subnormalize (result->value.real, 0, GFC_RND_MODE);
+ 
+  mpfr_set_emin (emin);
+  mpfr_set_emax (emax);
+ 
+  mpfr_clear(tmp);
+#endif
 
   return range_check (result, "NEAREST");
 }
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index cef767d40d6..facc15a739a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -590,12 +590,18 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
 
   if (m->libm_name)
     {
-      gcc_assert (ts->kind == 4 || ts->kind == 8 || ts->kind == 10
-                 || ts->kind == 16);
-      snprintf (name, sizeof (name), "%s%s%s",
-		ts->type == BT_COMPLEX ? "c" : "",
-		m->name,
-		ts->kind == 4 ? "f" : "");
+      if (ts->kind == 4)
+	snprintf (name, sizeof (name), "%s%s%s",
+		ts->type == BT_COMPLEX ? "c" : "", m->name, "f");
+      else if (ts->kind == 8)
+	snprintf (name, sizeof (name), "%s%s",
+		ts->type == BT_COMPLEX ? "c" : "", m->name);
+      else
+	{
+	  gcc_assert (ts->kind == 10 || ts->kind == 16);
+	  snprintf (name, sizeof (name), "%s%s%s",
+		ts->type == BT_COMPLEX ? "c" : "", m->name, "l");
+	}
     }
   else
     {