view gcc/testsuite/gfortran.dg/nan_2.f90 @ 152:2b5abeee2509

update gcc11
author anatofuz
date Mon, 25 May 2020 07:50:57 +0900
parents 1830386684a0
children
line wrap: on
line source

! { 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