gcc/testsuite/gfortran.dg/ieee/ieee_3.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_IS_FINITE
  12
  13   if (ieee_support_datatype(0._s)) then
  14     if (.not. ieee_is_finite(0.2_s)) call abort
  15     if (.not. ieee_is_finite(-0.2_s)) call abort
  16     if (.not. ieee_is_finite(0._s)) call abort
  17     if (.not. ieee_is_finite(-0._s)) call abort
  18     if (.not. ieee_is_finite(tiny(0._s))) call abort
  19     if (.not. ieee_is_finite(tiny(0._s)/100)) call abort
  20     if (.not. ieee_is_finite(huge(0._s))) call abort
  21     if (.not. ieee_is_finite(-huge(0._s))) call abort
  22     sx1 = huge(sx1)
  23     if (ieee_is_finite(2*sx1)) call abort
  24     if (ieee_is_finite(2*(-sx1))) call abort
  25     sx1 = ieee_value(sx1, ieee_quiet_nan)
  26     if (ieee_is_finite(sx1)) call abort
  27   end if
  28
  29   if (ieee_support_datatype(0._d)) then
  30     if (.not. ieee_is_finite(0.2_d)) call abort
  31     if (.not. ieee_is_finite(-0.2_d)) call abort
  32     if (.not. ieee_is_finite(0._d)) call abort
  33     if (.not. ieee_is_finite(-0._d)) call abort
  34     if (.not. ieee_is_finite(tiny(0._d))) call abort
  35     if (.not. ieee_is_finite(tiny(0._d)/100)) call abort
  36     if (.not. ieee_is_finite(huge(0._d))) call abort
  37     if (.not. ieee_is_finite(-huge(0._d))) call abort
  38     dx1 = huge(dx1)
  39     if (ieee_is_finite(2*dx1)) call abort
  40     if (ieee_is_finite(2*(-dx1))) call abort
  41     dx1 = ieee_value(dx1, ieee_quiet_nan)
  42     if (ieee_is_finite(dx1)) call abort
  43   end if
  44
  45   ! Test IEEE_IS_NAN
  46
  47   if (ieee_support_datatype(0._s)) then
  48     if (ieee_is_nan(0.2_s)) call abort
  49     if (ieee_is_nan(-0.2_s)) call abort
  50     if (ieee_is_nan(0._s)) call abort
  51     if (ieee_is_nan(-0._s)) call abort
  52     if (ieee_is_nan(tiny(0._s))) call abort
  53     if (ieee_is_nan(tiny(0._s)/100)) call abort
  54     if (ieee_is_nan(huge(0._s))) call abort
  55     if (ieee_is_nan(-huge(0._s))) call abort
  56     sx1 = huge(sx1)
  57     if (ieee_is_nan(2*sx1)) call abort
  58     if (ieee_is_nan(2*(-sx1))) call abort
  59     sx1 = ieee_value(sx1, ieee_quiet_nan)
  60     if (.not. ieee_is_nan(sx1)) call abort
  61     sx1 = -1
  62     if (.not. ieee_is_nan(sqrt(sx1))) call abort
  63   end if
  64
  65   if (ieee_support_datatype(0._d)) then
  66     if (ieee_is_nan(0.2_d)) call abort
  67     if (ieee_is_nan(-0.2_d)) call abort
  68     if (ieee_is_nan(0._d)) call abort
  69     if (ieee_is_nan(-0._d)) call abort
  70     if (ieee_is_nan(tiny(0._d))) call abort
  71     if (ieee_is_nan(tiny(0._d)/100)) call abort
  72     if (ieee_is_nan(huge(0._d))) call abort
  73     if (ieee_is_nan(-huge(0._d))) call abort
  74     dx1 = huge(dx1)
  75     if (ieee_is_nan(2*dx1)) call abort
  76     if (ieee_is_nan(2*(-dx1))) call abort
  77     dx1 = ieee_value(dx1, ieee_quiet_nan)
  78     if (.not. ieee_is_nan(dx1)) call abort
  79     dx1 = -1
  80     if (.not. ieee_is_nan(sqrt(dx1))) call abort
  81   end if
  82
  83   ! IEEE_IS_NEGATIVE
  84
  85   if (ieee_support_datatype(0._s)) then
  86     if (ieee_is_negative(0.2_s)) call abort
  87     if (.not. ieee_is_negative(-0.2_s)) call abort
  88     if (ieee_is_negative(0._s)) call abort
  89     if (.not. ieee_is_negative(-0._s)) call abort
  90     if (ieee_is_negative(tiny(0._s))) call abort
  91     if (ieee_is_negative(tiny(0._s)/100)) call abort
  92     if (.not. ieee_is_negative(-tiny(0._s))) call abort
  93     if (.not. ieee_is_negative(-tiny(0._s)/100)) call abort
  94     if (ieee_is_negative(huge(0._s))) call abort
  95     if (.not. ieee_is_negative(-huge(0._s))) call abort
  96     sx1 = huge(sx1)
  97     if (ieee_is_negative(2*sx1)) call abort
  98     if (.not. ieee_is_negative(2*(-sx1))) call abort
  99     sx1 = ieee_value(sx1, ieee_quiet_nan)
 100     if (ieee_is_negative(sx1)) call abort
 101     sx1 = -1
 102     if (ieee_is_negative(sqrt(sx1))) call abort
 103   end if
 104
 105   if (ieee_support_datatype(0._d)) then
 106     if (ieee_is_negative(0.2_d)) call abort
 107     if (.not. ieee_is_negative(-0.2_d)) call abort
 108     if (ieee_is_negative(0._d)) call abort
 109     if (.not. ieee_is_negative(-0._d)) call abort
 110     if (ieee_is_negative(tiny(0._d))) call abort
 111     if (ieee_is_negative(tiny(0._d)/100)) call abort
 112     if (.not. ieee_is_negative(-tiny(0._d))) call abort
 113     if (.not. ieee_is_negative(-tiny(0._d)/100)) call abort
 114     if (ieee_is_negative(huge(0._d))) call abort
 115     if (.not. ieee_is_negative(-huge(0._d))) call abort
 116     dx1 = huge(dx1)
 117     if (ieee_is_negative(2*dx1)) call abort
 118     if (.not. ieee_is_negative(2*(-dx1))) call abort
 119     dx1 = ieee_value(dx1, ieee_quiet_nan)
 120     if (ieee_is_negative(dx1)) call abort
 121     dx1 = -1
 122     if (ieee_is_negative(sqrt(dx1))) call abort
 123   end if
 124
 125   ! Test IEEE_IS_NORMAL
 126
 127   if (ieee_support_datatype(0._s)) then
 128     if (.not. ieee_is_normal(0.2_s)) call abort
 129     if (.not. ieee_is_normal(-0.2_s)) call abort
 130     if (.not. ieee_is_normal(0._s)) call abort
 131     if (.not. ieee_is_normal(-0._s)) call abort
 132     if (.not. ieee_is_normal(tiny(0._s))) call abort
 133     if (ieee_is_normal(tiny(0._s)/100)) call abort
 134     if (.not. ieee_is_normal(-tiny(0._s))) call abort
 135     if (ieee_is_normal(-tiny(0._s)/100)) call abort
 136     if (.not. ieee_is_normal(huge(0._s))) call abort
 137     if (.not. ieee_is_normal(-huge(0._s))) call abort
 138     sx1 = huge(sx1)
 139     if (ieee_is_normal(2*sx1)) call abort
 140     if (ieee_is_normal(2*(-sx1))) call abort
 141     sx1 = ieee_value(sx1, ieee_quiet_nan)
 142     if (ieee_is_normal(sx1)) call abort
 143     sx1 = -1
 144     if (ieee_is_normal(sqrt(sx1))) call abort
 145   end if
 146
 147   if (ieee_support_datatype(0._d)) then
 148     if (.not. ieee_is_normal(0.2_d)) call abort
 149     if (.not. ieee_is_normal(-0.2_d)) call abort
 150     if (.not. ieee_is_normal(0._d)) call abort
 151     if (.not. ieee_is_normal(-0._d)) call abort
 152     if (.not. ieee_is_normal(tiny(0._d))) call abort
 153     if (ieee_is_normal(tiny(0._d)/100)) call abort
 154     if (.not. ieee_is_normal(-tiny(0._d))) call abort
 155     if (ieee_is_normal(-tiny(0._d)/100)) call abort
 156     if (.not. ieee_is_normal(huge(0._d))) call abort
 157     if (.not. ieee_is_normal(-huge(0._d))) call abort
 158     dx1 = huge(dx1)
 159     if (ieee_is_normal(2*dx1)) call abort
 160     if (ieee_is_normal(2*(-dx1))) call abort
 161     dx1 = ieee_value(dx1, ieee_quiet_nan)
 162     if (ieee_is_normal(dx1)) call abort
 163     dx1 = -1
 164     if (ieee_is_normal(sqrt(dx1))) call abort
 165   end if
 166
 167 end