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)\
{ \