Skip to content

R
riscv-gcc-1
Commit 74ee24e2 by Steven G. Kargl
Options

re PR fortran/88342 (Possible bug with IEEE_POSITIVE_INF and -ffpe-trap=overflow) 

2018-12-29  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-29  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/88342
	* gfortran.dg/ieee/ieee_10.f90:  New test.

From-SVN: r267465
parent 0b774bab
Showing with 160 additions and 1 deletions
gcc/testsuite/ChangeLog
2018-12-29 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/88342
* gfortran.dg/ieee/ieee_10.f90: New test.
2018-12-29 Dominique d'Humieres <dominiq@gcc.gnu.org>
PR tree-optimization/68356
......
gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 0 → 100644
! { 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
libgfortran/ChangeLog
2018-12-29 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-28 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/81984
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment