blob: e0270a1b5a26ff7c9e5e0acf8a10b4db11731424 [file] [log] [blame]
! { dg-do run }
! { dg-options "-fno-range-check -pedantic" }
! { dg-add-options ieee }
!
! PR fortran/34333
!
! Check that (NaN /= NaN) == .TRUE.
! and some other NaN options.
!
! Contrary to nan_1.f90, PARAMETERs are used and thus
! the front end resolves the min, max and binary operators at
! compile time.
!
module aux2
interface isinf
module procedure isinf_r
module procedure isinf_d
end interface isinf
contains
pure function isinf_r(x) result (isinf)
logical :: isinf
real, intent(in) :: x
isinf = (x > huge(x)) .or. (x < -huge(x))
end function isinf_r
pure function isinf_d(x) result (isinf)
logical :: isinf
double precision, intent(in) :: x
isinf = (x > huge(x)) .or. (x < -huge(x))
end function isinf_d
end module aux2
program test
use aux2
implicit none
real, parameter :: nan = 0.0/0.0, large = huge(large), inf = 1.0/0.0
if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
.or. nan <= nan) STOP 1
if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
(.not. isnan(real(nan,kind=kind(2.d0))))) STOP 2
! Create an INF and check it
if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) STOP 3
if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) STOP 4
! Check that MIN and MAX behave correctly
if (max(2.0, nan) /= 2.0) STOP 5
if (min(2.0, nan) /= 2.0) STOP 6
if (max(nan, 2.0) /= 2.0) STOP 7
if (min(nan, 2.0) /= 2.0) STOP 8
if (max(2.d0, nan) /= 2.d0) STOP 9! { dg-warning "Extension: Different type kinds" }
if (min(2.d0, nan) /= 2.d0) STOP 10! { dg-warning "Extension: Different type kinds" }
if (max(nan, 2.d0) /= 2.d0) STOP 11! { dg-warning "Extension: Different type kinds" }
if (min(nan, 2.d0) /= 2.d0) STOP 12! { dg-warning "Extension: Different type kinds" }
if (.not. isnan(min(nan,nan))) STOP 13
if (.not. isnan(max(nan,nan))) STOP 14
! Same thing, with more arguments
if (max(3.0, 2.0, nan) /= 3.0) STOP 15
if (min(3.0, 2.0, nan) /= 2.0) STOP 16
if (max(3.0, nan, 2.0) /= 3.0) STOP 17
if (min(3.0, nan, 2.0) /= 2.0) STOP 18
if (max(nan, 3.0, 2.0) /= 3.0) STOP 19
if (min(nan, 3.0, 2.0) /= 2.0) STOP 20
if (max(3.d0, 2.d0, nan) /= 3.d0) STOP 21! { dg-warning "Extension: Different type kinds" }
if (min(3.d0, 2.d0, nan) /= 2.d0) STOP 22! { dg-warning "Extension: Different type kinds" }
if (max(3.d0, nan, 2.d0) /= 3.d0) STOP 23! { dg-warning "Extension: Different type kinds" }
if (min(3.d0, nan, 2.d0) /= 2.d0) STOP 24! { dg-warning "Extension: Different type kinds" }
if (max(nan, 3.d0, 2.d0) /= 3.d0) STOP 25! { dg-warning "Extension: Different type kinds" }
if (min(nan, 3.d0, 2.d0) /= 2.d0) STOP 26! { dg-warning "Extension: Different type kinds" }
if (.not. isnan(min(nan,nan,nan))) STOP 27
if (.not. isnan(max(nan,nan,nan))) STOP 28
if (.not. isnan(min(nan,nan,nan,nan))) STOP 29
if (.not. isnan(max(nan,nan,nan,nan))) STOP 30
if (.not. isnan(min(nan,nan,nan,nan,nan))) STOP 31
if (.not. isnan(max(nan,nan,nan,nan,nan))) STOP 32
! Large values, INF and NaNs
if (.not. isinf(max(large, inf))) STOP 33
if (isinf(min(large, inf))) STOP 34
if (.not. isinf(max(nan, large, inf))) STOP 35
if (isinf(min(nan, large, inf))) STOP 36
if (.not. isinf(max(large, nan, inf))) STOP 37
if (isinf(min(large, nan, inf))) STOP 38
if (.not. isinf(max(large, inf, nan))) STOP 39
if (isinf(min(large, inf, nan))) STOP 40
if (.not. isinf(min(-large, -inf))) STOP 41
if (isinf(max(-large, -inf))) STOP 42
if (.not. isinf(min(nan, -large, -inf))) STOP 43
if (isinf(max(nan, -large, -inf))) STOP 44
if (.not. isinf(min(-large, nan, -inf))) STOP 45
if (isinf(max(-large, nan, -inf))) STOP 46
if (.not. isinf(min(-large, -inf, nan))) STOP 47
if (isinf(max(-large, -inf, nan))) STOP 48
end program test