1! { dg-do run }
2! { dg-options "-fno-range-check -pedantic" }
3! { dg-add-options ieee }
4! { dg-skip-if "NaN not supported" { spu-*-* } }
5!
6! PR fortran/34333
7!
8! Check that (NaN /= NaN) == .TRUE.
9! and some other NaN options.
10!
11! Contrary to nan_1.f90, PARAMETERs are used and thus
12! the front end resolves the min, max and binary operators at
13! compile time.
14!
15
16module aux2
17  interface isinf
18    module procedure isinf_r
19    module procedure isinf_d
20  end interface isinf
21contains
22  pure function isinf_r(x) result (isinf)
23    logical :: isinf
24    real, intent(in) :: x
25
26    isinf = (x > huge(x)) .or. (x < -huge(x))
27  end function isinf_r
28
29  pure function isinf_d(x) result (isinf)
30    logical :: isinf
31    double precision, intent(in) :: x
32
33    isinf = (x > huge(x)) .or. (x < -huge(x))
34  end function isinf_d
35end module aux2
36
37program test
38  use aux2
39  implicit none
40  real, parameter :: nan = 0.0/0.0, large = huge(large), inf = 1.0/0.0
41
42  if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
43      .or. nan <= nan) STOP 1
44  if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
45      (.not. isnan(real(nan,kind=kind(2.d0))))) STOP 2
46
47  ! Create an INF and check it
48  if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) STOP 3
49  if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) STOP 4
50
51  ! Check that MIN and MAX behave correctly
52  if (max(2.0, nan) /= 2.0) STOP 5
53  if (min(2.0, nan) /= 2.0) STOP 6
54  if (max(nan, 2.0) /= 2.0) STOP 7
55  if (min(nan, 2.0) /= 2.0) STOP 8
56
57  if (max(2.d0, nan) /= 2.d0) STOP 9! { dg-warning "Extension: Different type kinds" }
58  if (min(2.d0, nan) /= 2.d0) STOP 10! { dg-warning "Extension: Different type kinds" }
59  if (max(nan, 2.d0) /= 2.d0) STOP 11! { dg-warning "Extension: Different type kinds" }
60  if (min(nan, 2.d0) /= 2.d0) STOP 12! { dg-warning "Extension: Different type kinds" }
61
62  if (.not. isnan(min(nan,nan))) STOP 13
63  if (.not. isnan(max(nan,nan))) STOP 14
64
65  ! Same thing, with more arguments
66
67  if (max(3.0, 2.0, nan) /= 3.0) STOP 15
68  if (min(3.0, 2.0, nan) /= 2.0) STOP 16
69  if (max(3.0, nan, 2.0) /= 3.0) STOP 17
70  if (min(3.0, nan, 2.0) /= 2.0) STOP 18
71  if (max(nan, 3.0, 2.0) /= 3.0) STOP 19
72  if (min(nan, 3.0, 2.0) /= 2.0) STOP 20
73
74  if (max(3.d0, 2.d0, nan) /= 3.d0) STOP 21! { dg-warning "Extension: Different type kinds" }
75  if (min(3.d0, 2.d0, nan) /= 2.d0) STOP 22! { dg-warning "Extension: Different type kinds" }
76  if (max(3.d0, nan, 2.d0) /= 3.d0) STOP 23! { dg-warning "Extension: Different type kinds" }
77  if (min(3.d0, nan, 2.d0) /= 2.d0) STOP 24! { dg-warning "Extension: Different type kinds" }
78  if (max(nan, 3.d0, 2.d0) /= 3.d0) STOP 25! { dg-warning "Extension: Different type kinds" }
79  if (min(nan, 3.d0, 2.d0) /= 2.d0) STOP 26! { dg-warning "Extension: Different type kinds" }
80
81  if (.not. isnan(min(nan,nan,nan))) STOP 27
82  if (.not. isnan(max(nan,nan,nan))) STOP 28
83  if (.not. isnan(min(nan,nan,nan,nan))) STOP 29
84  if (.not. isnan(max(nan,nan,nan,nan))) STOP 30
85  if (.not. isnan(min(nan,nan,nan,nan,nan))) STOP 31
86  if (.not. isnan(max(nan,nan,nan,nan,nan))) STOP 32
87
88  ! Large values, INF and NaNs
89  if (.not. isinf(max(large, inf))) STOP 33
90  if (isinf(min(large, inf))) STOP 34
91  if (.not. isinf(max(nan, large, inf))) STOP 35
92  if (isinf(min(nan, large, inf))) STOP 36
93  if (.not. isinf(max(large, nan, inf))) STOP 37
94  if (isinf(min(large, nan, inf))) STOP 38
95  if (.not. isinf(max(large, inf, nan))) STOP 39
96  if (isinf(min(large, inf, nan))) STOP 40
97
98  if (.not. isinf(min(-large, -inf))) STOP 41
99  if (isinf(max(-large, -inf))) STOP 42
100  if (.not. isinf(min(nan, -large, -inf))) STOP 43
101  if (isinf(max(nan, -large, -inf))) STOP 44
102  if (.not. isinf(min(-large, nan, -inf))) STOP 45
103  if (isinf(max(-large, nan, -inf))) STOP 46
104  if (.not. isinf(min(-large, -inf, nan))) STOP 47
105  if (isinf(max(-large, -inf, nan))) STOP 48
106
107end program test
108