OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

PR 93567, G edit descriptor uses E instead of F editing in rounding mode UP.

Browse Source 
The switch between FMT_E and FMT_F is based on the absolute value.
Set r=0 for rounding toward zero and r = 1 otherwise.
If (exp_d - m) == 1 there is no rounding needed.

libgfortran/ChangeLog:

	PR fortran/93567
	* io/write_float.def (determine_en_precision): Fix switch between
	FMT_E and FMT_F.

gcc/testsuite/ChangeLog:

	PR fortran/93567
	* gfortran.dg/round_3.f08: Add test cases.
This commit is contained in:
Dominique d'Humieres 2020-07-24 20:27:53 +02:00 committed by Thomas Koenig
parent 05e0971bcf
commit aa7e7eff5e
2 changed files with 33 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/testsuite/gfortran.dg/round_3.f08
View File

@ -110,6 +110,30 @@ program pr48615
call checkfmt("(RU,E17.1)", nearest(2.0, 1.0), " 0.3E+01")
call checkfmt("(RD,E17.1)", nearest(3.0, -1.0), " 0.2E+01")
call checkfmt("(G12.2)", 99.0, " 99. ")
call checkfmt("(G12.2)", 99.5, " 0.10E+03")
call checkfmt("(G12.2)", 100.0, " 0.10E+03")
call checkfmt("(G12.2)", -99.0, " -99. ")
call checkfmt("(G12.2)", -99.5, " -0.10E+03")
call checkfmt("(G12.2)", -100.0, " -0.10E+03")
call checkfmt("(RU,G12.2)", 99.0, " 99. ") ! pr93567
call checkfmt("(RU,G12.2)", 99.01, " 0.10E+03")
call checkfmt("(RU,G12.2)", -99.0, " -99. ")
call checkfmt("(RU,G12.2)", -99.01, " -99. ")
call checkfmt("(RU,G12.2)", -100.01, " -0.10E+03")
call checkfmt("(RU,G12.4)", 99.0 , " 99.00 ")
call checkfmt("(RU,G12.4)", 99.01, " 99.02 ")
call checkfmt("(RD,G12.2)", 99.0, " 99. ")
call checkfmt("(RD,G12.2)", 99.01, " 99. ")
call checkfmt("(RD,G12.2)", 100.01, " 0.10E+03")
call checkfmt("(RD,G12.2)", -99.0, " -99. ")
call checkfmt("(RD,G12.2)", -99.01, " -0.10E+03")
call checkfmt("(RD,G12.2)", -100.00, " -0.10E+03")
call checkfmt("(Rz,G12.2)", 99.01, " 99. ")
call checkfmt("(Rz,G12.2)", 100.01, " 0.10E+03")
call checkfmt("(Rz,G12.2)", -99.01, " -99. ")
call checkfmt("(Rz,G12.2)", -100.01, " -0.10E+03")
contains
subroutine checkfmt(fmt, x, cmp)
character(len=*), intent(in) :: fmt
@ -119,6 +143,6 @@ contains
write(s, fmt) x
if (s /= cmp) STOP 1
!if (s /= cmp) print "(a,1x,a,' expected: ',1x)", fmt, s, cmp
!if (s /= cmp) print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
end subroutine
end program

12
libgfortran/io/write_float.def
View File

@ -988,16 +988,19 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
w = default_width;\
d = precision;\
}\
/* The switch between FMT_E and FMT_F is based on the absolute value. \
Set r=0 for rounding toward zero and r = 1 otherwise. \
If (exp_d - m) == 1 there is no rounding needed. */\
switch (dtp->u.p.current_unit->round_status)\
{\
case ROUND_ZERO:\
r = sign_bit ? 1.0 : 0.0;\
r = 0.0;\
break;\
case ROUND_UP:\
r = 1.0;\
r = sign_bit ? 0.0 : 1.0;\
break;\
case ROUND_DOWN:\
r = 0.0;\
r = sign_bit ? 1.0 : 0.0;\
break;\
default:\
break;\
@ -1005,7 +1008,8 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
exp_d = calculate_exp_ ## x (d);\
r_sc = (1 - r / exp_d);\
temp = 0.1 * r_sc;\
if ((m > 0.0 && ((m < temp) || (r >= (exp_d - m))))\
if ((m > 0.0 && ((m < temp) || (r < 1 && r >= (exp_d - m))\
|| (r == 1 && 1 > (exp_d - m))))\
|| ((m == 0.0) && !(compile_options.allow_std\
& (GFC_STD_F2003 | GFC_STD_F2008)))\
|| d == 0)\