gcc/testsuite/gfortran.dg/nan_2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fno-range-check -pedantic" }
   3 ! { dg-options "-fno-range-check -pedantic -mieee" { target alpha*-*-* sh*-*-* } }
   4 !
   5 ! PR fortran/34333
   6 !
   7 ! Check that (NaN /= NaN) == .TRUE.
   8 ! and some other NaN options.
   9 !
  10 ! Contrary to nan_1.f90, PARAMETERs are used and thus
  11 ! the front end resolves the min, max and binary operators at
  12 ! compile time.
  13 !
  14
  15 module aux2
  16   interface isinf
  17     module procedure isinf_r
  18     module procedure isinf_d
  19   end interface isinf
  20 contains
  21   pure function isinf_r(x) result (isinf)
  22     logical :: isinf
  23     real, intent(in) :: x
  24
  25     isinf = (x > huge(x)) .or. (x < -huge(x))
  26   end function isinf_r
  27
  28   pure function isinf_d(x) result (isinf)
  29     logical :: isinf
  30     double precision, intent(in) :: x
  31
  32     isinf = (x > huge(x)) .or. (x < -huge(x))
  33   end function isinf_d
  34 end module aux2
  35
  36 program test
  37   use aux2
  38   implicit none
  39   real, parameter :: nan = 0.0/0.0, large = huge(large), inf = 1.0/0.0
  40
  41   if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
  42       .or. nan <= nan) call abort
  43   if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
  44       (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
  45
  46   ! Create an INF and check it
  47   if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
  48   if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
  49
  50   ! Check that MIN and MAX behave correctly
  51   if (max(2.0, nan) /= 2.0) call abort
  52   if (min(2.0, nan) /= 2.0) call abort
  53   if (max(nan, 2.0) /= 2.0) call abort
  54   if (min(nan, 2.0) /= 2.0) call abort
  55
  56   if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  57   if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  58   if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  59   if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  60
  61   if (.not. isnan(min(nan,nan))) call abort
  62   if (.not. isnan(max(nan,nan))) call abort
  63
  64   ! Same thing, with more arguments
  65
  66   if (max(3.0, 2.0, nan) /= 3.0) call abort
  67   if (min(3.0, 2.0, nan) /= 2.0) call abort
  68   if (max(3.0, nan, 2.0) /= 3.0) call abort
  69   if (min(3.0, nan, 2.0) /= 2.0) call abort
  70   if (max(nan, 3.0, 2.0) /= 3.0) call abort
  71   if (min(nan, 3.0, 2.0) /= 2.0) call abort
  72
  73   if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  74   if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  75   if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  76   if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  77   if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  78   if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
  79
  80   if (.not. isnan(min(nan,nan,nan))) call abort
  81   if (.not. isnan(max(nan,nan,nan))) call abort
  82   if (.not. isnan(min(nan,nan,nan,nan))) call abort
  83   if (.not. isnan(max(nan,nan,nan,nan))) call abort
  84   if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
  85   if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
  86
  87   ! Large values, INF and NaNs
  88   if (.not. isinf(max(large, inf))) call abort
  89   if (isinf(min(large, inf))) call abort
  90   if (.not. isinf(max(nan, large, inf))) call abort
  91   if (isinf(min(nan, large, inf))) call abort
  92   if (.not. isinf(max(large, nan, inf))) call abort
  93   if (isinf(min(large, nan, inf))) call abort
  94   if (.not. isinf(max(large, inf, nan))) call abort
  95   if (isinf(min(large, inf, nan))) call abort
  96
  97   if (.not. isinf(min(-large, -inf))) call abort
  98   if (isinf(max(-large, -inf))) call abort
  99   if (.not. isinf(min(nan, -large, -inf))) call abort
 100   if (isinf(max(nan, -large, -inf))) call abort
 101   if (.not. isinf(min(-large, nan, -inf))) call abort
 102   if (isinf(max(-large, nan, -inf))) call abort
 103   if (.not. isinf(min(-large, -inf, nan))) call abort
 104   if (isinf(max(-large, -inf, nan))) call abort
 105
 106 end program test