2006-06-18 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR fortran/19310
	* arith.c (gfc_range_check): Return ARITH_OK if -fno-range-check. Add
	return of ARITH_NAN, ARITH_UNDERFLOW, and ARITH_OVERFLOW.
	(gfc_arith_divide): If -fno-range-check allow mpfr to divide by zero.
	* gfortran.h (gfc_option_t): Add new flag.
	* invoke.texi: Document new flag.
	* lang.opt: Add option -frange-check.
	* options.c (gfc_init_options): Initialize new flag.
	(gfc_handle_options): Set flag if invoked.
	* simplify.c (range_check): Add error messages for
	overflow, underflow, and other errors.
	* trans-const.c (gfc_conv_mpfr_to_tree): Build NaN and Inf from mpfr
	result.


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

1 files changed, 20 insertions, 1 deletions

diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
index 936dd6459af..c1c96619715 100644
--- a/gcc/fortran/trans-const.c
+++ b/gcc/fortran/trans-const.c
@@ -209,11 +209,31 @@ gfc_conv_mpfr_to_tree (mpfr_t f, int kind)
   mp_exp_t exp;
   char *p, *q;
   int n;
+  REAL_VALUE_TYPE real;
 
   n = gfc_validate_kind (BT_REAL, kind, false);
 
   gcc_assert (gfc_real_kinds[n].radix == 2);
 
+  type = gfc_get_real_type (kind);
+
+  /* Take care of Infinity and NaN.  */
+  if (mpfr_inf_p (f))
+    {
+      real_inf (&real);
+      if (mpfr_sgn (f) < 0)
+	real = REAL_VALUE_NEGATE(real);
+      res = build_real (type , real);
+      return res;
+    }
+
+  if (mpfr_nan_p (f))
+    {
+      real_nan (&real, "", 0, TYPE_MODE (type));
+      res = build_real (type , real);
+      return res;
+    }
+
   /* mpfr chooses too small a number of hexadecimal digits if the
      number of binary digits is not divisible by four, therefore we
      have to explicitly request a sufficient number of digits here.  */
@@ -234,7 +254,6 @@ gfc_conv_mpfr_to_tree (mpfr_t f, int kind)
   else
     sprintf (q, "0x.%sp%d", p, (int) exp);
 
-  type = gfc_get_real_type (kind);
   res = build_real (type, REAL_VALUE_ATOF (q, TYPE_MODE (type)));
 
   gfc_free (q);