From bc7409a8a963cd4bd15805055369f292ac9d2012 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Mon, 18 Apr 2011 03:48:25 +0000 Subject: [PATCH] re PR libfortran/48602 (Invalid F conversion of G descriptor for values close to powers of 10) 2011-04-17 Jerry DeLisle PR libgfortran/48602 * io/write_float.def (output_float_FMT_G): Use current rounding mode to set the rounding parameters. (output_float): Skip rounding if value is zero. From-SVN: r172634 --- libgfortran/ChangeLog | 7 +++++++ libgfortran/io/write_float.def | 29 ++++++++++++++++++++++++----- 2 files changed, 31 insertions(+), 5 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 012ebe8a69f..f4b19f8b863 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2011-04-17 Jerry DeLisle + + PR libgfortran/48602 + * io/write_float.def (output_float_FMT_G): Use current rounding mode + to set the rounding parameters. (output_float): Skip rounding + if value is zero. + 2011-04-16 Janne Blomqvist * intrinsics/date_and_time.c (date_and_time): Remove sprintf CPP diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index 1fa797ed0d4..9e90d809450 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -221,6 +221,8 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, internal_error (&dtp->common, "Unexpected format token"); } + if (zero_flag) + goto skip; /* Round the value. The value being rounded is an unsigned magnitude. The ROUND_COMPATIBLE is rounding away from zero when there is a tie. */ switch (dtp->u.p.current_unit->round_status) @@ -802,7 +804,8 @@ CALCULATE_EXP(16) m >= 10**d-0.5 Ew.d[Ee] notes: for Gw.d , n' ' means 4 blanks - for Gw.dEe, n' ' means e+2 blanks */ + for Gw.dEe, n' ' means e+2 blanks + for rounding modes adjustment, r, See Fortran F2008 10.7.5.2.2 */ #define OUTPUT_FLOAT_FMT_G(x) \ static void \ @@ -814,7 +817,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \ int d = f->u.real.d;\ int w = f->u.real.w;\ fnode *newf;\ - GFC_REAL_ ## x rexp_d;\ + GFC_REAL_ ## x rexp_d, r = 0.5;\ int low, high, mid;\ int ubound, lbound;\ char *p, pad = ' ';\ @@ -823,10 +826,26 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \ \ save_scale_factor = dtp->u.p.scale_factor;\ newf = (fnode *) get_mem (sizeof (fnode));\ +\ + switch (dtp->u.p.current_unit->round_status)\ + {\ + case ROUND_ZERO:\ + r = sign_bit ? 0.0 : 1.0;\ + break;\ + case ROUND_UP:\ + r = 1.0;\ + break;\ + case ROUND_DOWN:\ + r = 0.0;\ + break;\ + default:\ + break;\ + }\ \ rexp_d = calculate_exp_ ## x (-d);\ - if ((m > 0.0 && m < 0.1 - 0.05 * rexp_d) || (rexp_d * (m + 0.5) >= 1.0) ||\ - ((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003)))\ + if ((m > 0.0 && ((m < 0.1 - 0.1 * r * rexp_d) || (rexp_d * (m + r) >= 1.0)))\ + || ((m == 0.0) && !(compile_options.allow_std\ + & (GFC_STD_F2003 | GFC_STD_F2008))))\ { \ newf->format = FMT_E;\ newf->u.real.w = w;\ @@ -847,7 +866,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \ GFC_REAL_ ## x temp;\ mid = (low + high) / 2;\ \ - temp = (calculate_exp_ ## x (mid - 1) * (1 - 0.5 * rexp_d));\ + temp = (calculate_exp_ ## x (mid - 1) * (1 - r * rexp_d));\ \ if (m < temp)\ { \ -- 2.30.2