OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/37930 (gfortran error and ICE at automatic type conversion with transfer intrinsic) 

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.

From-SVN: r141488
This commit is contained in:
Steven G. Kargl 2008-10-31 04:45:28 +00:00 committed by Jerry DeLisle
parent 98d53624ea
commit 7278e4dcfb
4 changed files with 29 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
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
2008-10-30 Mikael Morin <mikael.morin@tele2.fr>
PR fortran/37903

18
gcc/fortran/arith.c
View File

@ -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)
{

2
gcc/fortran/arith.h
View File

@ -27,7 +27,7 @@ along with GCC; see the file COPYING3. If not see
/* 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);

10
gcc/fortran/simplify.c
View File

@ -808,7 +808,7 @@ gfc_simplify_ceiling (gfc_expr *e, gfc_expr *k)
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_expr *k)
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_expr *e, gfc_expr *k)
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);