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   if (max(2.0, nan) /= 2.0) STOP 5
  70   if (min(2.0, nan) /= 2.0) STOP 6
  71   if (max(nan, 2.0) /= 2.0) STOP 7
  72   if (min(nan, 2.0) /= 2.0) STOP 8
  73
  74   if (max(2.d0, nan) /= 2.d0) STOP 9! { dg-warning "Extension: Different type kinds" }
  75   if (min(2.d0, nan) /= 2.d0) STOP 10! { dg-warning "Extension: Different type kinds" }
  76   if (max(nan, 2.d0) /= 2.d0) STOP 11! { dg-warning "Extension: Different type kinds" }
  77   if (min(nan, 2.d0) /= 2.d0) STOP 12! { dg-warning "Extension: Different type kinds" }
  78
  79   if (.not. isnan(min(nan,nan))) STOP 13
  80   if (.not. isnan(max(nan,nan))) STOP 14
  81
  82   ! Same thing, with more arguments
  83
  84   if (max(3.0, 2.0, nan) /= 3.0) STOP 15
  85   if (min(3.0, 2.0, nan) /= 2.0) STOP 16
  86   if (max(3.0, nan, 2.0) /= 3.0) STOP 17
  87   if (min(3.0, nan, 2.0) /= 2.0) STOP 18
  88   if (max(nan, 3.0, 2.0) /= 3.0) STOP 19
  89   if (min(nan, 3.0, 2.0) /= 2.0) STOP 20
  90
  91   if (max(3.d0, 2.d0, nan) /= 3.d0) STOP 21! { dg-warning "Extension: Different type kinds" }
  92   if (min(3.d0, 2.d0, nan) /= 2.d0) STOP 22! { dg-warning "Extension: Different type kinds" }
  93   if (max(3.d0, nan, 2.d0) /= 3.d0) STOP 23! { dg-warning "Extension: Different type kinds" }
  94   if (min(3.d0, nan, 2.d0) /= 2.d0) STOP 24! { dg-warning "Extension: Different type kinds" }
  95   if (max(nan, 3.d0, 2.d0) /= 3.d0) STOP 25! { dg-warning "Extension: Different type kinds" }
  96   if (min(nan, 3.d0, 2.d0) /= 2.d0) STOP 26! { dg-warning "Extension: Different type kinds" }
  97
  98   if (.not. isnan(min(nan,nan,nan))) STOP 27
  99   if (.not. isnan(max(nan,nan,nan))) STOP 28
 100   if (.not. isnan(min(nan,nan,nan,nan))) STOP 29
 101   if (.not. isnan(max(nan,nan,nan,nan))) STOP 30
 102   if (.not. isnan(min(nan,nan,nan,nan,nan))) STOP 31
 103   if (.not. isnan(max(nan,nan,nan,nan,nan))) STOP 32
 104
 105   ! Large values, INF and NaNs
 106   if (.not. isinf(max(large, inf))) STOP 33
 107   if (isinf(min(large, inf))) STOP 34
 108   if (.not. isinf(max(nan, large, inf))) STOP 35
 109   if (isinf(min(nan, large, inf))) STOP 36
 110   if (.not. isinf(max(large, nan, inf))) STOP 37
 111   if (isinf(min(large, nan, inf))) STOP 38
 112   if (.not. isinf(max(large, inf, nan))) STOP 39
 113   if (isinf(min(large, inf, nan))) STOP 40
 114
 115   if (.not. isinf(min(-large, -inf))) STOP 41
 116   if (isinf(max(-large, -inf))) STOP 42
 117   if (.not. isinf(min(nan, -large, -inf))) STOP 43
 118   if (isinf(max(nan, -large, -inf))) STOP 44
 119   if (.not. isinf(min(-large, nan, -inf))) STOP 45
 120   if (isinf(max(-large, nan, -inf))) STOP 46
 121   if (.not. isinf(min(-large, -inf, nan))) STOP 47
 122   if (isinf(max(-large, -inf, nan))) STOP 48
 123
 124 end program test