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

Reply via email to