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