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-options "-pedantic-errors -mieee" { target sh*-*-* } }
   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) call abort
  58   if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
  59       (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
  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)) call abort
  65   if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
  66
  67   ! Check that MIN and MAX behave correctly
  68   if (max(2.0, nan) /= 2.0) call abort
  69   if (min(2.0, nan) /= 2.0) call abort
  70   if (max(nan, 2.0) /= 2.0) call abort
  71   if (min(nan, 2.0) /= 2.0) call abort
  72
  73   if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  74   if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  75   if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  76   if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  77
  78   if (.not. isnan(min(nan,nan))) call abort
  79   if (.not. isnan(max(nan,nan))) call abort
  80
  81   ! Same thing, with more arguments
  82
  83   if (max(3.0, 2.0, nan) /= 3.0) call abort
  84   if (min(3.0, 2.0, nan) /= 2.0) call abort
  85   if (max(3.0, nan, 2.0) /= 3.0) call abort
  86   if (min(3.0, nan, 2.0) /= 2.0) call abort
  87   if (max(nan, 3.0, 2.0) /= 3.0) call abort
  88   if (min(nan, 3.0, 2.0) /= 2.0) call abort
  89
  90   if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  91   if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  92   if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  93   if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  94   if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  95   if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  96
  97   if (.not. isnan(min(nan,nan,nan))) call abort
  98   if (.not. isnan(max(nan,nan,nan))) call abort
  99   if (.not. isnan(min(nan,nan,nan,nan))) call abort
 100   if (.not. isnan(max(nan,nan,nan,nan))) call abort
 101   if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
 102   if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
 103
 104   ! Large values, INF and NaNs
 105   if (.not. isinf(max(large, inf))) call abort
 106   if (isinf(min(large, inf))) call abort
 107   if (.not. isinf(max(nan, large, inf))) call abort
 108   if (isinf(min(nan, large, inf))) call abort
 109   if (.not. isinf(max(large, nan, inf))) call abort
 110   if (isinf(min(large, nan, inf))) call abort
 111   if (.not. isinf(max(large, inf, nan))) call abort
 112   if (isinf(min(large, inf, nan))) call abort
 113
 114   if (.not. isinf(min(-large, -inf))) call abort
 115   if (isinf(max(-large, -inf))) call abort
 116   if (.not. isinf(min(nan, -large, -inf))) call abort
 117   if (isinf(max(nan, -large, -inf))) call abort
 118   if (.not. isinf(min(-large, nan, -inf))) call abort
 119   if (isinf(max(-large, nan, -inf))) call abort
 120   if (.not. isinf(min(-large, -inf, nan))) call abort
 121   if (isinf(max(-large, -inf, nan))) call abort
 122
 123 end program test
 124
 125 ! { dg-final { cleanup-modules "aux2" } }