1! Test if MIN and MAX intrinsics behave correctly when passed NaNs 2! as arguments 3! 4! { dg-do run } 5! { dg-add-options ieee } 6! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } } 7! 8module aux2 9 interface isnan 10 module procedure isnan_r 11 module procedure isnan_d 12 end interface isnan 13 14 interface isinf 15 module procedure isinf_r 16 module procedure isinf_d 17 end interface isinf 18contains 19 20 pure function isnan_r(x) result (isnan) 21 logical :: isnan 22 real, intent(in) :: x 23 24 isnan = (.not.(x == x)) 25 end function isnan_r 26 27 pure function isnan_d(x) result (isnan) 28 logical :: isnan 29 double precision, intent(in) :: x 30 31 isnan = (.not.(x == x)) 32 end function isnan_d 33 34 pure function isinf_r(x) result (isinf) 35 logical :: isinf 36 real, intent(in) :: x 37 38 isinf = (x > huge(x)) .or. (x < -huge(x)) 39 end function isinf_r 40 41 pure function isinf_d(x) result (isinf) 42 logical :: isinf 43 double precision, intent(in) :: x 44 45 isinf = (x > huge(x)) .or. (x < -huge(x)) 46 end function isinf_d 47end module aux2 48 49program test 50 use aux2 51 implicit none 52 real :: nan, large, inf 53 54 ! Create a NaN and check it 55 nan = 0 56 nan = nan / nan 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 61 62 ! Create an INF and check it 63 large = huge(large) 64 inf = 2 * large 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 67 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 73 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" } 78 79 if (.not. isnan(min(nan,nan))) call abort 80 if (.not. isnan(max(nan,nan))) call abort 81 82 ! Same thing, with more arguments 83 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 90 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" } 97 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 104 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 114 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 123 124end program test 125