blob: ce8b9182a2a487d9634fb07f074640aa81018813 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
! { 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
|
