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