(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
ieee/
ieee_2.f90
! { 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