re PR fortran/64022 ([F2003][IEEE] ieee_support_flag does not handle kind=10 and...

	PR fortran/64022
	* gfortran.dg/ieee/large_4.f90: New test.

From-SVN: r226755

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 24dd966..0e707eb 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-08-10  Uros Bizjak  <ubizjak@gmail.com>
+
+       PR fortran/64022
+       * gfortran.dg/ieee/large_4.f90: New test.
+
 2015-08-08  Bud Davis  <jmdavis@link.com>
 
        PR fortran/59746
@@ -93,8 +98,8 @@
 2015-08-05  Nick Clifton  <nickc@redhat.com>
 
        * gcc.target/rl78: New directory.
-        * gcc.target/rl78/rl78.exp: New file: Test driver.
-        * gcc.target/rl78/test_addm3.c: New file: Test adds.
+       * gcc.target/rl78/rl78.exp: New file: Test driver.
+       * gcc.target/rl78/test_addm3.c: New file: Test adds.
 
 2015-08-05  Richard Biener  <rguenther@suse.de>
 

diff --git a/gcc/testsuite/gfortran.dg/ieee/large_4.f90 b/gcc/testsuite/gfortran.dg/ieee/large_4.f90
new file mode 100644 (file)
index 0000000..c653d29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/large_4.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+
+program test_underflow_control
+  use ieee_arithmetic
+  use iso_fortran_env
+
+  ! kx and ky will be large real kinds, if supported, and single/double
+  ! otherwise
+  integer, parameter :: kx = &
+    max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.))
+  integer, parameter :: ky = &
+    max(ieee_selected_real_kind(precision(0._kx) + 1), kind(0.d0))
+
+  logical l
+  real(kind=kx), volatile :: x
+  real(kind=ky), volatile :: y
+
+  if (ieee_support_underflow_control(x)) then
+
+    x = tiny(x)
+    call ieee_set_underflow_mode(.true.)
+    x = x / 2000._kx
+    if (x == 0) call abort
+    call ieee_get_underflow_mode(l)
+    if (.not. l) call abort
+
+    x = tiny(x)
+    call ieee_set_underflow_mode(.false.)
+    x = x / 2000._kx
+    if (x > 0) call abort
+    call ieee_get_underflow_mode(l)
+    if (l) call abort
+
+  end if
+
+  if (ieee_support_underflow_control(y)) then
+
+    y = tiny(y)
+    call ieee_set_underflow_mode(.true.)
+    y = y / 2000._ky
+    if (y == 0) call abort
+    call ieee_get_underflow_mode(l)
+    if (.not. l) call abort
+
+    y = tiny(y)
+    call ieee_set_underflow_mode(.false.)
+    y = y / 2000._ky
+    if (y > 0) call abort
+    call ieee_get_underflow_mode(l)
+    if (l) call abort
+
+  end if
+
+end program