http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48602
--- Comment #7 from Jerry DeLisle <jvdelisle at gcc dot gnu.org> 2011-04-16 04:30:04 UTC --- Here is a patch for testing. Index: io/write_float.def =================================================================== --- io/write_float.def (revision 172502) +++ io/write_float.def (working copy) @@ -822,7 +822,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, co 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 = ' ';\ @@ -832,8 +832,26 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, co 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;\ + case ROUND_NEAREST:\ + case ROUND_PROCDEFINED:\ + case ROUND_UNSPECIFIED:\ + case ROUND_COMPATIBLE:\ + 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) ||\ + if ((m > 0.0 && m < 0.1 - r * rexp_d) || (rexp_d * (m + r) >= 1.0) ||\ ((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003)))\ { \ newf->format = FMT_E;\ @@ -855,7 +873,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, co 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)\ { \