Fortran: Allow IEEE_CLASS to identify signaling NaNs

We use the issignaling macro, present in some libc's (notably glibc),
when it is available. Compile all IEEE-related files in the library
(both C and Fortran sources) with -fsignaling-nans to ensure maximum
compatibility.

libgfortran/ChangeLog:

	PR fortran/82207
	* Makefile.am: Pass -fsignaling-nans for IEEE files.
	* Makefile.in: Regenerate.
	* ieee/ieee_helper.c: Use issignaling macro to recognized
	signaling NaNs.

gcc/testsuite/ChangeLog:

	PR fortran/82207
	* gfortran.dg/ieee/signaling_1.f90: New test.
	* gfortran.dg/ieee/signaling_1_c.c: New file.

diff --git a/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90 b/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90
new file mode 100644 (file)
index 0000000..a1403e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90
@@ -0,0 +1,89 @@
+! { dg-do run }
+! { dg-require-effective-target issignaling } */
+! { dg-additional-sources signaling_1_c.c }
+! { dg-options "-fsignaling-nans" }
+!
+program test
+  use, intrinsic :: iso_c_binding
+  use, intrinsic :: ieee_arithmetic
+  implicit none
+
+  interface
+    real(kind=c_float) function create_nansf () bind(c)
+      import :: c_float
+    end function
+
+    real(kind=c_double) function create_nans () bind(c)
+      import :: c_double
+    end function
+
+    real(kind=c_long_double) function create_nansl () bind(c)
+      import :: c_long_double
+    end function
+  end interface
+
+  real(kind=c_float) :: x
+  real(kind=c_double) :: y
+  real(kind=c_long_double) :: z
+
+  if (ieee_support_nan(x)) then
+    x = create_nansf()
+    if (ieee_class(x) /= ieee_signaling_nan) stop 100
+    if (.not. ieee_is_nan(x)) stop 101
+    if (ieee_is_negative(x)) stop 102
+    if (ieee_is_finite(x)) stop 103
+    if (ieee_is_normal(x)) stop 104
+    if (.not. ieee_unordered(x, x)) stop 105
+    if (.not. ieee_unordered(x, 1._c_float)) stop 106
+
+    x = ieee_value(y, ieee_quiet_nan)
+    if (ieee_class(x) /= ieee_quiet_nan) stop 107
+    if (.not. ieee_is_nan(x)) stop 108
+    if (ieee_is_negative(x)) stop 109
+    if (ieee_is_finite(x)) stop 110
+    if (ieee_is_normal(x)) stop 111
+    if (.not. ieee_unordered(x, x)) stop 112
+    if (.not. ieee_unordered(x, 1._c_double)) stop 113
+  end if
+
+  if (ieee_support_nan(y)) then
+    y = create_nans()
+    if (ieee_class(y) /= ieee_signaling_nan) stop 200
+    if (.not. ieee_is_nan(y)) stop 201
+    if (ieee_is_negative(y)) stop 202
+    if (ieee_is_finite(y)) stop 203
+    if (ieee_is_normal(y)) stop 204
+    if (.not. ieee_unordered(y, x)) stop 205
+    if (.not. ieee_unordered(y, 1._c_double)) stop 206
+
+    y = ieee_value(y, ieee_quiet_nan)
+    if (ieee_class(y) /= ieee_quiet_nan) stop 207
+    if (.not. ieee_is_nan(y)) stop 208
+    if (ieee_is_negative(y)) stop 209
+    if (ieee_is_finite(y)) stop 210
+    if (ieee_is_normal(y)) stop 211
+    if (.not. ieee_unordered(y, y)) stop 212
+    if (.not. ieee_unordered(y, 1._c_double)) stop 213
+  end if
+
+  if (ieee_support_nan(z)) then
+    z = create_nansl()
+    if (ieee_class(z) /= ieee_signaling_nan) stop 300
+    if (.not. ieee_is_nan(z)) stop 301
+    if (ieee_is_negative(z)) stop 302
+    if (ieee_is_finite(z)) stop 303
+    if (ieee_is_normal(z)) stop 304
+    if (.not. ieee_unordered(z, z)) stop 305
+    if (.not. ieee_unordered(z, 1._c_long_double)) stop 306
+
+    z = ieee_value(y, ieee_quiet_nan)
+    if (ieee_class(z) /= ieee_quiet_nan) stop 307
+    if (.not. ieee_is_nan(z)) stop 308
+    if (ieee_is_negative(z)) stop 309
+    if (ieee_is_finite(z)) stop 310
+    if (ieee_is_normal(z)) stop 311
+    if (.not. ieee_unordered(z, z)) stop 312
+    if (.not. ieee_unordered(z, 1._c_double)) stop 313
+  end if
+
+end program test

diff --git a/gcc/testsuite/gfortran.dg/ieee/signaling_1_c.c b/gcc/testsuite/gfortran.dg/ieee/signaling_1_c.c
new file mode 100644 (file)
index 0000000..ab19bb7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/signaling_1_c.c
@@ -0,0 +1,14 @@
+float create_nansf (void)
+{
+  return __builtin_nansf("");
+}
+
+double create_nans (void)
+{
+  return __builtin_nans("");
+}
+
+long double create_nansl (void)
+{
+  return __builtin_nansl("");
+}

diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 008f2e7549c67dd91650ba3e023ad40d18a6bc20..b7ef912a440d23dcda59d71c74c6e8b5ce385649 100644 (file)
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -185,6 +185,8 @@ endif
 
 if IEEE_SUPPORT
 
+gfor_ieee_helper_src=ieee/ieee_helper.c
+
 gfor_helper_src+=ieee/ieee_helper.c
 
 gfor_ieee_src= \
@@ -991,9 +993,13 @@ selected_real_kind.lo selected_int_kind.lo: AM_FCFLAGS += -fallow-leading-unders
 
 if IEEE_SUPPORT
 # Add flags for IEEE modules
-$(patsubst %.F90,%.lo,$(notdir $(gfor_ieee_src))): AM_FCFLAGS += -Wno-unused-dummy-argument -Wno-c-binding-type -ffree-line-length-0 -fallow-leading-underscore
+$(patsubst %.F90,%.lo,$(notdir $(gfor_ieee_src))): AM_FCFLAGS += -Wno-unused-dummy-argument -Wno-c-binding-type -ffree-line-length-0 -fallow-leading-underscore -fsignaling-nans
+
+# Add flags for IEEE helper code
+$(patsubst %.c,%.lo,$(notdir $(gfor_ieee_helper_src))): AM_CFLAGS += -fsignaling-nans
 endif
 
+
 # Dependencies between IEEE_ARITHMETIC and IEEE_EXCEPTIONS
 ieee_arithmetic.lo: ieee/ieee_arithmetic.F90 ieee_exceptions.lo
        $(LTPPFCCOMPILE) -c -o $@ $<

diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 5dac04e171e91ec0115a516ce70e9d2747d74d8f..3684b2aaa75e0be4d3c61edf4fa7f9f3054fc79c 100644 (file)
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -779,6 +779,7 @@ gfor_helper_src = intrinsics/associated.c intrinsics/abort.c \
        intrinsics/selected_real_kind.f90 intrinsics/trigd.c \
        intrinsics/unpack_generic.c runtime/in_pack_generic.c \
        runtime/in_unpack_generic.c $(am__append_3) $(am__append_4)
+@IEEE_SUPPORT_TRUE@gfor_ieee_helper_src = ieee/ieee_helper.c
 @IEEE_SUPPORT_FALSE@gfor_ieee_src = 
 @IEEE_SUPPORT_TRUE@gfor_ieee_src = \
 @IEEE_SUPPORT_TRUE@ieee/ieee_arithmetic.F90 \
@@ -6999,7 +7000,10 @@ $(patsubst %.F90,%.lo,$(patsubst %.f90,%.lo,$(notdir $(gfor_specific_src)))): AM
 selected_real_kind.lo selected_int_kind.lo: AM_FCFLAGS += -fallow-leading-underscore
 
 # Add flags for IEEE modules
-@IEEE_SUPPORT_TRUE@$(patsubst %.F90,%.lo,$(notdir $(gfor_ieee_src))): AM_FCFLAGS += -Wno-unused-dummy-argument -Wno-c-binding-type -ffree-line-length-0 -fallow-leading-underscore
+@IEEE_SUPPORT_TRUE@$(patsubst %.F90,%.lo,$(notdir $(gfor_ieee_src))): AM_FCFLAGS += -Wno-unused-dummy-argument -Wno-c-binding-type -ffree-line-length-0 -fallow-leading-underscore -fsignaling-nans
+
+# Add flags for IEEE helper code
+@IEEE_SUPPORT_TRUE@$(patsubst %.c,%.lo,$(notdir $(gfor_ieee_helper_src))): AM_CFLAGS += -fsignaling-nans
 
 # Dependencies between IEEE_ARITHMETIC and IEEE_EXCEPTIONS
 ieee_arithmetic.lo: ieee/ieee_arithmetic.F90 ieee_exceptions.lo

diff --git a/libgfortran/ieee/ieee_helper.c b/libgfortran/ieee/ieee_helper.c
index d70728c5b79a5b33684da18cca4a9b62a1c26e37..7a103df58f0448754443ad6b807b10a025826613 100644 (file)
--- a/libgfortran/ieee/ieee_helper.c
+++ b/libgfortran/ieee/ieee_helper.c
@@ -25,6 +25,15 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 #include "libgfortran.h"
 
+
+/* Check support for issignaling macro.
+   TODO: In the future, provide fallback implementations for IEEE types,
+   because many libc's do not have issignaling yet.  */
+#ifndef issignaling
+# define issignaling(X) 0
+#endif
+
+
 /* Prototypes.  */
 
 extern int ieee_class_helper_4 (GFC_REAL_4 *);
@@ -86,8 +95,10 @@ enum {
  \
     if (res == IEEE_QUIET_NAN) \
     { \
-      /* TODO: Handle signaling NaNs  */ \
-      return res; \
+      if (issignaling (*value)) \
+       return IEEE_SIGNALING_NAN; \
+      else \
+       return IEEE_QUIET_NAN; \
     } \
  \
     return res; \