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
|
! { dg-do run }
! { dg-options "-fno-range-check -pedantic" }
! { dg-add-options ieee }
! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
!
! PR fortran/34333
!
! Check that (NaN /= NaN) == .TRUE.
! and some other NaN options.
!
! Contrary to nan_1.f90, PARAMETERs are used and thus
! the front end resolves the min, max and binary operators at
! compile time.
!
module aux2
interface isinf
module procedure isinf_r
module procedure isinf_d
end interface isinf
contains
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, parameter :: nan = 0.0/0.0, large = huge(large), inf = 1.0/0.0
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
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
|
