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 167end 168