[patch,fortran] Handle (signed) zeros, infinities and NaNs in some intrinsics

[patch,fortran] Handle (signed) zeros, infinities and NaNs in some intrinsics

[FX]

[-- Attachment #1: Type: text/plain, Size: 1544 bytes --]

The attached patch fixes the compile-time simplification of special values (positive and negative zeros, infinities, and NaNs) in intrinsics EXPONENT, FRACTION, RRSPACING, SET_EXPONENT, SPACING. Those are all the intrinsics in the Fortran 2008 standard that say anything about these special values, so it makes sense to fix them. This is the compile-time part of PR 48979 (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=48979).

Some notes:

  - We’re not technically required to do anything about infinities and NaNs unless IEEE_ARITHMETIC is accessible. My view is that it makes sense, as a quality of implementation issue, to handle them correctly anyway. I’ve done so here for simplification, and intent to do the same later for code generation in trans-intrinsic.c

  - For FRACTION, the 2003 standard says FRACTION(inf) = inf, while Fortran 2008 says FRACTION(inf) = NaN. I agree with Tobias, who said in the PR we shouldn’t emit different code based on -std=f2003/f2008. Instead, we use the Fortran 2008 intepretation here. It makes more sense anyway.

  - While digging into MPFR doc, I realized that the test (mpfr_sgn (x->value.real) == 0) used a few times in simplify.c is not only true for zeros, but also for NaNs! I thus replaced it with mpfr_zero_p (x->value.real). It affects only some (invalid) warnings. For example, before my patch, the code LOG((nan,nan)) would emit an error "Complex argument of LOG cannot be zero”, which makes little sense.


Regtested on x86_64-apple-darwin14. OK to commit?

FX



[-- Attachment #2: intrinsics.ChangeLog --]
[-- Type: application/octet-stream, Size: 619 bytes --]

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-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/48979
	* gfortran.dg/ieee/intrinsics_1.f90: New test.

[-- Attachment #3: intrinsics.diff --]
[-- Type: application/octet-stream, Size: 7928 bytes --]

Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c	(revision 216036)
+++ gcc/fortran/simplify.c	(working copy)
@@ -1169,7 +1169,7 @@ gfc_simplify_atan2 (gfc_expr *y, gfc_exp
   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_exp
 
   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, 
 
   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
Index: gcc/testsuite/gfortran.dg/ieee/intrinsics_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ieee/intrinsics_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/ieee/intrinsics_1.f90	(working copy)
@@ -0,0 +1,60 @@
+! { 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

Re: [patch,fortran] Handle (signed) zeros, infinities and NaNs in some intrinsics

[Steve Kargl]

On Sat, Oct 11, 2014 at 03:13:00PM +0200, FX wrote:
> The attached patch fixes the compile-time simplification of special
> values (positive and negative zeros, infinities, and NaNs) in
> intrinsics EXPONENT, FRACTION, RRSPACING, SET_EXPONENT, SPACING.
> Those are all the intrinsics in the Fortran 2008 standard that say
> anything about these special values, so it makes sense to fix them.
> This is the compile-time part of PR 48979
> (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=48979).
> 

Looks ok to me.

-- 
Steve