gcc/testsuite/gfortran.dg/ieee/ieee_4.f90

   1 ! { dg-do run }
   2
   3   use :: ieee_arithmetic
   4   implicit none
   5
   6   real :: sx1, sx2, sx3
   7   double precision :: dx1, dx2, dx3
   8   integer, parameter :: s = kind(sx1), d = kind(dx1)
   9   type(ieee_round_type) :: mode
  10
  11   ! Test IEEE_CLASS
  12
  13   if (ieee_support_datatype(0._s)) then
  14     sx1 = 0.1_s
  15     if (ieee_class(sx1) /= ieee_positive_normal) call abort
  16     if (ieee_class(-sx1) /= ieee_negative_normal) call abort
  17     sx1 = huge(sx1)
  18     if (ieee_class(sx1) /= ieee_positive_normal) call abort
  19     if (ieee_class(-sx1) /= ieee_negative_normal) call abort
  20     if (ieee_class(2*sx1) /= ieee_positive_inf) call abort
  21     if (ieee_class(2*(-sx1)) /= ieee_negative_inf) call abort
  22     sx1 = tiny(sx1)
  23     if (ieee_class(sx1) /= ieee_positive_normal) call abort
  24     if (ieee_class(-sx1) /= ieee_negative_normal) call abort
  25     if (ieee_class(sx1 / 2) /= ieee_positive_denormal) call abort
  26     if (ieee_class((-sx1) / 2) /= ieee_negative_denormal) call abort
  27     sx1 = -1
  28     if (ieee_class(sqrt(sx1)) /= ieee_quiet_nan) call abort
  29     sx1 = 0
  30     if (ieee_class(sx1) /= ieee_positive_zero) call abort
  31     if (ieee_class(-sx1) /= ieee_negative_zero) call abort
  32   end if
  33
  34   if (ieee_support_datatype(0._d)) then
  35     dx1 = 0.1_d
  36     if (ieee_class(dx1) /= ieee_positive_normal) call abort
  37     if (ieee_class(-dx1) /= ieee_negative_normal) call abort
  38     dx1 = huge(dx1)
  39     if (ieee_class(dx1) /= ieee_positive_normal) call abort
  40     if (ieee_class(-dx1) /= ieee_negative_normal) call abort
  41     if (ieee_class(2*dx1) /= ieee_positive_inf) call abort
  42     if (ieee_class(2*(-dx1)) /= ieee_negative_inf) call abort
  43     dx1 = tiny(dx1)
  44     if (ieee_class(dx1) /= ieee_positive_normal) call abort
  45     if (ieee_class(-dx1) /= ieee_negative_normal) call abort
  46     if (ieee_class(dx1 / 2) /= ieee_positive_denormal) call abort
  47     if (ieee_class((-dx1) / 2) /= ieee_negative_denormal) call abort
  48     dx1 = -1
  49     if (ieee_class(sqrt(dx1)) /= ieee_quiet_nan) call abort
  50     dx1 = 0
  51     if (ieee_class(dx1) /= ieee_positive_zero) call abort
  52     if (ieee_class(-dx1) /= ieee_negative_zero) call abort
  53   end if
  54
  55   ! Test IEEE_VALUE and IEEE_UNORDERED
  56
  57   if (ieee_support_datatype(0._s)) then
  58     sx1 = ieee_value(sx1, ieee_quiet_nan)
  59     if (.not. ieee_is_nan(sx1)) call abort
  60     if (.not. ieee_unordered(sx1, sx1)) call abort
  61     if (.not. ieee_unordered(sx1, 0._s)) call abort
  62     if (.not. ieee_unordered(sx1, 0._d)) call abort
  63     if (.not. ieee_unordered(0._s, sx1)) call abort
  64     if (.not. ieee_unordered(0._d, sx1)) call abort
  65     if (ieee_unordered(0._s, 0._s)) call abort
  66
  67     sx1 = ieee_value(sx1, ieee_positive_inf)
  68     if (ieee_is_finite(sx1)) call abort
  69     if (ieee_is_nan(sx1)) call abort
  70     if (ieee_is_negative(sx1)) call abort
  71     if (ieee_is_normal(sx1)) call abort
  72
  73     sx1 = ieee_value(sx1, ieee_negative_inf)
  74     if (ieee_is_finite(sx1)) call abort
  75     if (ieee_is_nan(sx1)) call abort
  76     if (.not. ieee_is_negative(sx1)) call abort
  77     if (ieee_is_normal(sx1)) call abort
  78
  79     sx1 = ieee_value(sx1, ieee_positive_normal)
  80     if (.not. ieee_is_finite(sx1)) call abort
  81     if (ieee_is_nan(sx1)) call abort
  82     if (ieee_is_negative(sx1)) call abort
  83     if (.not. ieee_is_normal(sx1)) call abort
  84
  85     sx1 = ieee_value(sx1, ieee_negative_normal)
  86     if (.not. ieee_is_finite(sx1)) call abort
  87     if (ieee_is_nan(sx1)) call abort
  88     if (.not. ieee_is_negative(sx1)) call abort
  89     if (.not. ieee_is_normal(sx1)) call abort
  90
  91     sx1 = ieee_value(sx1, ieee_positive_denormal)
  92     if (.not. ieee_is_finite(sx1)) call abort
  93     if (ieee_is_nan(sx1)) call abort
  94     if (ieee_is_negative(sx1)) call abort
  95     if (ieee_is_normal(sx1)) call abort
  96     if (sx1 <= 0) call abort
  97     if (sx1 >= tiny(sx1)) call abort
  98
  99     sx1 = ieee_value(sx1, ieee_negative_denormal)
 100     if (.not. ieee_is_finite(sx1)) call abort
 101     if (ieee_is_nan(sx1)) call abort
 102     if (.not. ieee_is_negative(sx1)) call abort
 103     if (ieee_is_normal(sx1)) call abort
 104     if (sx1 >= 0) call abort
 105     if (sx1 <= -tiny(sx1)) call abort
 106
 107     sx1 = ieee_value(sx1, ieee_positive_zero)
 108     if (.not. ieee_is_finite(sx1)) call abort
 109     if (ieee_is_nan(sx1)) call abort
 110     if (ieee_is_negative(sx1)) call abort
 111     if (.not. ieee_is_normal(sx1)) call abort
 112     if (sx1 /= 0) call abort
 113
 114     sx1 = ieee_value(sx1, ieee_negative_zero)
 115     if (.not. ieee_is_finite(sx1)) call abort
 116     if (ieee_is_nan(sx1)) call abort
 117     if (.not. ieee_is_negative(sx1)) call abort
 118     if (.not. ieee_is_normal(sx1)) call abort
 119     if (sx1 /= 0) call abort
 120
 121   end if
 122
 123   if (ieee_support_datatype(0._d)) then
 124     dx1 = ieee_value(dx1, ieee_quiet_nan)
 125     if (.not. ieee_is_nan(dx1)) call abort
 126     if (.not. ieee_unordered(dx1, dx1)) call abort
 127     if (.not. ieee_unordered(dx1, 0._s)) call abort
 128     if (.not. ieee_unordered(dx1, 0._d)) call abort
 129     if (.not. ieee_unordered(0._s, dx1)) call abort
 130     if (.not. ieee_unordered(0._d, dx1)) call abort
 131     if (ieee_unordered(0._d, 0._d)) call abort
 132
 133     dx1 = ieee_value(dx1, ieee_positive_inf)
 134     if (ieee_is_finite(dx1)) call abort
 135     if (ieee_is_nan(dx1)) call abort
 136     if (ieee_is_negative(dx1)) call abort
 137     if (ieee_is_normal(dx1)) call abort
 138
 139     dx1 = ieee_value(dx1, ieee_negative_inf)
 140     if (ieee_is_finite(dx1)) call abort
 141     if (ieee_is_nan(dx1)) call abort
 142     if (.not. ieee_is_negative(dx1)) call abort
 143     if (ieee_is_normal(dx1)) call abort
 144
 145     dx1 = ieee_value(dx1, ieee_positive_normal)
 146     if (.not. ieee_is_finite(dx1)) call abort
 147     if (ieee_is_nan(dx1)) call abort
 148     if (ieee_is_negative(dx1)) call abort
 149     if (.not. ieee_is_normal(dx1)) call abort
 150
 151     dx1 = ieee_value(dx1, ieee_negative_normal)
 152     if (.not. ieee_is_finite(dx1)) call abort
 153     if (ieee_is_nan(dx1)) call abort
 154     if (.not. ieee_is_negative(dx1)) call abort
 155     if (.not. ieee_is_normal(dx1)) call abort
 156
 157     dx1 = ieee_value(dx1, ieee_positive_denormal)
 158     if (.not. ieee_is_finite(dx1)) call abort
 159     if (ieee_is_nan(dx1)) call abort
 160     if (ieee_is_negative(dx1)) call abort
 161     if (ieee_is_normal(dx1)) call abort
 162     if (dx1 <= 0) call abort
 163     if (dx1 >= tiny(dx1)) call abort
 164
 165     dx1 = ieee_value(dx1, ieee_negative_denormal)
 166     if (.not. ieee_is_finite(dx1)) call abort
 167     if (ieee_is_nan(dx1)) call abort
 168     if (.not. ieee_is_negative(dx1)) call abort
 169     if (ieee_is_normal(dx1)) call abort
 170     if (dx1 >= 0) call abort
 171     if (dx1 <= -tiny(dx1)) call abort
 172
 173     dx1 = ieee_value(dx1, ieee_positive_zero)
 174     if (.not. ieee_is_finite(dx1)) call abort
 175     if (ieee_is_nan(dx1)) call abort
 176     if (ieee_is_negative(dx1)) call abort
 177     if (.not. ieee_is_normal(dx1)) call abort
 178     if (dx1 /= 0) call abort
 179
 180     dx1 = ieee_value(dx1, ieee_negative_zero)
 181     if (.not. ieee_is_finite(dx1)) call abort
 182     if (ieee_is_nan(dx1)) call abort
 183     if (.not. ieee_is_negative(dx1)) call abort
 184     if (.not. ieee_is_normal(dx1)) call abort
 185     if (dx1 /= 0) call abort
 186
 187   end if
 188
 189 end