1 ! Test if MIN and MAX intrinsics behave correctly when passed NaNs
5 ! { dg-add-options ieee }
6 ! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
10 module procedure isnan_r
11 module procedure isnan_d
15 module procedure isinf_r
16 module procedure isinf_d
20 pure function isnan_r(x) result (isnan)
24 isnan = (.not.(x == x))
27 pure function isnan_d(x) result (isnan)
29 double precision, intent(in) :: x
31 isnan = (.not.(x == x))
34 pure function isinf_r(x) result (isinf)
38 isinf = (x > huge(x)) .or. (x < -huge(x))
41 pure function isinf_d(x) result (isinf)
43 double precision, intent(in) :: x
45 isinf = (x > huge(x)) .or. (x < -huge(x))
52 real :: nan, large, inf
54 ! Create a NaN and check it
57 if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
58 .or. nan <= nan) call abort
59 if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
60 (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
62 ! Create an INF and check it
65 if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
66 if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
68 ! Check that MIN and MAX behave correctly
69 if (max(2.0, nan) /= 2.0) call abort
70 if (min(2.0, nan) /= 2.0) call abort
71 if (max(nan, 2.0) /= 2.0) call abort
72 if (min(nan, 2.0) /= 2.0) call abort
74 if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
75 if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
76 if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
77 if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
79 if (.not. isnan(min(nan,nan))) call abort
80 if (.not. isnan(max(nan,nan))) call abort
82 ! Same thing, with more arguments
84 if (max(3.0, 2.0, nan) /= 3.0) call abort
85 if (min(3.0, 2.0, nan) /= 2.0) call abort
86 if (max(3.0, nan, 2.0) /= 3.0) call abort
87 if (min(3.0, nan, 2.0) /= 2.0) call abort
88 if (max(nan, 3.0, 2.0) /= 3.0) call abort
89 if (min(nan, 3.0, 2.0) /= 2.0) call abort
91 if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
92 if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
93 if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
94 if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
95 if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
96 if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
98 if (.not. isnan(min(nan,nan,nan))) call abort
99 if (.not. isnan(max(nan,nan,nan))) call abort
100 if (.not. isnan(min(nan,nan,nan,nan))) call abort
101 if (.not. isnan(max(nan,nan,nan,nan))) call abort
102 if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
103 if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
105 ! Large values, INF and NaNs
106 if (.not. isinf(max(large, inf))) call abort
107 if (isinf(min(large, inf))) call abort
108 if (.not. isinf(max(nan, large, inf))) call abort
109 if (isinf(min(nan, large, inf))) call abort
110 if (.not. isinf(max(large, nan, inf))) call abort
111 if (isinf(min(large, nan, inf))) call abort
112 if (.not. isinf(max(large, inf, nan))) call abort
113 if (isinf(min(large, inf, nan))) call abort
115 if (.not. isinf(min(-large, -inf))) call abort
116 if (isinf(max(-large, -inf))) call abort
117 if (.not. isinf(min(nan, -large, -inf))) call abort
118 if (isinf(max(nan, -large, -inf))) call abort
119 if (.not. isinf(min(-large, nan, -inf))) call abort
120 if (isinf(max(-large, nan, -inf))) call abort
121 if (.not. isinf(min(-large, -inf, nan))) call abort
122 if (isinf(max(-large, -inf, nan))) call abort