public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH] Fortran: make IEEE_CLASS recognize signaling NaNs
@ 2022-01-02 10:50 FX
  2022-01-09 10:52 ` FX
  2022-01-11 22:01 ` Harald Anlauf
  0 siblings, 2 replies; 15+ messages in thread
From: FX @ 2022-01-02 10:50 UTC (permalink / raw)
  To: fortran; +Cc: gcc-patches

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

Hi,

This is the first part of a three-patch series to fix PR 82207 (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=82207), making gfortran handle signaling NaNs. This part fixes the library code implementing IEEE_CLASS, by using the issignaling macro (from TS 18661-1:2014) to check whether a NaN is signalling.

The patch comes with a testcase, conditional on issignaling support (which will therefore run on glibc targets), which uses C built-ins to generate signaling NaNs and checks in Fortran code that they are classified and behave as expected.

Once this is in, the next two parts are:

- Add support for generating signaling NaNs in IEEE_VALUE, which is a longer patch because it requires moving the IEEE_VALUE library code from Fortran to C (but will be much more efficient and correct than the current implementation).
- Provide a fallback implementation of issignaling on targets that don’t have it.


Bootstrapped and regtested on x86_64-pc-gnu-linux. OK to commit?

FX


[-- Attachment #2: 0001-Fortran-Allow-IEEE_CLASS-to-identify-signaling-NaNs.patch --]
[-- Type: application/octet-stream, Size: 8566 bytes --]

From b341ad50e2d228de60e86dd6ffbd09b8733ef468 Mon Sep 17 00:00:00 2001
From: Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
Date: Sun, 2 Jan 2022 11:36:23 +0100
Subject: [PATCH] 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.
---
 .../gfortran.dg/ieee/signaling_1.f90          | 89 +++++++++++++++++++
 .../gfortran.dg/ieee/signaling_1_c.c          | 14 +++
 libgfortran/Makefile.am                       |  8 +-
 libgfortran/Makefile.in                       |  6 +-
 libgfortran/ieee/ieee_helper.c                | 15 +++-
 5 files changed, 128 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/ieee/signaling_1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/ieee/signaling_1_c.c

diff --git a/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90 b/gcc/testsuite/gfortran.dg/ieee/signaling_1.f90
new file mode 100644
index 00000000000..a1403e6ce16
--- /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
index 00000000000..ab19bb7eae7
--- /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 008f2e7549c..b7ef912a440 100644
--- 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 5dac04e171e..3684b2aaa75 100644
--- 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 fd2ba69488b..5a824a180e2 100644
--- 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; \
-- 
2.25.1


^ permalink raw reply	[flat|nested] 15+ messages in thread
end of thread, other threads:[~2022-01-12 11:55 UTC | newest]

Thread overview: 15+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-01-02 10:50 [PATCH] Fortran: make IEEE_CLASS recognize signaling NaNs FX
2022-01-09 10:52 ` FX
2022-01-09 19:34   ` Mikael Morin
2022-01-10 12:04     ` FX
2022-01-11 22:01 ` Harald Anlauf
2022-01-11 22:01   ` Harald Anlauf
2022-01-11 22:04   ` FX
2022-01-11 22:11     ` Harald Anlauf
2022-01-11 22:11       ` Harald Anlauf
2022-01-11 22:32       ` FX
2022-01-12 10:23         ` FX
2022-01-12 10:34           ` Jakub Jelinek
2022-01-12 11:03             ` FX
2022-01-12 11:06               ` Jakub Jelinek
2022-01-12 11:55                 ` FX

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).