From aa7e7eff5ec165dc8463a0e74309801b15d1feda Mon Sep 17 00:00:00 2001 From: Dominique d'Humieres Date: Fri, 24 Jul 2020 20:27:53 +0200 Subject: [PATCH] PR 93567, G edit descriptor uses E instead of F editing in rounding mode UP. 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. --- gcc/testsuite/gfortran.dg/round_3.f08 | 26 +++++++++++++++++++++++++- libgfortran/io/write_float.def | 12 ++++++++---- 2 files changed, 33 insertions(+), 5 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/round_3.f08 b/gcc/testsuite/gfortran.dg/round_3.f08 index 57d83395531..4a0a692fa7b 100644 --- a/gcc/testsuite/gfortran.dg/round_3.f08 +++ b/gcc/testsuite/gfortran.dg/round_3.f08 @@ -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 diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index 3311db31209..9a4462c1117 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -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)\ -- 2.30.2