From 7ae69d02c7081926f57b30b18f71bb7d55c632a5 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Mon, 18 Apr 2011 03:48:25 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@172634 138bc75d-0d04-0410-961f-82ee72b054a4 --- 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 012ebe8..f4b19f8 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 1fa797e..9e90d80 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 = ' ';\ @@ -824,9 +827,25 @@ 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.7.4