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 !
   7 module aux2
   8   interface isnan
   9     module procedure isnan_r
  10     module procedure isnan_d
  11   end interface isnan
  12
  13   interface isinf
  14     module procedure isinf_r
  15     module procedure isinf_d
  16   end interface isinf
  17 contains
  18
  19   pure function isnan_r(x) result (isnan)
  20     logical :: isnan
  21     real, intent(in) :: x
  22
  23     isnan = (.not.(x == x))
  24   end function isnan_r
  25
  26   pure function isnan_d(x) result (isnan)
  27     logical :: isnan
  28     double precision, intent(in) :: x
  29
  30     isnan = (.not.(x == x))
  31   end function isnan_d
  32
  33   pure function isinf_r(x) result (isinf)
  34     logical :: isinf
  35     real, intent(in) :: x
  36
  37     isinf = (x > huge(x)) .or. (x < -huge(x))
  38   end function isinf_r
  39
  40   pure function isinf_d(x) result (isinf)
  41     logical :: isinf
  42     double precision, intent(in) :: x
  43
  44     isinf = (x > huge(x)) .or. (x < -huge(x))
  45   end function isinf_d
  46 end module aux2
  47
  48 program test
  49   use aux2
  50   implicit none
  51   real :: nan, large, inf
  52
  53   ! Create a NaN and check it
  54   nan = 0
  55   nan = nan / nan
  56   if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
  57       .or. nan <= nan) STOP 1
  58   if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
  59       (.not. isnan(real(nan,kind=kind(2.d0))))) STOP 2
  60
  61   ! Create an INF and check it
  62   large = huge(large)
  63   inf = 2 * large
  64   if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) STOP 3
  65   if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) STOP 4
  66
  67   ! Check that MIN and MAX behave correctly
  68
  69   if (.not. isnan(min(nan,nan))) STOP 13
  70   if (.not. isnan(max(nan,nan))) STOP 14
  71
  72   ! Same thing, with more arguments
  73
  74   if (.not. isnan(min(nan,nan,nan))) STOP 27
  75   if (.not. isnan(max(nan,nan,nan))) STOP 28
  76   if (.not. isnan(min(nan,nan,nan,nan))) STOP 29
  77   if (.not. isnan(max(nan,nan,nan,nan))) STOP 30
  78   if (.not. isnan(min(nan,nan,nan,nan,nan))) STOP 31
  79   if (.not. isnan(max(nan,nan,nan,nan,nan))) STOP 32
  80
  81   ! Large values, INF and NaNs
  82   if (.not. isinf(max(large, inf))) STOP 33
  83   if (isinf(min(large, inf))) STOP 34
  84
  85   if (.not. isinf(min(-large, -inf))) STOP 41
  86   if (isinf(max(-large, -inf))) STOP 42
  87
  88 end program test