--- /dev/null
+! { dg-do run }
+
+ ! Test IEEE_GET_ROUNDING_MODE and IEEE_SET_ROUNDING_MODE
+ ! with a RADIX argument
+ use, intrinsic :: ieee_arithmetic
+ implicit none
+
+ real :: sx1
+ type(ieee_round_type) :: r
+
+ if (ieee_support_rounding(ieee_up, sx1) .and. &
+ ieee_support_rounding(ieee_down, sx1)) then
+
+ call ieee_set_rounding_mode(ieee_up)
+ call ieee_get_rounding_mode(r)
+ if (r /= ieee_up) stop 1
+
+ call ieee_set_rounding_mode(ieee_down, radix=2)
+ call ieee_get_rounding_mode(r, radix=2)
+ if (r /= ieee_down) stop 2
+
+ call ieee_set_rounding_mode(ieee_up, radix=10)
+ call ieee_get_rounding_mode(r, radix=2)
+ if (r /= ieee_down) stop 3
+ end if
+
+end
IEEE_SUPPORT_ROUNDING_NOARG
end interface
public :: IEEE_SUPPORT_ROUNDING
-
+
! Interface to the FPU-specific function
interface
pure integer function support_rounding_helper(flag) &
IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG
end interface
public :: IEEE_SUPPORT_UNDERFLOW_CONTROL
-
+
! Interface to the FPU-specific function
interface
pure integer function support_underflow_control_helper(kind) &
integer, value :: val
end subroutine
end interface
-
+
+ ! We do not support RADIX = 10, and such calls should not
+ ! modify the binary rounding mode.
+ if (present(RADIX)) then
+ if (RADIX == 10) return
+ end if
+
call helper(ROUND_VALUE%hidden)
end subroutine