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