[PATCH] PR fortran/37930 -- updated patch for conversion NaN,Inf to integer

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

Here's an updated patch.  It changes the error message to 
in accordance with Tobias comment.  The bad <tab> was 
replaced by 4 spaces.  Additionally, I've removed an old
kludge needed for MPFR 2.0.1 and older.  The patch has
passed a regression test on x86_64-*-*freebsd8.0.

2008-10-27  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/37930
	* gfortran.dg/int_conv_2.f90:  New test.


2008-10-27  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/37930
	* fortran/arith.c (gfc_mpfr_to_mpz):  Test for NaN and Inf values.
	Remove stale comment and kludge code for MPFR 2.0.1 and older.
	(gfc_real2int): Error on conversion of NaN or Inf.
	(gfc_complex2int): Ditto.
	* fortran/arith.h: Update mpfr_to_mpz prototype.
	* fortran/simplify.c (gfc_simplify_ceiling, gfc_simplify_floor,
	gfc_simplify_ifix, gfc_simplify_idint, simplify_nint): Update function
	calls to include locus

-- 
Steve

Index: arith.c
===================================================================
--- arith.c	(revision 141346)
+++ arith.c	(working copy)
@@ -35,15 +35,19 @@ along with GCC; see the file COPYING3.  
    It's easily implemented with a few calls though.  */
 
 void
-gfc_mpfr_to_mpz (mpz_t z, mpfr_t x)
+gfc_mpfr_to_mpz (mpz_t z, mpfr_t x, locus *where)
 {
   mp_exp_t e;
 
+  if (mpfr_inf_p (x) || mpfr_nan_p (x))
+    {
+      gfc_error ("Conversion of an Infinity or Not-a-Number at %L "
+		 "to INTEGER", where);
+      mpz_set_ui (z, 0);
+      return;
+    }
+
   e = mpfr_get_z_exp (z, x);
-  /* MPFR 2.0.1 (included with GMP 4.1) has a bug whereby mpfr_get_z_exp
-     may set the sign of z incorrectly.  Work around that here.  */
-  if (mpfr_sgn (x) != mpz_sgn (z))
-    mpz_neg (z, z);
 
   if (e > 0)
     mpz_mul_2exp (z, z, e);
@@ -2177,7 +2181,7 @@ gfc_real2int (gfc_expr *src, int kind)
 
   result = gfc_constant_result (BT_INTEGER, kind, &src->where);
 
-  gfc_mpfr_to_mpz (result->value.integer, src->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, src->value.real, &src->where);
 
   if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK)
     {
@@ -2263,7 +2267,7 @@ gfc_complex2int (gfc_expr *src, int kind
 
   result = gfc_constant_result (BT_INTEGER, kind, &src->where);
 
-  gfc_mpfr_to_mpz (result->value.integer, src->value.complex.r);
+  gfc_mpfr_to_mpz (result->value.integer, src->value.complex.r, &src->where);
 
   if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK)
     {
Index: arith.h
===================================================================
--- arith.h	(revision 141346)
+++ arith.h	(working copy)
@@ -27,7 +27,7 @@ along with GCC; see the file COPYING3.  
 /* MPFR also does not have the conversion of a mpfr_t to a mpz_t, so declare
    a function for this as well.  */
 
-void gfc_mpfr_to_mpz (mpz_t, mpfr_t);
+void gfc_mpfr_to_mpz (mpz_t, mpfr_t, locus *);
 void gfc_set_model_kind (int);
 void gfc_set_model (mpfr_t);
 
Index: simplify.c
===================================================================
--- simplify.c	(revision 141346)
+++ simplify.c	(working copy)
@@ -808,7 +808,7 @@ gfc_simplify_ceiling (gfc_expr *e, gfc_e
   ceil = gfc_copy_expr (e);
 
   mpfr_ceil (ceil->value.real, e->value.real);
-  gfc_mpfr_to_mpz (result->value.integer, ceil->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, ceil->value.real, &e->where);
 
   gfc_free_expr (ceil);
 
@@ -1341,7 +1341,7 @@ gfc_simplify_floor (gfc_expr *e, gfc_exp
   mpfr_init (floor);
   mpfr_floor (floor, e->value.real);
 
-  gfc_mpfr_to_mpz (result->value.integer, floor);
+  gfc_mpfr_to_mpz (result->value.integer, floor, &e->where);
 
   mpfr_clear (floor);
 
@@ -1925,7 +1925,7 @@ gfc_simplify_ifix (gfc_expr *e)
   rtrunc = gfc_copy_expr (e);
 
   mpfr_trunc (rtrunc->value.real, e->value.real);
-  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real, &e->where);
 
   gfc_free_expr (rtrunc);
   return range_check (result, "IFIX");
@@ -1946,7 +1946,7 @@ gfc_simplify_idint (gfc_expr *e)
   rtrunc = gfc_copy_expr (e);
 
   mpfr_trunc (rtrunc->value.real, e->value.real);
-  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real, &e->where);
 
   gfc_free_expr (rtrunc);
   return range_check (result, "IDINT");
@@ -2969,7 +2969,7 @@ simplify_nint (const char *name, gfc_exp
 
   mpfr_round (itrunc->value.real, e->value.real);
 
-  gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real);
+  gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real, &e->where);
 
   gfc_free_expr (itrunc);