Skip to content

R
riscv-gcc-1
Commit d2af8cc6 by François-Xavier Coudert
Options

re PR fortran/48979 (FRACTION und EXPONENT return invalid results for infinity/NaN) 

	PR fortran/48979

	* simplify.c (gfc_simplify_atan): Use mpfr_zero_p to check for zeros.
	(gfc_simplify_log): Likewise.
	(gfc_simplify_scale): Likewise.
	(gfc_simplify_exponent): Handle infinities and NaNs.
	(gfc_simplify_fraction): Handle infinities.
	(gfc_simplify_rrspacing): Handle signed zeros and NaNs.
	(gfc_simplify_set_exponent): Handle infinities and NaNs.
	(gfc_simplify_spacing): Handle zeros, infinities and NaNs.

	* gfortran.dg/ieee/intrinsics_1.f90: New test.

From-SVN: r216120
parent f3ca7111
Showing with 148 additions and 19 deletions
gcc/fortran/ChangeLog
2014-10-11 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/48979
* simplify.c (gfc_simplify_atan): Use mpfr_zero_p to check for zeros.
(gfc_simplify_log): Likewise.
(gfc_simplify_scale): Likewise.
(gfc_simplify_exponent): Handle infinities and NaNs.
(gfc_simplify_fraction): Handle infinities.
(gfc_simplify_rrspacing): Handle signed zeros and NaNs.
(gfc_simplify_set_exponent): Handle infinities and NaNs.
(gfc_simplify_spacing): Handle zeros, infinities and NaNs.
2014-10-10 Jakub Jelinek <jakub@redhat.com>
PR fortran/59488
......
gcc/fortran/simplify.c
......@@ -1169,7 +1169,7 @@ gfc_simplify_atan2 (gfc_expr *y, gfc_expr *x)
if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
return NULL;
if (mpfr_sgn (y->value.real) == 0 && mpfr_sgn (x->value.real) == 0)
if (mpfr_zero_p (y->value.real) && mpfr_zero_p (x->value.real))
{
gfc_error ("If first argument of ATAN2 %L is zero, then the "
"second argument must not be zero", &x->where);
......@@ -2191,7 +2191,7 @@ gfc_simplify_exp (gfc_expr *x)
gfc_expr *
gfc_simplify_exponent (gfc_expr *x)
{
int i;
long int val;
gfc_expr *result;
if (x->expr_type != EXPR_CONSTANT)
......@@ -2200,16 +2200,25 @@ gfc_simplify_exponent (gfc_expr *x)
result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
&x->where);
gfc_set_model (x->value.real);
/* EXPONENT(inf) = EXPONENT(nan) = HUGE(0) */
if (mpfr_inf_p (x->value.real) || mpfr_nan_p (x->value.real))
{
int i = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
mpz_set (result->value.integer, gfc_integer_kinds[i].huge);
return result;
}
if (mpfr_sgn (x->value.real) == 0)
/* EXPONENT(+/- 0.0) = 0 */
if (mpfr_zero_p (x->value.real))
{
mpz_set_ui (result->value.integer, 0);
return result;
}
i = (int) mpfr_get_exp (x->value.real);
mpz_set_si (result->value.integer, i);
gfc_set_model (x->value.real);
val = (long int) mpfr_get_exp (x->value.real);
mpz_set_si (result->value.integer, val);
return range_check (result, "EXPONENT");
}
......@@ -2373,6 +2382,13 @@ gfc_simplify_fraction (gfc_expr *x)
result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
/* FRACTION(inf) = NaN. */
if (mpfr_inf_p (x->value.real))
{
mpfr_set_nan (result->value.real);
return result;
}
#if MPFR_VERSION < MPFR_VERSION_NUM(3,1,0)
/* MPFR versions before 3.1.0 do not include mpfr_frexp.
......@@ -2403,6 +2419,7 @@ gfc_simplify_fraction (gfc_expr *x)
#else
/* mpfr_frexp() correctly handles zeros and NaNs. */
mpfr_frexp (&e, result->value.real, x->value.real, GFC_RND_MODE);
#endif
......@@ -3809,8 +3826,8 @@ gfc_simplify_log (gfc_expr *x)
break;
case BT_COMPLEX:
if ((mpfr_sgn (mpc_realref (x->value.complex)) == 0)
&& (mpfr_sgn (mpc_imagref (x->value.complex)) == 0))
if (mpfr_zero_p (mpc_realref (x->value.complex))
&& mpfr_zero_p (mpc_imagref (x->value.complex)))
{
gfc_error ("Complex argument of LOG at %L cannot be zero",
&x->where);
......@@ -5191,16 +5208,30 @@ gfc_simplify_rrspacing (gfc_expr *x)
i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
/* Special case x = -0 and 0. */
if (mpfr_sgn (result->value.real) == 0)
/* RRSPACING(+/- 0.0) = 0.0 */
if (mpfr_zero_p (x->value.real))
{
mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
return result;
}
/* RRSPACING(inf) = NaN */
if (mpfr_inf_p (x->value.real))
{
mpfr_set_nan (result->value.real);
return result;
}
/* RRSPACING(NaN) = same NaN */
if (mpfr_nan_p (x->value.real))
{
mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
return result;
}
/* | x * 2**(-e) | * 2**p. */
mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
e = - (long int) mpfr_get_exp (x->value.real);
mpfr_mul_2si (result->value.real, result->value.real, e, GFC_RND_MODE);
......@@ -5223,7 +5254,7 @@ gfc_simplify_scale (gfc_expr *x, gfc_expr *i)
result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
if (mpfr_sgn (x->value.real) == 0)
if (mpfr_zero_p (x->value.real))
{
mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
return result;
......@@ -5591,9 +5622,18 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i)
result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
if (mpfr_sgn (x->value.real) == 0)
/* SET_EXPONENT (+/-0.0, I) = +/- 0.0
SET_EXPONENT (NaN) = same NaN */
if (mpfr_zero_p (x->value.real) || mpfr_nan_p (x->value.real))
{
mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
return result;
}
/* SET_EXPONENT (inf) = NaN */
if (mpfr_inf_p (x->value.real))
{
mpfr_set_nan (result->value.real);
return result;
}
......@@ -5979,17 +6019,29 @@ gfc_simplify_spacing (gfc_expr *x)
return NULL;
i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
/* Special case x = 0 and -0. */
mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
if (mpfr_sgn (result->value.real) == 0)
/* SPACING(+/- 0.0) = SPACING(TINY(0.0)) = TINY(0.0) */
if (mpfr_zero_p (x->value.real))
{
mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
return result;
}
/* SPACING(inf) = NaN */
if (mpfr_inf_p (x->value.real))
{
mpfr_set_nan (result->value.real);
return result;
}
/* SPACING(NaN) = same NaN */
if (mpfr_nan_p (x->value.real))
{
mpfr_set (result->value.real, x->value.real, GFC_RND_MODE);
return result;
}
/* In the Fortran 95 standard, the result is b**(e - p) where b, e, and p
are the radix, exponent of x, and precision. This excludes the
possibility of subnormal numbers. Fortran 2003 states the result is
......
gcc/testsuite/ChangeLog
2014-10-11 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/48979
* gfortran.dg/ieee/intrinsics_1.f90: New test.
2014-10-11 Christophe Lyon <christophe.lyon@linaro.org>
* lib/target-supports.exp (check_effective_target_shared): New
function.
* g++.dg/ipa/devirt-28a.C: Check if -shared is supported.
* g++.dg/ipa/devirt-28a.C: Check if -shared is supported.
2014-10-10 Jakub Jelinek <jakub@redhat.com>
......
gcc/testsuite/gfortran.dg/ieee/intrinsics_1.f90 0 → 100644
! { dg-do run }
! { dg-additional-options "-fno-range-check" }
!
! Check compile-time simplification of functions FRACTION, EXPONENT,
! SPACING, RRSPACING and SET_EXPONENT for special values.
program test
implicit none
real, parameter :: inf = 2 * huge(0.)
real, parameter :: nan = 0. / 0.
call check_positive_zero(fraction(0.))
call check_negative_zero(fraction(-0.))
if (.not. isnan(fraction(inf))) call abort
if (.not. isnan(fraction(-inf))) call abort
if (.not. isnan(fraction(nan))) call abort
if (exponent(0.) /= 0) call abort
if (exponent(-0.) /= 0) call abort
if (exponent(inf) /= huge(0)) call abort
if (exponent(-inf) /= huge(0)) call abort
if (exponent(nan) /= huge(0)) call abort
if (spacing(0.) /= spacing(tiny(0.))) call abort
if (spacing(-0.) /= spacing(tiny(0.))) call abort
if (.not. isnan(spacing(inf))) call abort
if (.not. isnan(spacing(-inf))) call abort
if (.not. isnan(spacing(nan))) call abort
call check_positive_zero(rrspacing(0.))
call check_positive_zero(rrspacing(-0.))
if (.not. isnan(rrspacing(inf))) call abort
if (.not. isnan(rrspacing(-inf))) call abort
if (.not. isnan(rrspacing(nan))) call abort
call check_positive_zero(set_exponent(0.,42))
call check_negative_zero(set_exponent(-0.,42))
if (.not. isnan(set_exponent(inf, 42))) call abort
if (.not. isnan(set_exponent(-inf, 42))) call abort
if (.not. isnan(set_exponent(nan, 42))) call abort
contains
subroutine check_positive_zero(x)
use ieee_arithmetic
implicit none
real, value :: x
if (ieee_class (x) /= ieee_positive_zero) call abort
end
subroutine check_negative_zero(x)
use ieee_arithmetic
implicit none
real, value :: x
if (ieee_class (x) /= ieee_negative_zero) call abort
end
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment