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) call abort
44  if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
45      (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
46
47  ! Create an INF and check it
48  if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
49  if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
50
51  ! Check that MIN and MAX behave correctly
52  if (max(2.0, nan) /= 2.0) call abort
53  if (min(2.0, nan) /= 2.0) call abort
54  if (max(nan, 2.0) /= 2.0) call abort
55  if (min(nan, 2.0) /= 2.0) call abort
56
57  if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
58  if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
59  if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
60  if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
61
62  if (.not. isnan(min(nan,nan))) call abort
63  if (.not. isnan(max(nan,nan))) call abort
64
65  ! Same thing, with more arguments
66
67  if (max(3.0, 2.0, nan) /= 3.0) call abort
68  if (min(3.0, 2.0, nan) /= 2.0) call abort
69  if (max(3.0, nan, 2.0) /= 3.0) call abort
70  if (min(3.0, nan, 2.0) /= 2.0) call abort
71  if (max(nan, 3.0, 2.0) /= 3.0) call abort
72  if (min(nan, 3.0, 2.0) /= 2.0) call abort
73
74  if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
75  if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
76  if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
77  if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
78  if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
79  if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
80
81  if (.not. isnan(min(nan,nan,nan))) call abort
82  if (.not. isnan(max(nan,nan,nan))) call abort
83  if (.not. isnan(min(nan,nan,nan,nan))) call abort
84  if (.not. isnan(max(nan,nan,nan,nan))) call abort
85  if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
86  if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
87
88  ! Large values, INF and NaNs
89  if (.not. isinf(max(large, inf))) call abort
90  if (isinf(min(large, inf))) call abort
91  if (.not. isinf(max(nan, large, inf))) call abort
92  if (isinf(min(nan, large, inf))) call abort
93  if (.not. isinf(max(large, nan, inf))) call abort
94  if (isinf(min(large, nan, inf))) call abort
95  if (.not. isinf(max(large, inf, nan))) call abort
96  if (isinf(min(large, inf, nan))) call abort
97
98  if (.not. isinf(min(-large, -inf))) call abort
99  if (isinf(max(-large, -inf))) call abort
100  if (.not. isinf(min(nan, -large, -inf))) call abort
101  if (isinf(max(nan, -large, -inf))) call abort
102  if (.not. isinf(min(-large, nan, -inf))) call abort
103  if (isinf(max(-large, nan, -inf))) call abort
104  if (.not. isinf(min(-large, -inf, nan))) call abort
105  if (isinf(max(-large, -inf, nan))) call abort
106
107end program test
108