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) STOP 1
  59   if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
  60       (.not. isnan(real(nan,kind=kind(2.d0))))) STOP 2
  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)) STOP 3
  66   if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) STOP 4
  67
  68   ! Check that MIN and MAX behave correctly
  69
  70   if (.not. isnan(min(nan,nan))) STOP 13
  71   if (.not. isnan(max(nan,nan))) STOP 14
  72
  73   ! Same thing, with more arguments
  74
  75   if (.not. isnan(min(nan,nan,nan))) STOP 27
  76   if (.not. isnan(max(nan,nan,nan))) STOP 28
  77   if (.not. isnan(min(nan,nan,nan,nan))) STOP 29
  78   if (.not. isnan(max(nan,nan,nan,nan))) STOP 30
  79   if (.not. isnan(min(nan,nan,nan,nan,nan))) STOP 31
  80   if (.not. isnan(max(nan,nan,nan,nan,nan))) STOP 32
  81
  82   ! Large values, INF and NaNs
  83   if (.not. isinf(max(large, inf))) STOP 33
  84   if (isinf(min(large, inf))) STOP 34
  85
  86   if (.not. isinf(min(-large, -inf))) STOP 41
  87   if (isinf(max(-large, -inf))) STOP 42
  88
  89 end program test