diff options
| author | jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-10-31 04:45:28 +0000 |
|---|---|---|
| committer | jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-10-31 04:45:28 +0000 |
| commit | c83d115e711bab71efbbcc0c1bb9fcb7e400b3e1 (patch) | |
| tree | c50ffbe822be02d7c44b1f0de55e15e5f92b027c /gcc/fortran/arith.c | |
| parent | 964cb6aaa9d51e8c633c35b0698e5835aa851514 (diff) | |
| download | gcc-c83d115e711bab71efbbcc0c1bb9fcb7e400b3e1.tar.gz | |
2008-10-30 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@141488 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/arith.c')
| -rw-r--r-- | gcc/fortran/arith.c | 18 |
1 files changed, 11 insertions, 7 deletions
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 34780b6fe03..2ef34b14a57 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -35,15 +35,19 @@ along with GCC; see the file COPYING3. If not see 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) { |