gcc/testsuite/gfortran.dg/nan_2.f90

   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
  16 module aux2
  17   interface isinf
  18     module procedure isinf_r
  19     module procedure isinf_d
  20   end interface isinf
  21 contains
  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
  35 end module aux2
  36
  37 program 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
 107 end program test
 108 ! { dg-final { cleanup-modules "aux2" } }