gcc/testsuite/gfortran.dg/nan_2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fno-range-check -pedantic" }
   3 ! { dg-add-options ieee }
   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) STOP 1
  43   if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
  44       (.not. isnan(real(nan,kind=kind(2.d0))))) STOP 2
  45
  46   ! Create an INF and check it
  47   if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) STOP 3
  48   if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) STOP 4
  49
  50   ! Check that MIN and MAX behave correctly
  51   if (max(2.0, nan) /= 2.0) STOP 5
  52   if (min(2.0, nan) /= 2.0) STOP 6
  53   if (max(nan, 2.0) /= 2.0) STOP 7
  54   if (min(nan, 2.0) /= 2.0) STOP 8
  55
  56   if (max(2.d0, nan) /= 2.d0) STOP 9! { dg-warning "Extension: Different type kinds" }
  57   if (min(2.d0, nan) /= 2.d0) STOP 10! { dg-warning "Extension: Different type kinds" }
  58   if (max(nan, 2.d0) /= 2.d0) STOP 11! { dg-warning "Extension: Different type kinds" }
  59   if (min(nan, 2.d0) /= 2.d0) STOP 12! { dg-warning "Extension: Different type kinds" }
  60
  61   if (.not. isnan(min(nan,nan))) STOP 13
  62   if (.not. isnan(max(nan,nan))) STOP 14
  63
  64   ! Same thing, with more arguments
  65
  66   if (max(3.0, 2.0, nan) /= 3.0) STOP 15
  67   if (min(3.0, 2.0, nan) /= 2.0) STOP 16
  68   if (max(3.0, nan, 2.0) /= 3.0) STOP 17
  69   if (min(3.0, nan, 2.0) /= 2.0) STOP 18
  70   if (max(nan, 3.0, 2.0) /= 3.0) STOP 19
  71   if (min(nan, 3.0, 2.0) /= 2.0) STOP 20
  72
  73   if (max(3.d0, 2.d0, nan) /= 3.d0) STOP 21! { dg-warning "Extension: Different type kinds" }
  74   if (min(3.d0, 2.d0, nan) /= 2.d0) STOP 22! { dg-warning "Extension: Different type kinds" }
  75   if (max(3.d0, nan, 2.d0) /= 3.d0) STOP 23! { dg-warning "Extension: Different type kinds" }
  76   if (min(3.d0, nan, 2.d0) /= 2.d0) STOP 24! { dg-warning "Extension: Different type kinds" }
  77   if (max(nan, 3.d0, 2.d0) /= 3.d0) STOP 25! { dg-warning "Extension: Different type kinds" }
  78   if (min(nan, 3.d0, 2.d0) /= 2.d0) STOP 26! { dg-warning "Extension: Different type kinds" }
  79
  80   if (.not. isnan(min(nan,nan,nan))) STOP 27
  81   if (.not. isnan(max(nan,nan,nan))) STOP 28
  82   if (.not. isnan(min(nan,nan,nan,nan))) STOP 29
  83   if (.not. isnan(max(nan,nan,nan,nan))) STOP 30
  84   if (.not. isnan(min(nan,nan,nan,nan,nan))) STOP 31
  85   if (.not. isnan(max(nan,nan,nan,nan,nan))) STOP 32
  86
  87   ! Large values, INF and NaNs
  88   if (.not. isinf(max(large, inf))) STOP 33
  89   if (isinf(min(large, inf))) STOP 34
  90   if (.not. isinf(max(nan, large, inf))) STOP 35
  91   if (isinf(min(nan, large, inf))) STOP 36
  92   if (.not. isinf(max(large, nan, inf))) STOP 37
  93   if (isinf(min(large, nan, inf))) STOP 38
  94   if (.not. isinf(max(large, inf, nan))) STOP 39
  95   if (isinf(min(large, inf, nan))) STOP 40
  96
  97   if (.not. isinf(min(-large, -inf))) STOP 41
  98   if (isinf(max(-large, -inf))) STOP 42
  99   if (.not. isinf(min(nan, -large, -inf))) STOP 43
 100   if (isinf(max(nan, -large, -inf))) STOP 44
 101   if (.not. isinf(min(-large, nan, -inf))) STOP 45
 102   if (isinf(max(-large, nan, -inf))) STOP 46
 103   if (.not. isinf(min(-large, -inf, nan))) STOP 47
 104   if (isinf(max(-large, -inf, nan))) STOP 48
 105
 106 end program test