| Message ID | 20181224195950.GA94080@troutmask.apl.washington.edu |
|---|---|
| State | New |
| Headers | show |
| Series | fortran/88342 -- interaction of -ffpe-trap and IEEE_VALUE | expand |
Ping. On Mon, Dec 24, 2018 at 11:59:50AM -0800, Steve Kargl wrote: > All, > > The IEEE modules and -ffpe-trap are to some extent orthogonal > features of gfortran. Unfortunately, some users have the > expectation of using -ffpe-trap for debugging while also using only > some of the mechanisms provided by the IEEE modules. For example, > > % t.f90 > program test > use, intrinsic :: ieee_arithmetic > real :: inf > inf = ieee_value(inf, ieee_positive_inf) > end program test > % gfc8 -o z -ffpe-trap=overflow t.f90 && ./z > Floating exception (core dumped) > > The correct use of the module would be along the lines of > > program test > use, intrinsic :: ieee_arithmetic > real :: inf > logical h > call ieee_get_halting_mode(ieee_overflow, h) ! store halting mode > call ieee_set_halting_mode(ieee_overflow, .false.) ! no halting > inf = ieee_value(inf, ieee_positive_inf) > call ieee_set_halting_mode(ieee_overflow, h) ! restore halting mode > end program test > > Technically (as I have done in the patch), the user should also > use 'ieee_support_halting(ieee_overflow)', but that's just a detail. > > Now, IEEE_VALUE() is specifically included in the Fortran standard > to allow it to provide qNaN, sNaN, +inf, and -inf (among a few other > questionable constants). The attached patch allows gfortran to > generate an executable that does not abort with SIGFPE. > > 2018-12-24 Steven G. Kargl <kargl@gcc.gnu.org> > > PR fortran/88342 > * ieee/ieee_arithmetic.F90: Prevent exceptions in IEEE_VALUE if > -ffpe-trap=invalid or -ffpe-trap=overflow is used. > > 2018-12-24 Steven G. Kargl <kargl@gcc.gnu.org> > > PR fortran/88342 > * gfortran.dg/ieee/ieee_10.f90: New test. > > Regression tested on i586-*-freebsd and x86_64-*-freebsd. OK to commit? > > -- > Steve > 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4 > 20161221 https://www.youtube.com/watch?v=IbCHE-hONow > Index: gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 > =================================================================== > --- gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 (nonexistent) > +++ gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 (working copy) > @@ -0,0 +1,32 @@ > +! { dg-do run } > +! { dg-options "-ffpe-trap=overflow,invalid" } > +program foo > + > + use ieee_arithmetic > + > + implicit none > + > + real x > + real(8) y > + > + x = ieee_value(x, ieee_signaling_nan) > + if (.not. ieee_is_nan(x)) stop 1 > + x = ieee_value(x, ieee_quiet_nan) > + if (.not. ieee_is_nan(x)) stop 2 > + > + x = ieee_value(x, ieee_positive_inf) > + if (ieee_is_finite(x)) stop 3 > + x = ieee_value(x, ieee_negative_inf) > + if (ieee_is_finite(x)) stop 4 > + > + y = ieee_value(y, ieee_signaling_nan) > + if (.not. ieee_is_nan(y)) stop 5 > + y = ieee_value(y, ieee_quiet_nan) > + if (.not. ieee_is_nan(y)) stop 6 > + > + y = ieee_value(y, ieee_positive_inf) > + if (ieee_is_finite(y)) stop 7 > + y = ieee_value(y, ieee_negative_inf) > + if (ieee_is_finite(y)) stop 8 > + > +end program foo > Index: libgfortran/ieee/ieee_arithmetic.F90 > =================================================================== > --- libgfortran/ieee/ieee_arithmetic.F90 (revision 267415) > +++ libgfortran/ieee/ieee_arithmetic.F90 (working copy) > @@ -914,17 +914,39 @@ contains > > real(kind=4), intent(in) :: X > type(IEEE_CLASS_TYPE), intent(in) :: CLASS > + logical flag > > select case (CLASS%hidden) > case (1) ! IEEE_SIGNALING_NAN > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_get_halting_mode(ieee_invalid, flag) > + call ieee_set_halting_mode(ieee_invalid, .false.) > + end if > res = -1 > res = sqrt(res) > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_set_halting_mode(ieee_invalid, flag) > + end if > case (2) ! IEEE_QUIET_NAN > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_get_halting_mode(ieee_invalid, flag) > + call ieee_set_halting_mode(ieee_invalid, .false.) > + end if > res = -1 > res = sqrt(res) > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_set_halting_mode(ieee_invalid, flag) > + end if > case (3) ! IEEE_NEGATIVE_INF > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_get_halting_mode(ieee_overflow, flag) > + call ieee_set_halting_mode(ieee_overflow, .false.) > + end if > res = huge(res) > res = (-res) * res > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_set_halting_mode(ieee_overflow, flag) > + end if > case (4) ! IEEE_NEGATIVE_NORMAL > res = -42 > case (5) ! IEEE_NEGATIVE_DENORMAL > @@ -941,8 +963,15 @@ contains > case (9) ! IEEE_POSITIVE_NORMAL > res = 42 > case (10) ! IEEE_POSITIVE_INF > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_get_halting_mode(ieee_overflow, flag) > + call ieee_set_halting_mode(ieee_overflow, .false.) > + end if > res = huge(res) > res = res * res > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_set_halting_mode(ieee_overflow, flag) > + end if > case default ! IEEE_OTHER_VALUE, should not happen > res = 0 > end select > @@ -952,17 +981,39 @@ contains > > real(kind=8), intent(in) :: X > type(IEEE_CLASS_TYPE), intent(in) :: CLASS > + logical flag > > select case (CLASS%hidden) > case (1) ! IEEE_SIGNALING_NAN > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_get_halting_mode(ieee_invalid, flag) > + call ieee_set_halting_mode(ieee_invalid, .false.) > + end if > res = -1 > res = sqrt(res) > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_set_halting_mode(ieee_invalid, flag) > + end if > case (2) ! IEEE_QUIET_NAN > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_get_halting_mode(ieee_invalid, flag) > + call ieee_set_halting_mode(ieee_invalid, .false.) > + end if > res = -1 > res = sqrt(res) > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_set_halting_mode(ieee_invalid, flag) > + end if > case (3) ! IEEE_NEGATIVE_INF > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_get_halting_mode(ieee_overflow, flag) > + call ieee_set_halting_mode(ieee_overflow, .false.) > + end if > res = huge(res) > res = (-res) * res > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_set_halting_mode(ieee_overflow, flag) > + end if > case (4) ! IEEE_NEGATIVE_NORMAL > res = -42 > case (5) ! IEEE_NEGATIVE_DENORMAL > @@ -979,8 +1030,15 @@ contains > case (9) ! IEEE_POSITIVE_NORMAL > res = 42 > case (10) ! IEEE_POSITIVE_INF > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_get_halting_mode(ieee_overflow, flag) > + call ieee_set_halting_mode(ieee_overflow, .false.) > + end if > res = huge(res) > res = res * res > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_set_halting_mode(ieee_overflow, flag) > + end if > case default ! IEEE_OTHER_VALUE, should not happen > res = 0 > end select > @@ -991,17 +1049,39 @@ contains > > real(kind=10), intent(in) :: X > type(IEEE_CLASS_TYPE), intent(in) :: CLASS > + logical flag > > select case (CLASS%hidden) > case (1) ! IEEE_SIGNALING_NAN > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_get_halting_mode(ieee_invalid, flag) > + call ieee_set_halting_mode(ieee_invalid, .false.) > + end if > res = -1 > res = sqrt(res) > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_set_halting_mode(ieee_invalid, flag) > + end if > case (2) ! IEEE_QUIET_NAN > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_get_halting_mode(ieee_invalid, flag) > + call ieee_set_halting_mode(ieee_invalid, .false.) > + end if > res = -1 > res = sqrt(res) > - case (3) ! IEEE_NEGATIVE_INF > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_set_halting_mode(ieee_invalid, flag) > + end if > + case (3) ! IEEE_NEGATIVE_INF > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_get_halting_mode(ieee_overflow, flag) > + call ieee_set_halting_mode(ieee_overflow, .false.) > + end if > res = huge(res) > res = (-res) * res > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_set_halting_mode(ieee_overflow, flag) > + end if > case (4) ! IEEE_NEGATIVE_NORMAL > res = -42 > case (5) ! IEEE_NEGATIVE_DENORMAL > @@ -1018,8 +1098,15 @@ contains > case (9) ! IEEE_POSITIVE_NORMAL > res = 42 > case (10) ! IEEE_POSITIVE_INF > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_get_halting_mode(ieee_overflow, flag) > + call ieee_set_halting_mode(ieee_overflow, .false.) > + end if > res = huge(res) > res = res * res > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_set_halting_mode(ieee_overflow, flag) > + end if > case default ! IEEE_OTHER_VALUE, should not happen > res = 0 > end select > @@ -1032,17 +1119,39 @@ contains > > real(kind=16), intent(in) :: X > type(IEEE_CLASS_TYPE), intent(in) :: CLASS > + logical flag > > select case (CLASS%hidden) > case (1) ! IEEE_SIGNALING_NAN > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_get_halting_mode(ieee_invalid, flag) > + call ieee_set_halting_mode(ieee_invalid, .false.) > + end if > res = -1 > res = sqrt(res) > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_set_halting_mode(ieee_invalid, flag) > + end if > case (2) ! IEEE_QUIET_NAN > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_get_halting_mode(ieee_invalid, flag) > + call ieee_set_halting_mode(ieee_invalid, .false.) > + end if > res = -1 > res = sqrt(res) > + if (ieee_support_halting(ieee_invalid)) then > + call ieee_set_halting_mode(ieee_invalid, flag) > + end if > case (3) ! IEEE_NEGATIVE_INF > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_get_halting_mode(ieee_overflow, flag) > + call ieee_set_halting_mode(ieee_overflow, .false.) > + end if > res = huge(res) > res = (-res) * res > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_set_halting_mode(ieee_overflow, flag) > + end if > case (4) ! IEEE_NEGATIVE_NORMAL > res = -42 > case (5) ! IEEE_NEGATIVE_DENORMAL > @@ -1059,8 +1168,15 @@ contains > case (9) ! IEEE_POSITIVE_NORMAL > res = 42 > case (10) ! IEEE_POSITIVE_INF > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_get_halting_mode(ieee_overflow, flag) > + call ieee_set_halting_mode(ieee_overflow, .false.) > + end if > res = huge(res) > res = res * res > + if (ieee_support_halting(ieee_overflow)) then > + call ieee_set_halting_mode(ieee_overflow, flag) > + end if > case default ! IEEE_OTHER_VALUE, should not happen > res = 0 > end select
On 12/28/18 10:43 AM, Steve Kargl wrote: > Ping. > > On Mon, Dec 24, 2018 at 11:59:50AM -0800, Steve Kargl wrote: >> All, >> >> The IEEE modules and -ffpe-trap are to some extent orthogonal >> features of gfortran. Unfortunately, some users have the >> expectation of using -ffpe-trap for debugging while also using only >> some of the mechanisms provided by the IEEE modules. For example, >> >> % t.f90 >> program test >> use, intrinsic :: ieee_arithmetic >> real :: inf >> inf = ieee_value(inf, ieee_positive_inf) >> end program test >> % gfc8 -o z -ffpe-trap=overflow t.f90 && ./z >> Floating exception (core dumped) >> >> The correct use of the module would be along the lines of >> >> program test >> use, intrinsic :: ieee_arithmetic >> real :: inf >> logical h >> call ieee_get_halting_mode(ieee_overflow, h) ! store halting mode >> call ieee_set_halting_mode(ieee_overflow, .false.) ! no halting >> inf = ieee_value(inf, ieee_positive_inf) >> call ieee_set_halting_mode(ieee_overflow, h) ! restore halting mode >> end program test >> >> Technically (as I have done in the patch), the user should also >> use 'ieee_support_halting(ieee_overflow)', but that's just a detail. >> >> Now, IEEE_VALUE() is specifically included in the Fortran standard >> to allow it to provide qNaN, sNaN, +inf, and -inf (among a few other >> questionable constants). The attached patch allows gfortran to >> generate an executable that does not abort with SIGFPE. >> >> 2018-12-24 Steven G. Kargl <kargl@gcc.gnu.org> >> >> PR fortran/88342 >> * ieee/ieee_arithmetic.F90: Prevent exceptions in IEEE_VALUE if >> -ffpe-trap=invalid or -ffpe-trap=overflow is used. >> >> 2018-12-24 Steven G. Kargl <kargl@gcc.gnu.org> >> >> PR fortran/88342 >> * gfortran.dg/ieee/ieee_10.f90: New test. >> >> Regression tested on i586-*-freebsd and x86_64-*-freebsd. OK to commit? >> OK Steve, thanks. Jerry
On Fri, Dec 28, 2018 at 4:38 PM Jerry DeLisle <jvdelisle@charter.net> wrote: > > On 12/28/18 10:43 AM, Steve Kargl wrote: > > Ping. > > > > On Mon, Dec 24, 2018 at 11:59:50AM -0800, Steve Kargl wrote: > >> All, > >> > >> The IEEE modules and -ffpe-trap are to some extent orthogonal > >> features of gfortran. Unfortunately, some users have the > >> expectation of using -ffpe-trap for debugging while also using only > >> some of the mechanisms provided by the IEEE modules. For example, > >> > >> % t.f90 > >> program test > >> use, intrinsic :: ieee_arithmetic > >> real :: inf > >> inf = ieee_value(inf, ieee_positive_inf) > >> end program test > >> % gfc8 -o z -ffpe-trap=overflow t.f90 && ./z > >> Floating exception (core dumped) > >> > >> The correct use of the module would be along the lines of > >> > >> program test > >> use, intrinsic :: ieee_arithmetic > >> real :: inf > >> logical h > >> call ieee_get_halting_mode(ieee_overflow, h) ! store halting mode > >> call ieee_set_halting_mode(ieee_overflow, .false.) ! no halting > >> inf = ieee_value(inf, ieee_positive_inf) > >> call ieee_set_halting_mode(ieee_overflow, h) ! restore halting mode > >> end program test > >> > >> Technically (as I have done in the patch), the user should also > >> use 'ieee_support_halting(ieee_overflow)', but that's just a detail. > >> > >> Now, IEEE_VALUE() is specifically included in the Fortran standard > >> to allow it to provide qNaN, sNaN, +inf, and -inf (among a few other > >> questionable constants). The attached patch allows gfortran to > >> generate an executable that does not abort with SIGFPE. > >> > >> 2018-12-24 Steven G. Kargl <kargl@gcc.gnu.org> > >> > >> PR fortran/88342 > >> * ieee/ieee_arithmetic.F90: Prevent exceptions in IEEE_VALUE if > >> -ffpe-trap=invalid or -ffpe-trap=overflow is used. > >> > >> 2018-12-24 Steven G. Kargl <kargl@gcc.gnu.org> > >> > >> PR fortran/88342 > >> * gfortran.dg/ieee/ieee_10.f90: New test. > >> > >> Regression tested on i586-*-freebsd and x86_64-*-freebsd. OK to commit? > >> > > OK Steve, thanks. The test fails on Linux/x86: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88639
On Sun, Dec 30, 2018 at 08:06:40AM -0800, H.J. Lu wrote: > > > > OK Steve, thanks. > > The test fails on Linux/x86: > > https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88639 > The test works on both i586-*-freebsd and x86_64-*-freebsd. What does
On Sun, Dec 30, 2018 at 9:09 AM Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > > On Sun, Dec 30, 2018 at 08:06:40AM -0800, H.J. Lu wrote: > > > > > > OK Steve, thanks. > > > > The test fails on Linux/x86: > > > > https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88639 > > > > The test works on both i586-*-freebsd and x86_64-*-freebsd. > What does > diff --git a/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 b/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 index 9eb4620f0f9..c3ffffcb24d 100644 --- a/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 +++ b/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 @@ -1,5 +1,8 @@ ! { dg-do run } -! { dg-options "-ffpe-trap=overflow,invalid" } +! { dg-additional-options "-ffpe-trap=overflow,invalid" } +! +! Use dg-additional-options rather than dg-options to avoid overwriting the +! default IEEE options which are passed by ieee.exp and necessary. I am checking in this patch as an obvious fix.
On Sun, Dec 30, 2018 at 09:32:43AM -0800, H.J. Lu wrote: > On Sun, Dec 30, 2018 at 9:09 AM Steve Kargl > <sgk@troutmask.apl.washington.edu> wrote: > > > > On Sun, Dec 30, 2018 at 08:06:40AM -0800, H.J. Lu wrote: > > > > > > > > OK Steve, thanks. > > > > > > The test fails on Linux/x86: > > > > > > https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88639 > > > > > > > The test works on both i586-*-freebsd and x86_64-*-freebsd. > > What does > > > > diff --git a/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 > b/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 > index 9eb4620f0f9..c3ffffcb24d 100644 > --- a/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 > +++ b/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 > @@ -1,5 +1,8 @@ > ! { dg-do run } > -! { dg-options "-ffpe-trap=overflow,invalid" } > +! { dg-additional-options "-ffpe-trap=overflow,invalid" } > +! > +! Use dg-additional-options rather than dg-options to avoid overwriting the > +! default IEEE options which are passed by ieee.exp and necessary. > > I am checking in this patch as an obvious fix. > Thanks for the fix and sorry about the breakage.
Index: gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 =================================================================== --- gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 (working copy) @@ -0,0 +1,32 @@ +! { dg-do run } +! { dg-options "-ffpe-trap=overflow,invalid" } +program foo + + use ieee_arithmetic + + implicit none + + real x + real(8) y + + x = ieee_value(x, ieee_signaling_nan) + if (.not. ieee_is_nan(x)) stop 1 + x = ieee_value(x, ieee_quiet_nan) + if (.not. ieee_is_nan(x)) stop 2 + + x = ieee_value(x, ieee_positive_inf) + if (ieee_is_finite(x)) stop 3 + x = ieee_value(x, ieee_negative_inf) + if (ieee_is_finite(x)) stop 4 + + y = ieee_value(y, ieee_signaling_nan) + if (.not. ieee_is_nan(y)) stop 5 + y = ieee_value(y, ieee_quiet_nan) + if (.not. ieee_is_nan(y)) stop 6 + + y = ieee_value(y, ieee_positive_inf) + if (ieee_is_finite(y)) stop 7 + y = ieee_value(y, ieee_negative_inf) + if (ieee_is_finite(y)) stop 8 + +end program foo Index: libgfortran/ieee/ieee_arithmetic.F90 =================================================================== --- libgfortran/ieee/ieee_arithmetic.F90 (revision 267415) +++ libgfortran/ieee/ieee_arithmetic.F90 (working copy) @@ -914,17 +914,39 @@ contains real(kind=4), intent(in) :: X type(IEEE_CLASS_TYPE), intent(in) :: CLASS + logical flag select case (CLASS%hidden) case (1) ! IEEE_SIGNALING_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (2) ! IEEE_QUIET_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = (-res) * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case (4) ! IEEE_NEGATIVE_NORMAL res = -42 case (5) ! IEEE_NEGATIVE_DENORMAL @@ -941,8 +963,15 @@ contains case (9) ! IEEE_POSITIVE_NORMAL res = 42 case (10) ! IEEE_POSITIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = res * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case default ! IEEE_OTHER_VALUE, should not happen res = 0 end select @@ -952,17 +981,39 @@ contains real(kind=8), intent(in) :: X type(IEEE_CLASS_TYPE), intent(in) :: CLASS + logical flag select case (CLASS%hidden) case (1) ! IEEE_SIGNALING_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (2) ! IEEE_QUIET_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = (-res) * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case (4) ! IEEE_NEGATIVE_NORMAL res = -42 case (5) ! IEEE_NEGATIVE_DENORMAL @@ -979,8 +1030,15 @@ contains case (9) ! IEEE_POSITIVE_NORMAL res = 42 case (10) ! IEEE_POSITIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = res * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case default ! IEEE_OTHER_VALUE, should not happen res = 0 end select @@ -991,17 +1049,39 @@ contains real(kind=10), intent(in) :: X type(IEEE_CLASS_TYPE), intent(in) :: CLASS + logical flag select case (CLASS%hidden) case (1) ! IEEE_SIGNALING_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (2) ! IEEE_QUIET_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) - case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if + case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = (-res) * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case (4) ! IEEE_NEGATIVE_NORMAL res = -42 case (5) ! IEEE_NEGATIVE_DENORMAL @@ -1018,8 +1098,15 @@ contains case (9) ! IEEE_POSITIVE_NORMAL res = 42 case (10) ! IEEE_POSITIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = res * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case default ! IEEE_OTHER_VALUE, should not happen res = 0 end select @@ -1032,17 +1119,39 @@ contains real(kind=16), intent(in) :: X type(IEEE_CLASS_TYPE), intent(in) :: CLASS + logical flag select case (CLASS%hidden) case (1) ! IEEE_SIGNALING_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (2) ! IEEE_QUIET_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = (-res) * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case (4) ! IEEE_NEGATIVE_NORMAL res = -42 case (5) ! IEEE_NEGATIVE_DENORMAL @@ -1059,8 +1168,15 @@ contains case (9) ! IEEE_POSITIVE_NORMAL res = 42 case (10) ! IEEE_POSITIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = res * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case default ! IEEE_OTHER_VALUE, should not happen res = 0 end select
All, The IEEE modules and -ffpe-trap are to some extent orthogonal features of gfortran. Unfortunately, some users have the expectation of using -ffpe-trap for debugging while also using only some of the mechanisms provided by the IEEE modules. For example, % t.f90 program test use, intrinsic :: ieee_arithmetic real :: inf inf = ieee_value(inf, ieee_positive_inf) end program test % gfc8 -o z -ffpe-trap=overflow t.f90 && ./z Floating exception (core dumped) The correct use of the module would be along the lines of program test use, intrinsic :: ieee_arithmetic real :: inf logical h call ieee_get_halting_mode(ieee_overflow, h) ! store halting mode call ieee_set_halting_mode(ieee_overflow, .false.) ! no halting inf = ieee_value(inf, ieee_positive_inf) call ieee_set_halting_mode(ieee_overflow, h) ! restore halting mode end program test Technically (as I have done in the patch), the user should also use 'ieee_support_halting(ieee_overflow)', but that's just a detail. Now, IEEE_VALUE() is specifically included in the Fortran standard to allow it to provide qNaN, sNaN, +inf, and -inf (among a few other questionable constants). The attached patch allows gfortran to generate an executable that does not abort with SIGFPE. 2018-12-24 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/88342 * ieee/ieee_arithmetic.F90: Prevent exceptions in IEEE_VALUE if -ffpe-trap=invalid or -ffpe-trap=overflow is used. 2018-12-24 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/88342 * gfortran.dg/ieee/ieee_10.f90: New test. Regression tested on i586-*-freebsd and x86_64-*-freebsd. OK to commit?