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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
! Test if MIN and MAX intrinsics behave correctly when passed NaNs
! as arguments
!
! { dg-do run }
! { dg-options "-pedantic-errors -mieee" { target alpha*-*-* sh*-*-* } }
! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
!
module aux2
interface isnan
module procedure isnan_r
module procedure isnan_d
end interface isnan
interface isinf
module procedure isinf_r
module procedure isinf_d
end interface isinf
contains
pure function isnan_r(x) result (isnan)
logical :: isnan
real, intent(in) :: x
isnan = (.not.(x == x))
end function isnan_r
pure function isnan_d(x) result (isnan)
logical :: isnan
double precision, intent(in) :: x
isnan = (.not.(x == x))
end function isnan_d
pure function isinf_r(x) result (isinf)
logical :: isinf
real, intent(in) :: x
isinf = (x > huge(x)) .or. (x < -huge(x))
end function isinf_r
pure function isinf_d(x) result (isinf)
logical :: isinf
double precision, intent(in) :: x
isinf = (x > huge(x)) .or. (x < -huge(x))
end function isinf_d
end module aux2
program test
use aux2
implicit none
real :: nan, large, inf
! Create a NaN and check it
nan = 0
nan = nan / nan
if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
.or. nan <= nan) call abort
if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
(.not. isnan(real(nan,kind=kind(2.d0))))) call abort
! Create an INF and check it
large = huge(large)
inf = 2 * large
if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
! Check that MIN and MAX behave correctly
if (max(2.0, nan) /= 2.0) call abort
if (min(2.0, nan) /= 2.0) call abort
if (max(nan, 2.0) /= 2.0) call abort
if (min(nan, 2.0) /= 2.0) call abort
if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (.not. isnan(min(nan,nan))) call abort
if (.not. isnan(max(nan,nan))) call abort
! Same thing, with more arguments
if (max(3.0, 2.0, nan) /= 3.0) call abort
if (min(3.0, 2.0, nan) /= 2.0) call abort
if (max(3.0, nan, 2.0) /= 3.0) call abort
if (min(3.0, nan, 2.0) /= 2.0) call abort
if (max(nan, 3.0, 2.0) /= 3.0) call abort
if (min(nan, 3.0, 2.0) /= 2.0) call abort
if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
if (.not. isnan(min(nan,nan,nan))) call abort
if (.not. isnan(max(nan,nan,nan))) call abort
if (.not. isnan(min(nan,nan,nan,nan))) call abort
if (.not. isnan(max(nan,nan,nan,nan))) call abort
if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
! Large values, INF and NaNs
if (.not. isinf(max(large, inf))) call abort
if (isinf(min(large, inf))) call abort
if (.not. isinf(max(nan, large, inf))) call abort
if (isinf(min(nan, large, inf))) call abort
if (.not. isinf(max(large, nan, inf))) call abort
if (isinf(min(large, nan, inf))) call abort
if (.not. isinf(max(large, inf, nan))) call abort
if (isinf(min(large, inf, nan))) call abort
if (.not. isinf(min(-large, -inf))) call abort
if (isinf(max(-large, -inf))) call abort
if (.not. isinf(min(nan, -large, -inf))) call abort
if (isinf(max(nan, -large, -inf))) call abort
if (.not. isinf(min(-large, nan, -inf))) call abort
if (isinf(max(-large, nan, -inf))) call abort
if (.not. isinf(min(-large, -inf, nan))) call abort
if (isinf(max(-large, -inf, nan))) call abort
end program test
! { dg-final { cleanup-modules "aux2" } }
|
