1 ! Test if MIN and MAX intrinsics behave correctly when passed NaNs
5 ! { dg-options "-pedantic-errors -mieee" { target sh*-*-* } }
9 module procedure isnan_r
10 module procedure isnan_d
14 module procedure isinf_r
15 module procedure isinf_d
19 pure function isnan_r(x) result (isnan)
23 isnan = (.not.(x == x))
26 pure function isnan_d(x) result (isnan)
28 double precision, intent(in) :: x
30 isnan = (.not.(x == x))
33 pure function isinf_r(x) result (isinf)
37 isinf = (x > huge(x)) .or. (x < -huge(x))
40 pure function isinf_d(x) result (isinf)
42 double precision, intent(in) :: x
44 isinf = (x > huge(x)) .or. (x < -huge(x))
51 real :: nan, large, inf
53 ! Create a NaN and check it
56 if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
57 .or. nan <= nan) call abort
58 if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
59 (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
61 ! Create an INF and check it
64 if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
65 if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
67 ! Check that MIN and MAX behave correctly
68 if (max(2.0, nan) /= 2.0) call abort
69 if (min(2.0, nan) /= 2.0) call abort
70 if (max(nan, 2.0) /= 2.0) call abort
71 if (min(nan, 2.0) /= 2.0) call abort
73 if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
74 if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
75 if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
76 if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
78 if (.not. isnan(min(nan,nan))) call abort
79 if (.not. isnan(max(nan,nan))) call abort
81 ! Same thing, with more arguments
83 if (max(3.0, 2.0, nan) /= 3.0) call abort
84 if (min(3.0, 2.0, nan) /= 2.0) call abort
85 if (max(3.0, nan, 2.0) /= 3.0) call abort
86 if (min(3.0, nan, 2.0) /= 2.0) call abort
87 if (max(nan, 3.0, 2.0) /= 3.0) call abort
88 if (min(nan, 3.0, 2.0) /= 2.0) call abort
90 if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
91 if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
92 if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
93 if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
94 if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
95 if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
97 if (.not. isnan(min(nan,nan,nan))) call abort
98 if (.not. isnan(max(nan,nan,nan))) call abort
99 if (.not. isnan(min(nan,nan,nan,nan))) call abort
100 if (.not. isnan(max(nan,nan,nan,nan))) call abort
101 if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
102 if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
104 ! Large values, INF and NaNs
105 if (.not. isinf(max(large, inf))) call abort
106 if (isinf(min(large, inf))) call abort
107 if (.not. isinf(max(nan, large, inf))) call abort
108 if (isinf(min(nan, large, inf))) call abort
109 if (.not. isinf(max(large, nan, inf))) call abort
110 if (isinf(min(large, nan, inf))) call abort
111 if (.not. isinf(max(large, inf, nan))) call abort
112 if (isinf(min(large, inf, nan))) call abort
114 if (.not. isinf(min(-large, -inf))) call abort
115 if (isinf(max(-large, -inf))) call abort
116 if (.not. isinf(min(nan, -large, -inf))) call abort
117 if (isinf(max(nan, -large, -inf))) call abort
118 if (.not. isinf(min(-large, nan, -inf))) call abort
119 if (isinf(max(-large, nan, -inf))) call abort
120 if (.not. isinf(min(-large, -inf, nan))) call abort
121 if (isinf(max(-large, -inf, nan))) call abort
125 ! { dg-final { cleanup-modules "aux2" } }