[Bug libfortran/35862] [F2003] Implement new rounding modes for run time

["jvdelisle at gcc dot gnu dot org" <gcc-bugzilla at gcc dot gnu dot org>]

------- Comment #13 from jvdelisle at gcc dot gnu dot org  2009-10-03 15:10 -------
There are two unrelated bugs in output rounding.  The following patch fixes
both.  The smaller hunks were obvious.  The larger gets rid of a hack I did to
handle the special case with d=0.  The rounding logic always saw a value of
1.0.

Turns out with this special case, we have no leading digit from the sprintf
routines so the rounding logic is looking in the wrong places.  Fixed by
shifting digits left and adjusting the exponent. Regression tested and passes
the test case from Dominique in comment #11.

Index: write_float.def
===================================================================
--- write_float.def     (revision 152422)
+++ write_float.def     (working copy)
@@ -141,6 +141,14 @@ output_float (st_parameter_dt *dtp, const fnode *f
   switch (ft)
     {
     case FMT_F:
+      if (d == 0 && e <= 0 && dtp->u.p.scale_factor == 0)
+       {
+         for (i = ndigits - 1; i >= 0; i--)
+           digits[i] = digits[i - 1];
+         digits[0] = '0';
+         e++;
+       }
+
       nbefore = e + dtp->u.p.scale_factor;
       if (nbefore < 0)
        {
@@ -255,7 +263,7 @@ output_float (st_parameter_dt *dtp, const fnode *f
       case ROUND_NEAREST:
        /* Round compatible unless there is a tie. A tie is a 5 with
           all trailing zero's.  */
-       i = nafter + 1;
+       i = nafter + nbefore;
        if (digits[i] == '5')
          {
            for(i++ ; i < ndigits; i++)
@@ -264,7 +272,7 @@ output_float (st_parameter_dt *dtp, const fnode *f
                  goto do_rnd;
              }
            /* It is a  tie so round to even.  */
-           switch (digits[nafter])
+           switch (digits[nafter + nbefore - 1])
              {
                case '1':
                case '3':
@@ -818,14 +826,6 @@ sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*"
            return;\
          }\
        tmp = sign_bit ? -tmp : tmp;\
-       if (f->u.real.d == 0 && f->format == FMT_F\
-           && dtp->u.p.scale_factor == 0)\
-         {\
-           if (tmp < 0.5)\
-             tmp = 0.0;\
-           else if (tmp < 1.0)\
-             tmp = 1.0;\
-         }\
        zero_flag = (tmp == 0.0);\
 \
        DTOA ## y\



-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=35862