diff mbox

[libgfortran] PR48767 Rounding Up followup patch

Message ID 4DBB6707.1050703@frontier.com
State New
Headers show

Commit Message

Jerry DeLisle April 30, 2011, 1:33 a.m. UTC 
Hi,

The attached patch does some cleanup and a check for trailing zeros to decide 
whether or not to round.

I have added the additional test cases posted on the bugzilla to the existing 
test case round_3.f08.

Regression tested on x86-64.

OK for trunk and then I will back port the whole enchilada to 4.6.1 in a few 
weeks.  Please consider the starting point of the zero scan carefully.  I have 
not convinced myself that the d * p covers all cases, but it works for all cases 
I have tried.

Regards,

Jerry

2011-04-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/48787
	* io/write_float.def (output_float): Gather up integer declarations and
	add new 'p' for scale factor. Use 'p' in place of the 'dtp' reference
	everywhere. For ROUND_UP scan the digit string and only perform
	rounding if something other than '0' is found.

Comments

Janne Blomqvist April 30, 2011, 7:56 a.m. UTC | #1 
On Sat, Apr 30, 2011 at 04:33, Jerry DeLisle <jvdelisle@frontier.com> wrote:
> Hi,
>
> The attached patch does some cleanup and a check for trailing zeros to
> decide whether or not to round.
>
> I have added the additional test cases posted on the bugzilla to the
> existing test case round_3.f08.
>
> Regression tested on x86-64.
>
> OK for trunk and then I will back port the whole enchilada to 4.6.1 in a few
> weeks.  Please consider the starting point of the zero scan carefully.  I
> have not convinced myself that the d * p covers all cases, but it works for
> all cases I have tried.

I'm a bit suspicious about that as well:

+	/* Scan for trailing zeros to see if we really need to round it.  */
+	for(i = 1 +  d * p ; i < ndigits; i++)
+	  {
+	    if (digits[i] != '0')
+	      goto do_rnd;
+	  }
+	goto skip;

legal values for p are (-d, d+2) for E format. Won't this easily
overflow if p>1? E.g. 3PE50.36? Then 1 + 36*3 = 109 and ndigits is
specified by

ndigits = MIN_FIELD_WIDTH - 4 - edigits;

If real(16) is available, ndigits= 49-4-4=41.

Or am I missing something obvious?
Jerry DeLisle April 30, 2011, 1:37 p.m. UTC | #2 
On 04/30/2011 12:56 AM, Janne Blomqvist wrote:
> On Sat, Apr 30, 2011 at 04:33, Jerry DeLisle<jvdelisle@frontier.com>  wrote:
>> Hi,
>>
>> The attached patch does some cleanup and a check for trailing zeros to
>> decide whether or not to round.
>>
>> I have added the additional test cases posted on the bugzilla to the
>> existing test case round_3.f08.
>>
>> Regression tested on x86-64.
>>
>> OK for trunk and then I will back port the whole enchilada to 4.6.1 in a few
>> weeks.  Please consider the starting point of the zero scan carefully.  I
>> have not convinced myself that the d * p covers all cases, but it works for
>> all cases I have tried.
>
> I'm a bit suspicious about that as well:
>
> +	/* Scan for trailing zeros to see if we really need to round it.  */
> +	for(i = 1 +  d * p ; i<  ndigits; i++)
> +	  {
> +	    if (digits[i] != '0')
> +	      goto do_rnd;
> +	  }
> +	goto skip;
>

I must have been tired yesterday.  Revised chunk.  Regression tests OK.

@@ -233,7 +231,13 @@
  	if (sign_bit)
  	  goto skip;
  	rchar = '0';
-	break;
+	/* Scan for trailing zeros to see if we really need to round it.  */
+	for(i = nbefore + nafter; i < ndigits; i++)
+	  {
+	    if (digits[i] != '0')
+	      goto do_rnd;
+	  }
+	goto skip;
        case ROUND_DOWN:
  	if (!sign_bit)
  	  goto skip;

OK for trunk?

