diff mbox

[libgfortran] Fix numerous formatting bugs

Message ID BANLkTi=Tce63cRu+rDTd+osDjpNN_+8gkg@mail.gmail.com
State New
Headers show

Commit Message

Janne Blomqvist April 27, 2011, 7:57 p.m. UTC 
On Wed, Apr 27, 2011 at 08:53, Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
> On Wed, Apr 27, 2011 at 07:09, Jerry DeLisle <jvdelisle@frontier.com> wrote:
>> On 04/25/2011 07:36 AM, Janne Blomqvist wrote:
>>>
>>> On Mon, Apr 25, 2011 at 14:44, Jerry DeLisle<jvdelisle@frontier.com>
>>>  wrote:
>>>>
>>>> On 04/25/2011 03:48 AM, Janne Blomqvist wrote:
>>>>>
>>>>> Now, for one of the testcase changes:
>>>>>
>>>>> --- gcc/testsuite/gfortran.dg/char4_iunit_1.f03 (revision 172909)
>>>>> +++ gcc/testsuite/gfortran.dg/char4_iunit_1.f03 (working copy)
>>>>> @@ -24,11 +24,11 @@ program char4_iunit_1
>>>>>    write(string, *) .true., .false. , .true.
>>>>>    if (string .ne. 4_" T F T                                    ") call
>>>>> abort
>>>>>    write(string, *) 1.2345e-06, 4.2846e+10_8
>>>>> -  if (string .ne. 4_"  1.23450002E-06   42846000000.000000     ") call
>>>>> abort
>>>>> +  if (string .ne. 4_"  1.234500019E-06   42846000000.000000    ") call
>>>>> abort
>>>>>
>>>>> This looks wrong. For correctly rounded REAL(4) output, we need 9
>>>>> significant digits, but here we print 10.
>>>>>
>>>>
>>>> Well, I bumped it up for defaults based on pr48488 comment #2 shown
>>>> below.
>>>
>>> Yes, that comment in the PR is correct; to guarantee that a
>>> binary->ascii->binary roundtrip preserves the original binary value
>>> (with the default "round to nearest, break on even" rounding mode),
>>> one must output at least {9, 17, 21, 36} significant digits for real
>>> kinds 4, 8, 10, and 16, respectively (yes, I double-checked IEEE
>>> 754-2008 that this is indeed correct).
>>>
>>> Since for the G edit descriptor d is equivalent to the number of
>>> significant digits, AFAICS the write.c patch below is correct and the
>>> bug must be elsewhere, no?
>>>
>>
>> No.
>>
>> Look at this example:
>>
>> program t4
>>  implicit none
>>  character(len=44) :: string
>>  write(*,*) 1.2345e-06, 4.2846e+10_8
>>  write(*,'(1x,1pG16.9e2,1x,1pG25.17e3)') 1.2345e-06, 4.2846e+10_8
>>  write(*,'(1x,1pG15.8e2,1x,1pG25.17e3)') 1.2345e-06, 4.2846e+10_8
>> end program t4
>>
>> This gives with the patch:
>>
>>  1.234500019E-06   42846000000.000000
>>  1.234500019E-06   42846000000.000000
>>  1.23450002E-06   42846000000.000000
>>
>> And without the patch:
>>
>>  1.23450002E-06   42846000000.000000
>>  1.234500019E-06   42846000000.000000
>>  1.23450002E-06   42846000000.000000
>>
>> d is the number of digits after the decimal point, not the number of
>> significant digits.
>
> I stand corrected. Or well, I still stand by my previous statement
> that with the G edit descriptor d corresponds to the number of
> significant digits. However, only when not using the scale factor.
>
> Since we use a scale factor of 1, when the magnitude of the number is
> such that the E edit descriptor is used, according to F2008 10.7.2.3.3
> paragraph 6 for 0 < k < d+2 we must print k significant digits to the
> left of the decimal point and d-k+1 to the right. That is, with k=1 we
> print one digit to the left of the decimal point and d-1+1=d to the
> right which has the effect of increasing the number of significant
> digits by one!
>
> However, when the magnitude of the value is such that F editing is
> used, the scale factor has no effect and we thus print d significant
> digits.
>
> So in order to guarantee an exact binary<->ascii roundtrip we must
> accept an extra digit in some cases. Or then do something which would
> make list formatted (and perhaps G0 as well?) write differ from 1PGw.d
> (effectively, reduce d by one when the magnitude is such that E
> editing is used)?

That is, what about something like the attached patch on top of your
patch. With the patch, the test program

