| ! { dg-do run } |
| |
| use :: ieee_arithmetic |
| implicit none |
| |
| real :: sx1, sx2, sx3 |
| double precision :: dx1, dx2, dx3 |
| integer, parameter :: s = kind(sx1), d = kind(dx1) |
| type(ieee_round_type) :: mode |
| |
| ! Test IEEE_IS_FINITE |
| |
| if (ieee_support_datatype(0._s)) then |
| if (.not. ieee_is_finite(0.2_s)) STOP 1 |
| if (.not. ieee_is_finite(-0.2_s)) STOP 2 |
| if (.not. ieee_is_finite(0._s)) STOP 3 |
| if (.not. ieee_is_finite(-0._s)) STOP 4 |
| if (.not. ieee_is_finite(tiny(0._s))) STOP 5 |
| if (.not. ieee_is_finite(tiny(0._s)/100)) STOP 6 |
| if (.not. ieee_is_finite(huge(0._s))) STOP 7 |
| if (.not. ieee_is_finite(-huge(0._s))) STOP 8 |
| sx1 = huge(sx1) |
| if (ieee_is_finite(2*sx1)) STOP 9 |
| if (ieee_is_finite(2*(-sx1))) STOP 10 |
| sx1 = ieee_value(sx1, ieee_quiet_nan) |
| if (ieee_is_finite(sx1)) STOP 11 |
| end if |
| |
| if (ieee_support_datatype(0._d)) then |
| if (.not. ieee_is_finite(0.2_d)) STOP 12 |
| if (.not. ieee_is_finite(-0.2_d)) STOP 13 |
| if (.not. ieee_is_finite(0._d)) STOP 14 |
| if (.not. ieee_is_finite(-0._d)) STOP 15 |
| if (.not. ieee_is_finite(tiny(0._d))) STOP 16 |
| if (.not. ieee_is_finite(tiny(0._d)/100)) STOP 17 |
| if (.not. ieee_is_finite(huge(0._d))) STOP 18 |
| if (.not. ieee_is_finite(-huge(0._d))) STOP 19 |
| dx1 = huge(dx1) |
| if (ieee_is_finite(2*dx1)) STOP 20 |
| if (ieee_is_finite(2*(-dx1))) STOP 21 |
| dx1 = ieee_value(dx1, ieee_quiet_nan) |
| if (ieee_is_finite(dx1)) STOP 22 |
| end if |
| |
| ! Test IEEE_IS_NAN |
| |
| if (ieee_support_datatype(0._s)) then |
| if (ieee_is_nan(0.2_s)) STOP 23 |
| if (ieee_is_nan(-0.2_s)) STOP 24 |
| if (ieee_is_nan(0._s)) STOP 25 |
| if (ieee_is_nan(-0._s)) STOP 26 |
| if (ieee_is_nan(tiny(0._s))) STOP 27 |
| if (ieee_is_nan(tiny(0._s)/100)) STOP 28 |
| if (ieee_is_nan(huge(0._s))) STOP 29 |
| if (ieee_is_nan(-huge(0._s))) STOP 30 |
| sx1 = huge(sx1) |
| if (ieee_is_nan(2*sx1)) STOP 31 |
| if (ieee_is_nan(2*(-sx1))) STOP 32 |
| sx1 = ieee_value(sx1, ieee_quiet_nan) |
| if (.not. ieee_is_nan(sx1)) STOP 33 |
| sx1 = -1 |
| if (.not. ieee_is_nan(sqrt(sx1))) STOP 34 |
| end if |
| |
| if (ieee_support_datatype(0._d)) then |
| if (ieee_is_nan(0.2_d)) STOP 35 |
| if (ieee_is_nan(-0.2_d)) STOP 36 |
| if (ieee_is_nan(0._d)) STOP 37 |
| if (ieee_is_nan(-0._d)) STOP 38 |
| if (ieee_is_nan(tiny(0._d))) STOP 39 |
| if (ieee_is_nan(tiny(0._d)/100)) STOP 40 |
| if (ieee_is_nan(huge(0._d))) STOP 41 |
| if (ieee_is_nan(-huge(0._d))) STOP 42 |
| dx1 = huge(dx1) |
| if (ieee_is_nan(2*dx1)) STOP 43 |
| if (ieee_is_nan(2*(-dx1))) STOP 44 |
| dx1 = ieee_value(dx1, ieee_quiet_nan) |
| if (.not. ieee_is_nan(dx1)) STOP 45 |
| dx1 = -1 |
| if (.not. ieee_is_nan(sqrt(dx1))) STOP 46 |
| end if |
| |
| ! IEEE_IS_NEGATIVE |
| |
| if (ieee_support_datatype(0._s)) then |
| if (ieee_is_negative(0.2_s)) STOP 47 |
| if (.not. ieee_is_negative(-0.2_s)) STOP 48 |
| if (ieee_is_negative(0._s)) STOP 49 |
| if (.not. ieee_is_negative(-0._s)) STOP 50 |
| if (ieee_is_negative(tiny(0._s))) STOP 51 |
| if (ieee_is_negative(tiny(0._s)/100)) STOP 52 |
| if (.not. ieee_is_negative(-tiny(0._s))) STOP 53 |
| if (.not. ieee_is_negative(-tiny(0._s)/100)) STOP 54 |
| if (ieee_is_negative(huge(0._s))) STOP 55 |
| if (.not. ieee_is_negative(-huge(0._s))) STOP 56 |
| sx1 = huge(sx1) |
| if (ieee_is_negative(2*sx1)) STOP 57 |
| if (.not. ieee_is_negative(2*(-sx1))) STOP 58 |
| sx1 = ieee_value(sx1, ieee_quiet_nan) |
| if (ieee_is_negative(sx1)) STOP 59 |
| sx1 = -1 |
| if (ieee_is_negative(sqrt(sx1))) STOP 60 |
| end if |
| |
| if (ieee_support_datatype(0._d)) then |
| if (ieee_is_negative(0.2_d)) STOP 61 |
| if (.not. ieee_is_negative(-0.2_d)) STOP 62 |
| if (ieee_is_negative(0._d)) STOP 63 |
| if (.not. ieee_is_negative(-0._d)) STOP 64 |
| if (ieee_is_negative(tiny(0._d))) STOP 65 |
| if (ieee_is_negative(tiny(0._d)/100)) STOP 66 |
| if (.not. ieee_is_negative(-tiny(0._d))) STOP 67 |
| if (.not. ieee_is_negative(-tiny(0._d)/100)) STOP 68 |
| if (ieee_is_negative(huge(0._d))) STOP 69 |
| if (.not. ieee_is_negative(-huge(0._d))) STOP 70 |
| dx1 = huge(dx1) |
| if (ieee_is_negative(2*dx1)) STOP 71 |
| if (.not. ieee_is_negative(2*(-dx1))) STOP 72 |
| dx1 = ieee_value(dx1, ieee_quiet_nan) |
| if (ieee_is_negative(dx1)) STOP 73 |
| dx1 = -1 |
| if (ieee_is_negative(sqrt(dx1))) STOP 74 |
| end if |
| |
| ! Test IEEE_IS_NORMAL |
| |
| if (ieee_support_datatype(0._s)) then |
| if (.not. ieee_is_normal(0.2_s)) STOP 75 |
| if (.not. ieee_is_normal(-0.2_s)) STOP 76 |
| if (.not. ieee_is_normal(0._s)) STOP 77 |
| if (.not. ieee_is_normal(-0._s)) STOP 78 |
| if (.not. ieee_is_normal(tiny(0._s))) STOP 79 |
| if (ieee_is_normal(tiny(0._s)/100)) STOP 80 |
| if (.not. ieee_is_normal(-tiny(0._s))) STOP 81 |
| if (ieee_is_normal(-tiny(0._s)/100)) STOP 82 |
| if (.not. ieee_is_normal(huge(0._s))) STOP 83 |
| if (.not. ieee_is_normal(-huge(0._s))) STOP 84 |
| sx1 = huge(sx1) |
| if (ieee_is_normal(2*sx1)) STOP 85 |
| if (ieee_is_normal(2*(-sx1))) STOP 86 |
| sx1 = ieee_value(sx1, ieee_quiet_nan) |
| if (ieee_is_normal(sx1)) STOP 87 |
| sx1 = -1 |
| if (ieee_is_normal(sqrt(sx1))) STOP 88 |
| end if |
| |
| if (ieee_support_datatype(0._d)) then |
| if (.not. ieee_is_normal(0.2_d)) STOP 89 |
| if (.not. ieee_is_normal(-0.2_d)) STOP 90 |
| if (.not. ieee_is_normal(0._d)) STOP 91 |
| if (.not. ieee_is_normal(-0._d)) STOP 92 |
| if (.not. ieee_is_normal(tiny(0._d))) STOP 93 |
| if (ieee_is_normal(tiny(0._d)/100)) STOP 94 |
| if (.not. ieee_is_normal(-tiny(0._d))) STOP 95 |
| if (ieee_is_normal(-tiny(0._d)/100)) STOP 96 |
| if (.not. ieee_is_normal(huge(0._d))) STOP 97 |
| if (.not. ieee_is_normal(-huge(0._d))) STOP 98 |
| dx1 = huge(dx1) |
| if (ieee_is_normal(2*dx1)) STOP 99 |
| if (ieee_is_normal(2*(-dx1))) STOP 100 |
| dx1 = ieee_value(dx1, ieee_quiet_nan) |
| if (ieee_is_normal(dx1)) STOP 101 |
| dx1 = -1 |
| if (ieee_is_normal(sqrt(dx1))) STOP 102 |
| end if |
| |
| end |