! { dg-do run }
!
! Test IEEE_MODES_TYPE, IEEE_GET_MODES and IEEE_SET_MODES


! The symbols should be accessible from both IEEE_EXCEPTIONS
! and IEEE_ARITHMETIC.

subroutine test_1
  use ieee_exceptions, only : IEEE_GET_MODES, IEEE_SET_MODES
end subroutine

subroutine test_2
  use ieee_arithmetic, only : IEEE_GET_MODES, IEEE_SET_MODES
end subroutine

subroutine test_3
  use ieee_exceptions, only : IEEE_MODES_TYPE
end subroutine

subroutine test_4
  use ieee_arithmetic, only : IEEE_MODES_TYPE
end subroutine


! Check that the functions actually do the job

program foo
  use ieee_arithmetic
  implicit none

  type(ieee_modes_type) :: modes1, modes2
  type(ieee_round_type) :: rmode
  logical :: f

  ! Set some modes
  if (ieee_support_underflow_control()) then
    call ieee_set_underflow_mode(gradual=.false.)
  endif
  if (ieee_support_rounding(ieee_up)) then
    call ieee_set_rounding_mode(ieee_up)
  endif
  if (ieee_support_halting(ieee_overflow)) then
    call ieee_set_halting_mode(ieee_overflow, .true.)
  endif

  call ieee_get_modes(modes1)

  ! Change modes
  if (ieee_support_underflow_control()) then
    call ieee_set_underflow_mode(gradual=.true.)
  endif
  if (ieee_support_rounding(ieee_down)) then
    call ieee_set_rounding_mode(ieee_down)
  endif
  if (ieee_support_halting(ieee_overflow)) then
    call ieee_set_halting_mode(ieee_overflow, .false.)
  endif

  ! Save and restore the previous modes
  call ieee_get_modes(modes2)
  call ieee_set_modes(modes1)

  ! Check them
  if (ieee_support_underflow_control()) then
    call ieee_get_underflow_mode(f)
    if (f) stop 1
  endif
  if (ieee_support_rounding(ieee_down)) then
    call ieee_get_rounding_mode(rmode)
    if (rmode /= ieee_up) stop 2
  endif
  if (ieee_support_halting(ieee_overflow)) then
    call ieee_get_halting_mode(ieee_overflow, f)
    if (.not. f) stop 3
  endif

  ! Restore the second set of modes
  call ieee_set_modes(modes2)

  ! Check again
  if (ieee_support_underflow_control()) then
    call ieee_get_underflow_mode(f)
    if (.not. f) stop 4
  endif
  if (ieee_support_rounding(ieee_down)) then
    call ieee_get_rounding_mode(rmode)
    if (rmode /= ieee_down) stop 5
  endif
  if (ieee_support_halting(ieee_overflow)) then
    call ieee_get_halting_mode(ieee_overflow, f)
    if (f) stop 6
  endif

end program foo