blob: 8383f47999248d4ef29d1a024d839b15e595c387 [file] [log] [blame]
! { dg-do run }
use, intrinsic :: ieee_features
use, intrinsic :: ieee_exceptions
use, intrinsic :: ieee_arithmetic
implicit none
interface check_equal
procedure check_equal_float, check_equal_double
end interface
interface check_not_equal
procedure check_not_equal_float, check_not_equal_double
end interface
real :: sx1, sx2, sx3
double precision :: dx1, dx2, dx3
type(ieee_round_type) :: mode
! Test IEEE_COPY_SIGN
sx1 = 1.3
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 1
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 2
if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 3
if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 4
sx1 = huge(sx1)
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 5
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 6
if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 7
if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 8
sx1 = ieee_value(sx1, ieee_positive_inf)
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 9
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 10
if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 11
if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 12
sx1 = tiny(sx1)
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 13
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 14
if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 15
if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 16
sx1 = tiny(sx1)
sx1 = sx1 / 101
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 17
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 18
if (ieee_copy_sign(sx1, 1.) /= sx1) STOP 19
if (ieee_copy_sign(sx1, -1.) /= -sx1) STOP 20
sx1 = -1.3
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 21
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 22
if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 23
if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 24
sx1 = -huge(sx1)
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 25
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 26
if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 27
if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 28
sx1 = ieee_value(sx1, ieee_negative_inf)
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 29
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 30
if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 31
if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 32
sx1 = -tiny(sx1)
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 33
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 34
if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 35
if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 36
sx1 = -tiny(sx1)
sx1 = sx1 / 101
if (ieee_copy_sign(sx1, sx1) /= sx1) STOP 37
if (ieee_copy_sign(sx1, -sx1) /= -sx1) STOP 38
if (ieee_copy_sign(sx1, 1.) /= abs(sx1)) STOP 39
if (ieee_copy_sign(sx1, -1.) /= -abs(sx1)) STOP 40
if (ieee_class(ieee_copy_sign(0., -1.)) /= ieee_negative_zero) STOP 41
if (ieee_class(ieee_copy_sign(-0., -1.)) /= ieee_negative_zero) STOP 42
if (ieee_class(ieee_copy_sign(0., 1.)) /= ieee_positive_zero) STOP 43
if (ieee_class(ieee_copy_sign(-0., 1.)) /= ieee_positive_zero) STOP 44
sx1 = ieee_value(0., ieee_quiet_nan)
if (ieee_class(ieee_copy_sign(sx1, 1.)) /= ieee_quiet_nan) STOP 45
if (ieee_class(ieee_copy_sign(sx1, -1.)) /= ieee_quiet_nan) STOP 46
dx1 = 1.3
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 47
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 48
if (ieee_copy_sign(dx1, 1.) /= dx1) STOP 49
if (ieee_copy_sign(dx1, -1.d0) /= -dx1) STOP 50
dx1 = huge(dx1)
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 51
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 52
if (ieee_copy_sign(dx1, 1.d0) /= dx1) STOP 53
if (ieee_copy_sign(dx1, -1.) /= -dx1) STOP 54
dx1 = ieee_value(dx1, ieee_positive_inf)
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 55
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 56
if (ieee_copy_sign(dx1, 1.) /= dx1) STOP 57
if (ieee_copy_sign(dx1, -1.d0) /= -dx1) STOP 58
dx1 = tiny(dx1)
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 59
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 60
if (ieee_copy_sign(dx1, 1.d0) /= dx1) STOP 61
if (ieee_copy_sign(dx1, -1.) /= -dx1) STOP 62
dx1 = tiny(dx1)
dx1 = dx1 / 101
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 63
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 64
if (ieee_copy_sign(dx1, 1.) /= dx1) STOP 65
if (ieee_copy_sign(dx1, -1.d0) /= -dx1) STOP 66
dx1 = -1.3d0
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 67
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 68
if (ieee_copy_sign(dx1, 1.d0) /= abs(dx1)) STOP 69
if (ieee_copy_sign(dx1, -1.) /= -abs(dx1)) STOP 70
dx1 = -huge(dx1)
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 71
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 72
if (ieee_copy_sign(dx1, 1.) /= abs(dx1)) STOP 73
if (ieee_copy_sign(dx1, -1.d0) /= -abs(dx1)) STOP 74
dx1 = ieee_value(dx1, ieee_negative_inf)
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 75
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 76
if (ieee_copy_sign(dx1, 1.d0) /= abs(dx1)) STOP 77
if (ieee_copy_sign(dx1, -1.) /= -abs(dx1)) STOP 78
dx1 = -tiny(dx1)
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 79
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 80
if (ieee_copy_sign(dx1, 1.) /= abs(dx1)) STOP 81
if (ieee_copy_sign(dx1, -1.d0) /= -abs(dx1)) STOP 82
dx1 = -tiny(dx1)
dx1 = dx1 / 101
if (ieee_copy_sign(dx1, dx1) /= dx1) STOP 83
if (ieee_copy_sign(dx1, -dx1) /= -dx1) STOP 84
if (ieee_copy_sign(dx1, 1.d0) /= abs(dx1)) STOP 85
if (ieee_copy_sign(dx1, -1.) /= -abs(dx1)) STOP 86
if (ieee_class(ieee_copy_sign(0.d0, -1.)) /= ieee_negative_zero) STOP 87
if (ieee_class(ieee_copy_sign(-0.d0, -1.)) /= ieee_negative_zero) STOP 88
if (ieee_class(ieee_copy_sign(0.d0, 1.)) /= ieee_positive_zero) STOP 89
if (ieee_class(ieee_copy_sign(-0.d0, 1.)) /= ieee_positive_zero) STOP 90
dx1 = ieee_value(0.d0, ieee_quiet_nan)
if (ieee_class(ieee_copy_sign(dx1, 1.d0)) /= ieee_quiet_nan) STOP 91
if (ieee_class(ieee_copy_sign(dx1, -1.)) /= ieee_quiet_nan) STOP 92
! Test IEEE_LOGB
if (ieee_logb(1.17) /= exponent(1.17) - 1) STOP 93
if (ieee_logb(-1.17) /= exponent(-1.17) - 1) STOP 94
if (ieee_logb(huge(sx1)) /= exponent(huge(sx1)) - 1) STOP 95
if (ieee_logb(-huge(sx1)) /= exponent(-huge(sx1)) - 1) STOP 96
if (ieee_logb(tiny(sx1)) /= exponent(tiny(sx1)) - 1) STOP 97
if (ieee_logb(-tiny(sx1)) /= exponent(-tiny(sx1)) - 1) STOP 98
if (ieee_class(ieee_logb(0.)) /= ieee_negative_inf) STOP 99
if (ieee_class(ieee_logb(-0.)) /= ieee_negative_inf) STOP 100
sx1 = ieee_value(sx1, ieee_positive_inf)
if (ieee_class(ieee_logb(sx1)) /= ieee_positive_inf) STOP 101
if (ieee_class(ieee_logb(-sx1)) /= ieee_positive_inf) STOP 102
sx1 = ieee_value(sx1, ieee_quiet_nan)
if (ieee_class(ieee_logb(sx1)) /= ieee_quiet_nan) STOP 103
if (ieee_logb(1.17d0) /= exponent(1.17d0) - 1) STOP 104
if (ieee_logb(-1.17d0) /= exponent(-1.17d0) - 1) STOP 105
if (ieee_logb(huge(dx1)) /= exponent(huge(dx1)) - 1) STOP 106
if (ieee_logb(-huge(dx1)) /= exponent(-huge(dx1)) - 1) STOP 107
if (ieee_logb(tiny(dx1)) /= exponent(tiny(dx1)) - 1) STOP 108
if (ieee_logb(-tiny(dx1)) /= exponent(-tiny(dx1)) - 1) STOP 109
if (ieee_class(ieee_logb(0.d0)) /= ieee_negative_inf) STOP 110
if (ieee_class(ieee_logb(-0.d0)) /= ieee_negative_inf) STOP 111
dx1 = ieee_value(dx1, ieee_positive_inf)
if (ieee_class(ieee_logb(dx1)) /= ieee_positive_inf) STOP 112
if (ieee_class(ieee_logb(-dx1)) /= ieee_positive_inf) STOP 113
dx1 = ieee_value(dx1, ieee_quiet_nan)
if (ieee_class(ieee_logb(dx1)) /= ieee_quiet_nan) STOP 114
! Test IEEE_NEXT_AFTER
if (ieee_next_after(0.12, 1.0) /= nearest(0.12, 1.0)) STOP 115
if (ieee_next_after(0.12, -1.0) /= nearest(0.12, -1.0)) STOP 116
sx1 = 0.12
if (ieee_next_after(sx1, sx1) /= sx1) STOP 117
sx1 = -0.12
if (ieee_next_after(sx1, sx1) /= sx1) STOP 118
sx1 = huge(sx1)
if (ieee_next_after(sx1, sx1) /= sx1) STOP 119
sx1 = tiny(sx1)
if (ieee_next_after(sx1, sx1) /= sx1) STOP 120
sx1 = 0
if (ieee_next_after(sx1, sx1) /= sx1) STOP 121
sx1 = ieee_value(sx1, ieee_negative_inf)
if (ieee_next_after(sx1, sx1) /= sx1) STOP 122
sx1 = ieee_value(sx1, ieee_quiet_nan)
if (ieee_class(ieee_next_after(sx1, sx1)) /= ieee_quiet_nan) STOP 123
if (ieee_next_after(0., 1.0) <= 0) STOP 124
if (ieee_next_after(0., -1.0) >= 0) STOP 125
sx1 = ieee_next_after(huge(sx1), ieee_value(sx1, ieee_negative_inf))
if (.not. sx1 < huge(sx1)) STOP 126
sx1 = ieee_next_after(huge(sx1), ieee_value(sx1, ieee_positive_inf))
if (ieee_class(sx1) /= ieee_positive_inf) STOP 127
sx1 = ieee_next_after(-tiny(sx1), 1.0)
if (ieee_class(sx1) /= ieee_negative_denormal) STOP 128
if (ieee_next_after(0.12d0, 1.0d0) /= nearest(0.12d0, 1.0)) STOP 129
if (ieee_next_after(0.12d0, -1.0) /= nearest(0.12d0, -1.0)) STOP 130
dx1 = 0.12
if (ieee_next_after(dx1, dx1) /= dx1) STOP 131
dx1 = -0.12
if (ieee_next_after(dx1, dx1) /= dx1) STOP 132
dx1 = huge(dx1)
if (ieee_next_after(dx1, dx1) /= dx1) STOP 133
dx1 = tiny(dx1)
if (ieee_next_after(dx1, dx1) /= dx1) STOP 134
dx1 = 0
if (ieee_next_after(dx1, dx1) /= dx1) STOP 135
dx1 = ieee_value(dx1, ieee_negative_inf)
if (ieee_next_after(dx1, dx1) /= dx1) STOP 136
dx1 = ieee_value(dx1, ieee_quiet_nan)
if (ieee_class(ieee_next_after(dx1, dx1)) /= ieee_quiet_nan) STOP 137
if (ieee_next_after(0.d0, 1.0) <= 0) STOP 138
if (ieee_next_after(0.d0, -1.0d0) >= 0) STOP 139
dx1 = ieee_next_after(huge(dx1), ieee_value(dx1, ieee_negative_inf))
if (.not. dx1 < huge(dx1)) STOP 140
dx1 = ieee_next_after(huge(dx1), ieee_value(dx1, ieee_positive_inf))
if (ieee_class(dx1) /= ieee_positive_inf) STOP 141
dx1 = ieee_next_after(-tiny(dx1), 1.0d0)
if (ieee_class(dx1) /= ieee_negative_denormal) STOP 142
! Test IEEE_REM
if (ieee_rem(4.0, 3.0) /= 1.0) STOP 143
if (ieee_rem(-4.0, 3.0) /= -1.0) STOP 144
if (ieee_rem(2.0, 3.0d0) /= -1.0d0) STOP 145
if (ieee_rem(-2.0, 3.0d0) /= 1.0d0) STOP 146
if (ieee_rem(2.0d0, 3.0d0) /= -1.0d0) STOP 147
if (ieee_rem(-2.0d0, 3.0d0) /= 1.0d0) STOP 148
if (ieee_class(ieee_rem(ieee_value(0., ieee_quiet_nan), 1.0)) &
/= ieee_quiet_nan) STOP 149
if (ieee_class(ieee_rem(1.0, ieee_value(0.d0, ieee_quiet_nan))) &
/= ieee_quiet_nan) STOP 150
if (ieee_class(ieee_rem(ieee_value(0., ieee_positive_inf), 1.0)) &
/= ieee_quiet_nan) STOP 151
if (ieee_class(ieee_rem(ieee_value(0.d0, ieee_negative_inf), 1.0)) &
/= ieee_quiet_nan) STOP 152
if (ieee_rem(-1.0, ieee_value(0., ieee_positive_inf)) &
/= -1.0) STOP 153
if (ieee_rem(1.0, ieee_value(0.d0, ieee_negative_inf)) &
/= 1.0) STOP 154
! Test IEEE_RINT
if (ieee_support_rounding (ieee_nearest, sx1)) then
call ieee_get_rounding_mode (mode)
call ieee_set_rounding_mode (ieee_nearest)
sx1 = 7 / 3.
sx1 = ieee_rint (sx1)
call ieee_set_rounding_mode (mode)
if (sx1 /= 2) STOP 155
end if
if (ieee_support_rounding (ieee_up, sx1)) then
call ieee_get_rounding_mode (mode)
call ieee_set_rounding_mode (ieee_up)
sx1 = 7 / 3.
sx1 = ieee_rint (sx1)
call ieee_set_rounding_mode (mode)
if (sx1 /= 3) STOP 156
end if
if (ieee_support_rounding (ieee_down, sx1)) then
call ieee_get_rounding_mode (mode)
call ieee_set_rounding_mode (ieee_down)
sx1 = 7 / 3.
sx1 = ieee_rint (sx1)
call ieee_set_rounding_mode (mode)
if (sx1 /= 2) STOP 157
end if
if (ieee_support_rounding (ieee_to_zero, sx1)) then
call ieee_get_rounding_mode (mode)
call ieee_set_rounding_mode (ieee_to_zero)
sx1 = 7 / 3.
sx1 = ieee_rint (sx1)
call ieee_set_rounding_mode (mode)
if (sx1 /= 2) STOP 158
end if
if (ieee_class(ieee_rint(0.)) /= ieee_positive_zero) STOP 159
if (ieee_class(ieee_rint(-0.)) /= ieee_negative_zero) STOP 160
if (ieee_support_rounding (ieee_nearest, dx1)) then
call ieee_get_rounding_mode (mode)
call ieee_set_rounding_mode (ieee_nearest)
dx1 = 7 / 3.d0
dx1 = ieee_rint (dx1)
call ieee_set_rounding_mode (mode)
if (dx1 /= 2) STOP 161
end if
if (ieee_support_rounding (ieee_up, dx1)) then
call ieee_get_rounding_mode (mode)
call ieee_set_rounding_mode (ieee_up)
dx1 = 7 / 3.d0
dx1 = ieee_rint (dx1)
call ieee_set_rounding_mode (mode)
if (dx1 /= 3) STOP 162
end if
if (ieee_support_rounding (ieee_down, dx1)) then
call ieee_get_rounding_mode (mode)
call ieee_set_rounding_mode (ieee_down)
dx1 = 7 / 3.d0
dx1 = ieee_rint (dx1)
call ieee_set_rounding_mode (mode)
if (dx1 /= 2) STOP 163
end if
if (ieee_support_rounding (ieee_to_zero, dx1)) then
call ieee_get_rounding_mode (mode)
call ieee_set_rounding_mode (ieee_to_zero)
dx1 = 7 / 3.d0
dx1 = ieee_rint (dx1)
call ieee_set_rounding_mode (mode)
if (dx1 /= 2) STOP 164
end if
if (ieee_class(ieee_rint(0.d0)) /= ieee_positive_zero) STOP 165
if (ieee_class(ieee_rint(-0.d0)) /= ieee_negative_zero) STOP 166
! Test IEEE_SCALB
sx1 = 1
if (ieee_scalb(sx1, 2) /= 4.) STOP 167
if (ieee_scalb(-sx1, 2) /= -4.) STOP 168
if (ieee_scalb(sx1, -2) /= 1/4.) STOP 169
if (ieee_scalb(-sx1, -2) /= -1/4.) STOP 170
if (ieee_class(ieee_scalb(sx1, huge(0))) /= ieee_positive_inf) STOP 171
if (ieee_class(ieee_scalb(-sx1, huge(0))) /= ieee_negative_inf) STOP 172
if (ieee_class(ieee_scalb(sx1, -huge(0))) /= ieee_positive_zero) STOP 173
if (ieee_class(ieee_scalb(-sx1, -huge(0))) /= ieee_negative_zero) STOP 174
sx1 = ieee_value(sx1, ieee_quiet_nan)
if (ieee_class(ieee_scalb(sx1, 1)) /= ieee_quiet_nan) STOP 175
sx1 = ieee_value(sx1, ieee_positive_inf)
if (ieee_class(ieee_scalb(sx1, -42)) /= ieee_positive_inf) STOP 176
sx1 = ieee_value(sx1, ieee_negative_inf)
if (ieee_class(ieee_scalb(sx1, -42)) /= ieee_negative_inf) STOP 177
dx1 = 1
if (ieee_scalb(dx1, 2) /= 4.d0) STOP 178
if (ieee_scalb(-dx1, 2) /= -4.d0) STOP 179
if (ieee_scalb(dx1, -2) /= 1/4.d0) STOP 180
if (ieee_scalb(-dx1, -2) /= -1/4.d0) STOP 181
if (ieee_class(ieee_scalb(dx1, huge(0))) /= ieee_positive_inf) STOP 182
if (ieee_class(ieee_scalb(-dx1, huge(0))) /= ieee_negative_inf) STOP 183
if (ieee_class(ieee_scalb(dx1, -huge(0))) /= ieee_positive_zero) STOP 184
if (ieee_class(ieee_scalb(-dx1, -huge(0))) /= ieee_negative_zero) STOP 185
dx1 = ieee_value(dx1, ieee_quiet_nan)
if (ieee_class(ieee_scalb(dx1, 1)) /= ieee_quiet_nan) STOP 186
dx1 = ieee_value(dx1, ieee_positive_inf)
if (ieee_class(ieee_scalb(dx1, -42)) /= ieee_positive_inf) STOP 187
dx1 = ieee_value(dx1, ieee_negative_inf)
if (ieee_class(ieee_scalb(dx1, -42)) /= ieee_negative_inf) STOP 188
contains
subroutine check_equal_float (x, y)
real, intent(in) :: x, y
if (x /= y) then
print *, x, y
STOP 189
end if
end subroutine
subroutine check_equal_double (x, y)
double precision, intent(in) :: x, y
if (x /= y) then
print *, x, y
STOP 190
end if
end subroutine
subroutine check_not_equal_float (x, y)
real, intent(in) :: x, y
if (x == y) then
print *, x, y
STOP 191
end if
end subroutine
subroutine check_not_equal_double (x, y)
double precision, intent(in) :: x, y
if (x == y) then
print *, x, y
STOP 192
end if
end subroutine
end