gcc/testsuite/gfortran.dg/nan_2.f90

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