* [Patch fortran] PR 93567 - G edit descriptor uses E instead of F editing in rounding mode UP
@ 2020-07-21 22:09 dhumieres.dominique
2020-07-24 18:50 ` Thomas Koenig
0 siblings, 1 reply; 2+ messages in thread
From: dhumieres.dominique @ 2020-07-21 22:09 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, jvdelisle
[-- Attachment #1: Type: text/plain, Size: 85 bytes --]
I am not set up to commit on git, someone will have to do it for me.
TIA
Dominique
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch-93567 --]
[-- Type: text/x-diff; name=patch-93567, Size: 3325 bytes --]
--- ../_clean/libgfortran/io/write_float.def 2020-06-13 03:11:55.000000000 +0200
+++ libgfortran/io/write_float.def 2020-07-21 23:03:08.000000000 +0200
@@ -987,16 +987,19 @@ determine_en_precision (st_parameter_dt
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;\
@@ -1004,7 +1007,8 @@ determine_en_precision (st_parameter_dt
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)\
--- ../_clean/gcc/testsuite/gfortran.dg/round_3.f08 2020-06-13 03:11:54.000000000 +0200
+++ gcc/testsuite/gfortran.dg/round_3.f08 2020-07-21 01:14:56.000000000 +0200
@@ -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
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2020-07-24 18:50 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-07-21 22:09 [Patch fortran] PR 93567 - G edit descriptor uses E instead of F editing in rounding mode UP dhumieres.dominique
2020-07-24 18:50 ` Thomas Koenig
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).