From 74ee24e23e96dde8a338a140c3cadd0bb7715e61 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sat, 29 Dec 2018 18:10:57 +0000 Subject: [PATCH] re PR fortran/88342 (Possible bug with IEEE_POSITIVE_INF and -ffpe-trap=overflow) 2018-12-29 Steven G. Kargl PR fortran/88342 * ieee/ieee_arithmetic.F90: Prevent exceptions in IEEE_VALUE if -ffpe-trap=invalid or -ffpe-trap=overflow is used. 2018-12-29 Steven G. Kargl PR fortran/88342 * gfortran.dg/ieee/ieee_10.f90: New test. From-SVN: r267465 --- gcc/testsuite/ChangeLog | 5 + gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 | 32 ++++++ libgfortran/ChangeLog | 6 ++ libgfortran/ieee/ieee_arithmetic.F90 | 118 ++++++++++++++++++++- 4 files changed, 160 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 496066577d5..109441d80b2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-12-29 Steven G. Kargl + + PR fortran/88342 + * gfortran.dg/ieee/ieee_10.f90: New test. + 2018-12-29 Dominique d'Humieres PR tree-optimization/68356 diff --git a/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 b/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 new file mode 100644 index 00000000000..9eb4620f0f9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 @@ -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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8397eee6607..6eace449440 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +2018-12-29 Steven G. Kargl + + PR fortran/88342 + * ieee/ieee_arithmetic.F90: Prevent exceptions in IEEE_VALUE if + -ffpe-trap=invalid or -ffpe-trap=overflow is used. + 2018-12-28 Steven G. Kargl PR fortran/81984 diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90 index 09375605d5b..1cda1c7458b 100644 --- a/libgfortran/ieee/ieee_arithmetic.F90 +++ b/libgfortran/ieee/ieee_arithmetic.F90 @@ -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 -- 2.30.2