FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: handle RADIX kind in IEEE_SET_ROUNDING_MODE

Browse source 
Make sure that calling IEEE_SET_ROUNDING_MODE with RADIX=10 does not
affect the binary rounding mode.

2022-09-21  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

libgfortran/

	* ieee/ieee_arithmetic.F90 (IEEE_SET_ROUNDING_MODE): Handle
	RADIX argument better.

gcc/testsuite/

	* gfortran.dg/ieee/rounding_3.f90: New test.
This commit is contained in:
Francois-Xavier Coudert 2022-09-21 11:06:19 +02:00 • committed by Francois-Xavier Coudert
parent dd9e5f4db2
commit 519196a27c
2 changed files with 36 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gcc/testsuite/gfortran.dg/ieee/rounding_3.f90 Normal file
View file

@ -0,0 +1,27 @@
! { 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

12
libgfortran/ieee/ieee_arithmetic.F90
View file

@ -816,7 +816,7 @@ REM_MACRO(4,4,4)
IEEE_SUPPORT_ROUNDING_NOARG
end interface
public :: IEEE_SUPPORT_ROUNDING
! Interface to the FPU-specific function
interface
pure integer function support_rounding_helper(flag) &
@ -839,7 +839,7 @@ REM_MACRO(4,4,4)
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) &
@ -1074,7 +1074,13 @@ contains
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