gcc/testsuite/gfortran.dg/nan_1.f90

! Test if MIN and MAX intrinsics behave correctly when passed NaNs
! as arguments
!
! { dg-do run }
! { dg-add-options ieee }
! { dg-skip-if "NaN not supported" { spu-*-* } }
!
module aux2
  interface isnan
    module procedure isnan_r
    module procedure isnan_d
  end interface isnan

  interface isinf
    module procedure isinf_r
    module procedure isinf_d
  end interface isinf
contains

  pure function isnan_r(x) result (isnan)
    logical :: isnan
    real, intent(in) :: x

    isnan = (.not.(x == x))
  end function isnan_r

  pure function isnan_d(x) result (isnan)
    logical :: isnan
    double precision, intent(in) :: x

    isnan = (.not.(x == x))
  end function isnan_d

  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 :: nan, large, inf

  ! Create a NaN and check it
  nan = 0
  nan = nan / nan
  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
  large = huge(large)
  inf = 2 * large
  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