From b341ad50e2d228de60e86dd6ffbd09b8733ef468 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert 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