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

4 files changed, 160 insertions, 1 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4960665..109441d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
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 0000000..9eb4620
--- /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 8397eee..6eace44 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,9 @@
+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
diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90
index 0937560..1cda1c7 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