Jerry
Janne Blomqvist May 1, 2011, 9:30 a.m. UTC | #3 
On Sat, Apr 30, 2011 at 16:37, Jerry DeLisle <jvdelisle@frontier.com> wrote:
> On 04/30/2011 12:56 AM, Janne Blomqvist wrote:
>>
>> On Sat, Apr 30, 2011 at 04:33, Jerry DeLisle<jvdelisle@frontier.com>
>>  wrote:
>>>
>>> Hi,
>>>
>>> The attached patch does some cleanup and a check for trailing zeros to
>>> decide whether or not to round.
>>>
>>> I have added the additional test cases posted on the bugzilla to the
>>> existing test case round_3.f08.
>>>
>>> Regression tested on x86-64.
>>>
>>> OK for trunk and then I will back port the whole enchilada to 4.6.1 in a
>>> few
>>> weeks.  Please consider the starting point of the zero scan carefully.  I
>>> have not convinced myself that the d * p covers all cases, but it works
>>> for
>>> all cases I have tried.
>>
>> I'm a bit suspicious about that as well:
>>
>> +       /* Scan for trailing zeros to see if we really need to round it.
>>  */
>> +       for(i = 1 +  d * p ; i<  ndigits; i++)
>> +         {
>> +           if (digits[i] != '0')
>> +             goto do_rnd;
>> +         }
>> +       goto skip;
>>
>
> I must have been tired yesterday.  Revised chunk.  Regression tests OK.
>
> @@ -233,7 +231,13 @@
>        if (sign_bit)
>          goto skip;
>        rchar = '0';
> -       break;
> +       /* Scan for trailing zeros to see if we really need to round it.  */
> +       for(i = nbefore + nafter; i < ndigits; i++)
> +         {
> +           if (digits[i] != '0')
> +             goto do_rnd;
> +         }
> +       goto skip;
>       case ROUND_DOWN:
>        if (!sign_bit)
>          goto skip;
>
> OK for trunk?

Ok.
diff mbox

Patch

Index: gcc/testsuite/gfortran.dg/round_3.f08
===================================================================
--- gcc/testsuite/gfortran.dg/round_3.f08	(revision 173197)
+++ gcc/testsuite/gfortran.dg/round_3.f08	(working copy)
@@ -4,10 +4,17 @@ 
 program pr48615
     call checkfmt("(RU,F17.0)", 2.5,     "               3.")
     call checkfmt("(RU,-1P,F17.1)", 2.5, "              0.3")
-    call checkfmt("(RU,E17.1)", 2.5,     "          0.3E+01") ! 0.2E+01
+    call checkfmt("(RU,E17.1)", 2.5,     "          0.3E+01")
     call checkfmt("(RU,1P,E17.0)", 2.5,  "           3.E+00")
-    call checkfmt("(RU,ES17.0)", 2.5,    "           3.E+00") ! 2.E+00
+    call checkfmt("(RU,ES17.0)", 2.5,    "           3.E+00")
     call checkfmt("(RU,EN17.0)", 2.5,    "           3.E+00")
+    call checkfmt("(RU,F2.0)",      2.0,  "2.")
+    call checkfmt("(RU,F6.4)",      2.0,  "2.0000")
+    call checkfmt("(RU,1P,E6.0E2)", 2.0,  "2.E+00")
+    call checkfmt("(RU,1P,E7.1E2)", 2.5,  "2.5E+00")
+    call checkfmt("(RU,1P,E10.4E2)", 2.5,  "2.5000E+00")
+    call checkfmt("(RU,1P,G6.0E2)", 2.0,  "2.E+00")
+    call checkfmt("(RU,1P,G10.4E2)", 2.3456e5,  "2.3456E+05")
 
     call checkfmt("(RD,F17.0)", 2.5,     "               2.")
     call checkfmt("(RD,-1P,F17.1)", 2.5, "              0.2")
@@ -18,9 +25,9 @@  program pr48615
 
     call checkfmt("(RC,F17.0)", 2.5,     "               3.")
     call checkfmt("(RC,-1P,F17.1)", 2.5, "              0.3")
-    call checkfmt("(RC,E17.1)", 2.5,     "          0.3E+01") ! 0.2E+01
+    call checkfmt("(RC,E17.1)", 2.5,     "          0.3E+01")
     call checkfmt("(RC,1P,E17.0)", 2.5,  "           3.E+00")
-    call checkfmt("(RC,ES17.0)", 2.5,    "           3.E+00") ! 2.E+00
+    call checkfmt("(RC,ES17.0)", 2.5,    "           3.E+00")
     call checkfmt("(RC,EN17.0)", 2.5,    "           3.E+00")
 
     call checkfmt("(RN,F17.0)", 2.5,     "               2.")
@@ -53,20 +60,20 @@  program pr48615
 
     call checkfmt("(RC,F17.0)", -2.5,     "              -3.")
     call checkfmt("(RC,-1P,F17.1)", -2.5, "             -0.3")
-    call checkfmt("(RC,E17.1)", -2.5,     "         -0.3E+01") ! -0.2E+01
+    call checkfmt("(RC,E17.1)", -2.5,     "         -0.3E+01")
     call checkfmt("(RC,1P,E17.0)", -2.5,  "          -3.E+00")
