| ! { dg-do run { xfail i?86-*-freebsd* } } |
| |
| 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) STOP 1 |
| call ieee_get_underflow_mode(l) |
| if (.not. l) STOP 2 |
| |
| x = tiny(x) |
| call ieee_set_underflow_mode(.false.) |
| x = x / 2000._kx |
| if (x > 0) STOP 3 |
| call ieee_get_underflow_mode(l) |
| if (l) STOP 4 |
| |
| 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) STOP 5 |
| call ieee_get_underflow_mode(l) |
| if (.not. l) STOP 6 |
| |
| y = tiny(y) |
| call ieee_set_underflow_mode(.false.) |
| y = y / 2000._ky |
| if (y > 0) STOP 7 |
| call ieee_get_underflow_mode(l) |
| if (l) STOP 8 |
| |
| end if |
| |
| end program |
