gcc/testsuite/gfortran.dg/nan_1.f90

   1 ! Test if MIN and MAX intrinsics behave correctly when passed NaNs
   2 ! as arguments
   3 !
   4 ! { dg-do run }
   5 ! { dg-add-options ieee }
   6 ! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
   7 !
   8 module aux2
   9   interface isnan
  10     module procedure isnan_r
  11     module procedure isnan_d
  12   end interface isnan
  13
  14   interface isinf
  15     module procedure isinf_r
  16     module procedure isinf_d
  17   end interface isinf
  18 contains
  19
  20   pure function isnan_r(x) result (isnan)
  21     logical :: isnan
  22     real, intent(in) :: x
  23
  24     isnan = (.not.(x == x))
  25   end function isnan_r
  26
  27   pure function isnan_d(x) result (isnan)
  28     logical :: isnan
  29     double precision, intent(in) :: x
  30
  31     isnan = (.not.(x == x))
  32   end function isnan_d
  33
  34   pure function isinf_r(x) result (isinf)
  35     logical :: isinf
  36     real, intent(in) :: x
  37
  38     isinf = (x > huge(x)) .or. (x < -huge(x))
  39   end function isinf_r
  40
  41   pure function isinf_d(x) result (isinf)
  42     logical :: isinf
  43     double precision, intent(in) :: x
  44
  45     isinf = (x > huge(x)) .or. (x < -huge(x))
  46   end function isinf_d
  47 end module aux2
  48
  49 program test
  50   use aux2
  51   implicit none
  52   real :: nan, large, inf
  53
  54   ! Create a NaN and check it
  55   nan = 0
  56   nan = nan / nan
  57   if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
  58       .or. nan <= nan) call abort
  59   if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
  60       (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
  61
  62   ! Create an INF and check it
  63   large = huge(large)
  64   inf = 2 * large
  65   if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
  66   if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
  67
  68   ! Check that MIN and MAX behave correctly
  69   if (max(2.0, nan) /= 2.0) call abort
  70   if (min(2.0, nan) /= 2.0) call abort
  71   if (max(nan, 2.0) /= 2.0) call abort
  72   if (min(nan, 2.0) /= 2.0) call abort
  73
  74   if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  75   if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  76   if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  77   if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  78
  79   if (.not. isnan(min(nan,nan))) call abort
  80   if (.not. isnan(max(nan,nan))) call abort
  81
  82   ! Same thing, with more arguments
  83
  84   if (max(3.0, 2.0, nan) /= 3.0) call abort
  85   if (min(3.0, 2.0, nan) /= 2.0) call abort
  86   if (max(3.0, nan, 2.0) /= 3.0) call abort
  87   if (min(3.0, nan, 2.0) /= 2.0) call abort
  88   if (max(nan, 3.0, 2.0) /= 3.0) call abort
  89   if (min(nan, 3.0, 2.0) /= 2.0) call abort
  90
  91   if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  92   if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  93   if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  94   if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  95   if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  96   if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  97
  98   if (.not. isnan(min(nan,nan,nan))) call abort
  99   if (.not. isnan(max(nan,nan,nan))) call abort
 100   if (.not. isnan(min(nan,nan,nan,nan))) call abort
 101   if (.not. isnan(max(nan,nan,nan,nan))) call abort
 102   if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
 103   if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
 104
 105   ! Large values, INF and NaNs
 106   if (.not. isinf(max(large, inf))) call abort
 107   if (isinf(min(large, inf))) call abort
 108   if (.not. isinf(max(nan, large, inf))) call abort
 109   if (isinf(min(nan, large, inf))) call abort
 110   if (.not. isinf(max(large, nan, inf))) call abort
 111   if (isinf(min(large, nan, inf))) call abort
 112   if (.not. isinf(max(large, inf, nan))) call abort
 113   if (isinf(min(large, inf, nan))) call abort
 114
 115   if (.not. isinf(min(-large, -inf))) call abort
 116   if (isinf(max(-large, -inf))) call abort
 117   if (.not. isinf(min(nan, -large, -inf))) call abort
 118   if (isinf(max(nan, -large, -inf))) call abort
 119   if (.not. isinf(min(-large, nan, -inf))) call abort
 120   if (isinf(max(-large, nan, -inf))) call abort
 121   if (.not. isinf(min(-large, -inf, nan))) call abort
 122   if (isinf(max(-large, -inf, nan))) call abort
 123
 124 end program test
 125
 126 ! { dg-final { cleanup-modules "aux2" } }