program t4
 implicit none
 character(len=44) :: string
 write(*,*) 1.2345e-06, 4.2846e+10_8, 1.1
 write(*,'(1x,1pG16.9e2,1x,1pG25.17e3)') 1.2345e-06, 4.2846e+10_8
 write(*,'(1x,1pG15.8e2,1x,1pG25.17e3)') 1.2345e-06, 4.2846e+10_8
 write(*,'(1x,1pG0,1x,1pG0)') 1.2345e-06, 1.1
 write(*,'(1x,1pG0.9,1x,1pG0.9)') 1.2345e-06, 1.1
end program t4

outputs

   1.23450002E-06   42846000000.000000        1.10000002
  1.234500019E-06   42846000000.000000
  1.23450002E-06   42846000000.000000
 1.23450002E-06 1.10000002
 1.234500019E-06 1.10000002

So the change is that now it prints the same number of significant
digits in E and F mode, both for list formatted output and kPG0 when
k>=0. For list formatted we can do pretty much what we want, and for
G0 the standard only says the processor can choose appropriate values
for w, d, and e. So far we have chosen d and e only based on the kind,
but AFAICS nothing prevents taking into account the magnitude as well.

I haven't modified any of the testcases so I expect some number of
regressions due to that, but I'm asking for opinions on the approach
itself before doing that.
diff mbox

Patch

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 548f9f5..bf02ad8 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1155,35 +1155,35 @@  write_z (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
 void
 write_d (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
 {
-  write_float (dtp, f, p, len);
+  write_float (dtp, f, p, len, 0);
 }
 
 
 void
 write_e (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
 {
-  write_float (dtp, f, p, len);
+  write_float (dtp, f, p, len, 0);
 }
 
 
 void
 write_f (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
 {
-  write_float (dtp, f, p, len);
+  write_float (dtp, f, p, len, 0);
 }
 
 
 void
 write_en (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
 {
-  write_float (dtp, f, p, len);
+  write_float (dtp, f, p, len, 0);
 }
 
 
 void
 write_es (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
 {
-  write_float (dtp, f, p, len);
+  write_float (dtp, f, p, len, 0);
 }
 
 
@@ -1468,7 +1468,7 @@  write_real (st_parameter_dt *dtp, const char *source, int length)
   int org_scale = dtp->u.p.scale_factor;
   dtp->u.p.scale_factor = 1;
   set_fnode_default (dtp, &f, length);
-  write_float (dtp, &f, source , length);
+  write_float (dtp, &f, source , length, 1);
   dtp->u.p.scale_factor = org_scale;
 }
 
@@ -1476,12 +1476,20 @@  write_real (st_parameter_dt *dtp, const char *source, int length)
 void
 write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d)
 {
-  fnode f ;
+  fnode f;
+  int comp_d; 
   set_fnode_default (dtp, &f, length);
   if (d > 0)
     f.u.real.d = d;
+
+  /* Compensate for extra digits when using scale factor, d is not
+     specified, and the magnitude is such that E editing is used.  */
+  if (dtp->u.p.scale_factor > 0 && d == 0)
+    comp_d = 1;
+  else
+    comp_d = 0;
   dtp->u.p.g0_no_blanks = 1;
-  write_float (dtp, &f, source , length);
+  write_float (dtp, &f, source , length, comp_d);
   dtp->u.p.g0_no_blanks = 0;
 }
 
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 6d0057b..53be4af 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -812,7 +812,8 @@  CALCULATE_EXP(16)
 static void \
 output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
 		      GFC_REAL_ ## x m, char *buffer, size_t size, \
-		      int sign_bit, bool zero_flag, int ndigits, int edigits) \
+		      int sign_bit, bool zero_flag, int ndigits, \
+                      int edigits, int comp_d) \
 { \
   int e = f->u.real.e;\
   int d = f->u.real.d;\
@@ -850,7 +851,7 @@  output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
     { \
       newf->format = FMT_E;\
       newf->u.real.w = w;\
-      newf->u.real.d = d;\
+      newf->u.real.d = d - comp_d;\
       newf->u.real.e = e;\
       nb = 0;\
       goto finish;\
@@ -998,13 +999,14 @@  __qmath_(quadmath_snprintf) (buffer, sizeof buffer, \
 			edigits);\
 	else \
 	  output_float_FMT_G_ ## x (dtp, f, tmp, buffer, size, sign_bit, \
-				    zero_flag, ndigits, edigits);\
+				    zero_flag, ndigits, edigits, comp_d);\
 }\
 
 /* Output a real number according to its format.  */
 
 static void
-write_float (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
+write_float (st_parameter_dt *dtp, const fnode *f, const char *source, \
+            int len, int comp_d)
 {
 
 #if defined(HAVE_GFC_REAL_16) || __LDBL_DIG__ > 18