-    call checkfmt("(RC,ES17.0)", -2.5,    "          -3.E+00") ! -2.E+00
+    call checkfmt("(RC,ES17.0)", -2.5,    "          -3.E+00")
     call checkfmt("(RC,EN17.0)", -2.5,    "          -3.E+00")
 
-    call checkfmt("(RU,E17.1)", nearest(2.0, 1.0),     "          0.3E+01") ! 0.2E+01
-    call checkfmt("(RD,E17.1)", nearest(3.0, -1.0),    "          0.2E+01") ! 0.3E+01
+    call checkfmt("(RU,E17.1)", nearest(2.0, 1.0),     "          0.3E+01")
+    call checkfmt("(RD,E17.1)", nearest(3.0, -1.0),    "          0.2E+01")
 
 contains
     subroutine checkfmt(fmt, x, cmp)
         character(len=*), intent(in) :: fmt
         real, intent(in) :: x
         character(len=*), intent(in) :: cmp
-        character(len=40) :: s
+        character(len=20) :: s
         
         write(s, fmt) x
         if (s /= cmp) call abort
Index: libgfortran/io/write_float.def
===================================================================
--- libgfortran/io/write_float.def	(revision 173197)
+++ libgfortran/io/write_float.def	(working copy)
@@ -67,11 +67,9 @@  output_float (st_parameter_dt *dtp, const fnode *f
 {
   char *out;
   char *digits;
-  int e;
+  int e, w, d, p, i;
   char expchar, rchar;
   format_token ft;
-  int w;
-  int d;
   /* Number of digits before the decimal point.  */
   int nbefore;
   /* Number of zeros after the decimal point.  */
@@ -82,12 +80,12 @@  output_float (st_parameter_dt *dtp, const fnode *f
   int nzero_real;
   int leadzero;
   int nblanks;
-  int i;
   sign_t sign;
 
   ft = f->format;
   w = f->u.real.w;
   d = f->u.real.d;
+  p = dtp->u.p.scale_factor;
 
   rchar = '5';
   nzero_real = -1;
@@ -119,14 +117,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)
+      if (d == 0 && e <= 0 && p == 0)
 	{
 	  memmove (digits + 1, digits, ndigits - 1);
 	  digits[0] = '0';
 	  e++;
 	}
 
-      nbefore = e + dtp->u.p.scale_factor;
+      nbefore = e + p;
       if (nbefore < 0)
 	{
 	  nzero = -nbefore;
@@ -147,13 +145,13 @@  output_float (st_parameter_dt *dtp, const fnode *f
     case FMT_E:
     case FMT_D:
       i = dtp->u.p.scale_factor;
-      if (d <= 0 && i == 0)
+      if (d <= 0 && p == 0)
 	{
 	  generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not "
 			  "greater than zero in format specifier 'E' or 'D'");
 	  return FAILURE;
 	}
-      if (i <= -d || i >= d + 2)
+      if (p <= -d || p >= d + 2)
 	{
 	  generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor "
 			  "out of range in format specifier 'E' or 'D'");
@@ -161,20 +159,20 @@  output_float (st_parameter_dt *dtp, const fnode *f
 	}
 
       if (!zero_flag)
-	e -= i;
-      if (i < 0)
+	e -= p;
+      if (p < 0)
 	{
 	  nbefore = 0;
-	  nzero = -i;
-	  nafter = d + i;
+	  nzero = -p;
+	  nafter = d + p;
 	}
-      else if (i > 0)
+      else if (p > 0)
 	{
-	  nbefore = i;
+	  nbefore = p;
 	  nzero = 0;
-	  nafter = (d - i) + 1;
+	  nafter = (d - p) + 1;
 	}
-      else /* i == 0 */
+      else /* p == 0 */
 	{
 	  nbefore = 0;
 	  nzero = 0;
@@ -233,7 +231,13 @@  output_float (st_parameter_dt *dtp, const fnode *f
 	if (sign_bit)
 	  goto skip;
 	rchar = '0';
-	break;
+	/* Scan for trailing zeros to see if we really need to round it.  */
+	for(i = 1 +  d * p ; i < ndigits; i++)
+	  {
+	    if (digits[i] != '0')
+	      goto do_rnd;
+	  }
+	goto skip;
       case ROUND_DOWN:
 	if (!sign_bit)
 	  goto skip;
@@ -290,8 +294,6 @@  output_float (st_parameter_dt *dtp, const fnode *f
   else if (nbefore + nafter < ndigits)
     {
       i = ndigits = nbefore + nafter;
-      if (d == 0 && digits[1] == '0')
-	goto skip;
       if (digits[i] >= rchar)
 	{
 	  /* Propagate the carry.  */