[patch, libgfortran] PR47567 Wrong output for small absolute values with F editing

[patch, libgfortran] PR47567 Wrong output for small absolute values with F editing

[Jerry DeLisle]

[-- Attachment #1: Type: text/plain, Size: 518 bytes --]

Hi folks,

The attached patch fixes the concerns with where and where not to emit "*" with 
small values and no width or small width specified.

Regression tested on x86-64.

I will dejagnu the test case attached.

OK for Trunk?

Regards,

Jerry

2011-02-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/47567
	* io/write_float.def (output_float): Eliminate some redundant code.
	Adjust width for case of F0.X for values of zero and all other values.
	Expand cases where '*' is set to give cleaner results.

[-- Attachment #2: pr47567-2.diff --]
[-- Type: text/x-patch, Size: 1535 bytes --]

Index: write_float.def
===================================================================
--- write_float.def	(revision 169821)
+++ write_float.def	(working copy)
@@ -111,14 +111,12 @@ output_float (st_parameter_dt *dtp, const fnode *f
   if (zero_flag)
     {
       e = 0;
-      if (compile_options.sign_zero == 1)
-	sign = calculate_sign (dtp, sign_bit);
-      else
+      if (compile_options.sign_zero != 1)
 	sign = calculate_sign (dtp, 0);
 
       /* Handle special cases.  */
       if (w == 0)
-	w = d + 2;
+	w = d + 1;
 
       /* For this one we choose to not output a decimal point.
 	 F95 10.5.1.2.1  */
@@ -138,7 +136,6 @@ output_float (st_parameter_dt *dtp, const fnode *f
 	  *out = '0';
 	  return SUCCESS;
 	}
-	      
     }
 
   /* Normalize the fractional component.  */
@@ -417,7 +414,10 @@ output_float (st_parameter_dt *dtp, const fnode *f
 
   /* Pick a field size if none was specified.  */
   if (w <= 0)
-    w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
+    {
+      w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
+      w = w == 1 ? 2 : w;
+    }
   
   /* Work out how much padding is needed.  */
   nblanks = w - (nbefore + nzero + nafter + edigits + 1);
@@ -436,7 +436,7 @@ output_float (st_parameter_dt *dtp, const fnode *f
     return FAILURE;
 
   /* Check the value fits in the specified field width.  */
-  if (nblanks < 0 || edigits == -1)
+  if (nblanks < 0 || edigits == -1 || w == 1 || (w == 2 && sign != S_NONE))
     {
       if (unlikely (is_char4_unit (dtp)))
 	{

[-- Attachment #3: pr47567.f90 --]
[-- Type: text/x-fortran, Size: 575 bytes --]

print "(F0.0)", 0.001 ! => 0.
print "(F0.0)", 0.01  ! => 0.
print "(F0.0)", 0.1   ! => 0.
print "(F1.0)", -0.0  ! => 0
print "(F1.0)", 0.001 ! => *
print "(F1.0)", 0.01  ! => *
print "(F1.0)", 0.1   ! => *
print "(F2.0)", -0.001! => **
print "(F2.0)", -0.01 ! => **
print "(F2.0)", -0.1  ! => **
print "(F0.0)", 0.0   ! => 0
print "(F0.1)", 0.0   ! => .0
print "(F0.2)", 0.0   ! => .00
print "(F0.3)", 0.0   ! => .000
print "(F0.4)", 0.0   ! => .0000
print "(F2.0)", 0.0   ! => 0.
print "(F2.0)", 0.001 ! => 0.
print "(F2.0)", 0.01  ! => 0.
print "(F2.0)", 0.1   ! => 0.
end

Re: [patch, libgfortran] PR47567 Wrong output for small absolute values with F editing

[Janne Blomqvist]

On Sat, Feb 5, 2011 at 18:13, Jerry DeLisle <jvdelisle@frontier.com> wrote:
> Hi folks,
>
> The attached patch fixes the concerns with where and where not to emit "*"
> with small values and no width or small width specified.
>
> Regression tested on x86-64.
>
> I will dejagnu the test case attached.
>
> OK for Trunk?
>
> Regards,
>
> Jerry
>
> 2011-02-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
>
>        PR libgfortran/47567
>        * io/write_float.def (output_float): Eliminate some redundant code.
>        Adjust width for case of F0.X for values of zero and all other
> values.
>        Expand cases where '*' is set to give cleaner results.
>

Ok, thanks. I suppose it could be argued that F1.0 should always print
*, if one wanted to be really picky.


-- 
Janne Blomqvist

Re: [patch, libgfortran] Pr47567 Wrong output for small absolute values with F editing

[H.J. Lu]

On Sun, Feb 27, 2011 at 5:18 PM, Jerry DeLisle <jvdelisle@frontier.com> wrote:
> Hi all,
>
> I am painfully aware that we have gone through a few iterations here.  Once
> again, I hope this is the last of it.
>
> This patch does some code clean-up. I have consolidated the handling of the
> special case of F0.d in one place and moved the special case of zero values
> to after rounding has occurred.  This way, values not zero, but rounded down
> to zero are handled correctly.
>
> Regression tested on x86-64.  The comprehensive test case is from the PR
> reporter, Thomas Henlich. Thanks Thomas for that test case.
>
> OK for trunk?
>
> Jerry
>
> 2011-02-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
>
>        PR libgfortran/47567
>        * io/write_float.def (output_float): Move handling of w = 0 to after
>        output rounding. Check for zero and set zero_flag accordingly. Set
>        width according to zero_flag. Add better comments.
>

It doesn't work. I opened:

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

-- 
H.J.

Re: [patch, libgfortran] Pr47567 Wrong output for small absolute values with F editing

[Tobias Burnus]

Jerry DeLisle wrote:
> Regression tested on x86-64.  The comprehensive test case is from the 
> PR reporter, Thomas Henlich. Thanks Thomas for that test case.
> OK for trunk?

OK. Thanks for the patch.

Tobias

> 2011-02-27  Jerry DeLisle <jvdelisle@gcc.gnu.org>
>
>     PR libgfortran/47567
>     * io/write_float.def (output_float): Move handling of w = 0 to after
>     output rounding. Check for zero and set zero_flag accordingly. Set
>     width according to zero_flag. Add better comments.

[patch, libgfortran] Pr47567 Wrong output for small absolute values with F editing

[Jerry DeLisle]

[-- Attachment #1: Type: text/plain, Size: 810 bytes --]

Hi all,

I am painfully aware that we have gone through a few iterations here.  Once 
again, I hope this is the last of it.

This patch does some code clean-up. I have consolidated the handling of the 
special case of F0.d in one place and moved the special case of zero values to 
after rounding has occurred.  This way, values not zero, but rounded down to 
zero are handled correctly.

Regression tested on x86-64.  The comprehensive test case is from the PR 
reporter, Thomas Henlich. Thanks Thomas for that test case.

OK for trunk?

Jerry

2011-02-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/47567
	* io/write_float.def (output_float): Move handling of w = 0 to after
	output rounding. Check for zero and set zero_flag accordingly. Set
	width according to zero_flag. Add better comments.

[-- Attachment #2: pr47567-new.diff --]
[-- Type: text/x-patch, Size: 2130 bytes --]

Index: write_float.def
===================================================================
--- write_float.def	(revision 170543)
+++ write_float.def	(working copy)
@@ -109,16 +109,8 @@ output_float (st_parameter_dt *dtp, const fnode *f
 
   /* Make sure zero comes out as 0.0e0.   */
   if (zero_flag)
-    {
-      e = 0;
-      if (compile_options.sign_zero != 1)
-	sign = calculate_sign (dtp, 0);
+    e = 0;
 
-      /* Handle special cases.  */
-      if (w == 0)
-	w = d + (sign != S_NONE ? 2 : 1) + (d == 0 ? 1 : 0);
-    }
-
   /* Normalize the fractional component.  */
   buffer[2] = buffer[1];
   digits = &buffer[2];
@@ -376,15 +368,21 @@ output_float (st_parameter_dt *dtp, const fnode *f
   else
     edigits = 0;
 
-  /* Zero values always output as positive, even if the value was negative
-     before rounding.  */
+  /* Scan the digits string and count the number of zeros.  If we make it
+     all the way through the loop, we know the value is zero after the
+     rounding completed above.  */
   for (i = 0; i < ndigits; i++)
     {
       if (digits[i] != '0')
 	break;
     }
+
+  /* To format properly, we need to know if the rounded result is zero and if
+     so, we set the zero_flag which may have been already set for
+     actual zero.  */
   if (i == ndigits)
     {
+      zero_flag = true;
       /* The output is zero, so set the sign according to the sign bit unless
 	 -fno-sign-zero was specified.  */
       if (compile_options.sign_zero == 1)
@@ -393,11 +391,17 @@ output_float (st_parameter_dt *dtp, const fnode *f
 	sign = calculate_sign (dtp, 0);
     }
 
-  /* Pick a field size if none was specified.  */
+  /* Pick a field size if none was specified, taking into account small
+     values that may have been rounded to zero.  */
   if (w <= 0)
     {
-      w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
-      w = w == 1 ? 2 : w;
+      if (zero_flag)
+	w = d + (sign != S_NONE ? 2 : 1) + (d == 0 ? 1 : 0);
+      else
+	{
+	  w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
+	  w = w == 1 ? 2 : w;
+	}
     }
   
   /* Work out how much padding is needed.  */

[-- Attachment #3: fmt_fw_d.f90 --]
[-- Type: text/x-fortran, Size: 3658 bytes --]

! { dg-do run }
! PR47567 Wrong output for small absolute values with F editing
! Test case provided by Thomas Henlich 
call verify_fmt(1.2)
call verify_fmt(-0.1)
call verify_fmt(1e-7)
call verify_fmt(1e-6)
call verify_fmt(1e-5)
call verify_fmt(1e-4)
call verify_fmt(1e-3)
call verify_fmt(1e-2)
call verify_fmt(-1e-7)
call verify_fmt(-1e-6)
call verify_fmt(-1e-5)
call verify_fmt(-1e-4)
call verify_fmt(-1e-3)
call verify_fmt(-1e-2)
call verify_fmt(tiny(0.0))
call verify_fmt(-tiny(0.0))
call verify_fmt(0.0)
call verify_fmt(-0.0)
call verify_fmt(100.0)
call verify_fmt(.12345)
call verify_fmt(1.2345)
call verify_fmt(12.345)
call verify_fmt(123.45)
call verify_fmt(1234.5)
call verify_fmt(12345.6)
call verify_fmt(123456.7)
call verify_fmt(99.999)
call verify_fmt(-100.0)
call verify_fmt(-99.999)
end

! loop through values for w, d
subroutine verify_fmt(x)
    real, intent(in) :: x
    integer :: w, d
    character(len=80) :: str, str0
    integer :: len, len0
    character(len=80) :: fmt_w_d
    logical :: result, have_num, verify_fmt_w_d
    
    do d = 0, 10
        have_num = .false.
        do w = 1, 20
            str = fmt_w_d(x, w, d)
            len = len_trim(str)
            
            result = verify_fmt_w_d(x, str, len, w, d)
            if (.not. have_num .and. result) then
                have_num = .true.
                str0 = fmt_w_d(x, 0, d)
                len0 = len_trim(str0)
                if (len /= len0) then
                    call errormsg(x, str0, len0, 0, d, "selected width is wrong")
                else
                    if (str(:len) /= str0(:len0)) call errormsg(x, str0, len0, 0, d, "output is wrong")
                end if
            end if
        end do
    end do

end subroutine

! checks for standard-compliance, returns .true. if field contains number, .false. on overflow
function verify_fmt_w_d(x, str, len, w, d)
    real, intent(in) :: x
    character(len=80), intent(in) :: str
    integer, intent(in) :: len
    integer, intent(in) :: w, d
    logical :: verify_fmt_w_d
    integer :: pos
    character :: decimal_sep = "."

    verify_fmt_w_d = .false.
    
    ! check if string is all asterisks
    pos = verify(str(:len), "*")
    if (pos == 0) return
    
    ! check if string contains a digit
    pos = scan(str(:len), "0123456789")
    if (pos == 0) call errormsg(x, str, len, w, d, "no digits")

    ! contains decimal separator?
    pos = index(str(:len), decimal_sep)
    if (pos == 0) call errormsg(x, str, len, w, d, "no decimal separator")
    
    ! negative and starts with minus?
    if (sign(1., x) < 0.) then
        pos = verify(str, " ")
        if (pos == 0) call errormsg(x, str, len, w, d, "only spaces")
        if (str(pos:pos) /= "-") call errormsg(x, str, len, w, d, "no minus sign")
    end if
    
    verify_fmt_w_d = .true.
end function

function fmt_w_d(x, w, d)
    real, intent(in) :: x
    integer, intent(in) :: w, d
    character(len=*) :: fmt_w_d
    character(len=10) :: fmt, make_fmt
    
    fmt = make_fmt(w, d)
    write (fmt_w_d, fmt) x
end function

function make_fmt(w, d)
    integer, intent(in) :: w, d
    character(len=10) :: make_fmt
    
    write (make_fmt,'("(f",i0,".",i0,")")') w, d
end function

subroutine errormsg(x, str, len, w, d, reason)
    real, intent(in) :: x
    character(len=80), intent(in) :: str
    integer, intent(in) :: len, w, d
    character(len=*), intent(in) :: reason
    integer :: fmt_len
    character(len=10) :: fmt, make_fmt
    
    fmt = make_fmt(w, d)
    fmt_len = len_trim(fmt)
    
    !print *, "print '", fmt(:fmt_len), "', ", x, " ! => ", str(:len), ": ", reason
    call abort
end subroutine

[patch,libgfortran] PR47567 Wrong output for small absolute values with F editing

[Jerry DeLisle]

[-- Attachment #1: Type: text/plain, Size: 545 bytes --]

Hi all,

After a lot of thought and the persistence of the OP, I think now the right 
thing to do is to get rid of the special handling we have for a zero F editing 
with width of one.  Otherwise, we add additional special handling for width 2.

The attached patch does this and simplifies the code.

Regression tested on x86-64. Revised test case attached.

OK for trunk?

Jerry

2011-02-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/47567
	* io/write_float.def (output_float): Remove special case handling of
	zero with width 1.

[-- Attachment #2: fmt_f0_1.f90 --]
[-- Type: text/x-fortran, Size: 1728 bytes --]

! { dg-do run }
! PR39304 write of  0.0 with F0.3 gives  **
! Test case developed from case provided by reporter.
 REAL :: x
 CHARACTER(80) :: str
 x = 0.0
 write (str,'(f0.0)') x
 if (str.ne."0.") call abort
 write (str,'(f0.1)') x
 if (str.ne.".0") call abort
 write (str,'(f0.2)') x
 if (str.ne.".00") call abort
 write (str,'(f0.3)') x
 if (str.ne.".000") call abort
 write (str,'(f0.4)') x
 if (str.ne.".0000") call abort
 write (str,'(F0.0)') 0.0
 if (str.ne."0.") call abort
 write (str,'(F0.0)') 0.001
 if (str.ne."0.") call abort
 write (str,'(F0.0)') 0.01
 if (str.ne."0.") call abort
 write (str,'(F0.0)') 0.1
 if (str.ne."0.") call abort
 write (str,'(F1.0)') -0.0
 if (str.ne."*") call abort
 write (str,'(F1.0)') 0.001
 if (str.ne."*") call abort
 write (str,'(F1.0)') 0.01
 if (str.ne."*") call abort
 write (str,'(F1.0)') 0.1
 if (str.ne."*") call abort
 write (str,'(F2.0)') -0.001
 if (str.ne."**") call abort
 write (str,'(F2.0)') -0.01
 if (str.ne."**") call abort
 write (str,'(F2.0)') -0.1
 if (str.ne."**") call abort
 write (str,'(F0.2)') 0.0
 if (str.ne.".00") call abort
 write (str,'(F0.0)') -0.0
 if (str.ne."-0.") call abort
 write (str,'(F0.1)') -0.0
 if (str.ne."-.0") call abort
 write (str,'(F0.2)') -0.0
 if (str.ne."-.00") call abort
 write (str,'(F0.3)') -0.0
 if (str.ne."-.000") call abort
 write (str,'(F3.0)') -0.0
 if (str.ne."-0.") call abort
 write (str,'(F2.0)') -0.0
 if (str.ne."**") call abort
 write (str,'(F1.0)') -0.0
 if (str.ne."*") call abort
 write (str,'(F0.1)') -0.0
 if (str.ne."-.0") call abort
 write (str,'(F3.1)') -0.0
 if (str.ne."-.0") call abort
 write (str,'(F2.1)') -0.0
 if (str.ne."**") call abort
 write (str,'(F1.1)') -0.0
 if (str.ne."*") call abort
 END  

[-- Attachment #3: pr47567-3.diff --]
[-- Type: text/x-patch, Size: 805 bytes --]

Index: io/write_float.def
===================================================================
--- io/write_float.def	(revision 170426)
+++ io/write_float.def	(working copy)
@@ -117,25 +117,6 @@ output_float (st_parameter_dt *dtp, const fnode *f
       /* Handle special cases.  */
       if (w == 0)
 	w = d + (sign != S_NONE ? 2 : 1) + (d == 0 ? 1 : 0);
-
-      /* For this one we choose to not output a decimal point.
-	 F95 10.5.1.2.1  */
-      if (w == 1 && ft == FMT_F)
-	{
-	  out = write_block (dtp, w);
-	  if (out == NULL)
-	    return FAILURE;
-
-	  if (unlikely (is_char4_unit (dtp)))
-	    {
-	      gfc_char4_t *out4 = (gfc_char4_t *) out;
-	      *out4 = '0';
-	      return SUCCESS;
-	    }
-
-	  *out = '0';
-	  return SUCCESS;
-	}
     }
 
   /* Normalize the fractional component.  */

Re: [patch, libgfortran] PR47567 Wrong output for small absolute values with F editing

[Jerry DeLisle]

On 02/18/2011 05:41 PM, Jerry DeLisle wrote:
> This small patch adjusts the processor generated width for F0.d formatting to
> accommodate negative signs on zero.
>
> Regression tested on x86-64. Updated test case provided.
>
> OK for trunk?
>
> Regards,
>
> Jerry
>
> 2011-02-18 Jerry DeLisle <jvdelisle@gcc.gnu.org>
>
> PR libgfortran/47567
> * io/write_float.def (output_float): Adjust width for F0.d to
> allow space for negative signs on zero.

Committed after approval from Tobias on IRC.

Author: jvdelisle
Date: Sat Feb 19 15:10:55 2011
New Revision: 170318

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=170318
Log:
2011-02-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

     PR libgfortran/47567
     * io/write_float.def (output_float): Adjust width for F0.d to
     allow space for negative signs on zero.

[patch, libgfortran] PR47567 Wrong output for small absolute values with F editing

[Jerry DeLisle]

[-- Attachment #1: Type: text/plain, Size: 384 bytes --]

This small patch adjusts the processor generated width for F0.d formatting to 
accommodate negative signs on zero.

Regression tested on x86-64. Updated test case provided.

OK for trunk?

Regards,

Jerry

2011-02-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/47567
	* io/write_float.def (output_float): Adjust width for F0.d to
	allow space for negative signs on zero.

[-- Attachment #2: pr47567.diff --]
[-- Type: text/x-patch, Size: 448 bytes --]

Index: write_float.def
===================================================================
--- write_float.def	(revision 170273)
+++ write_float.def	(working copy)
@@ -116,7 +116,7 @@ output_float (st_parameter_dt *dtp, const fnode *f
 
       /* Handle special cases.  */
       if (w == 0)
-	w = d + 1;
+	w = d + (sign != S_NONE ? 2 : 1) + (d == 0 ? 1 : 0);
 
       /* For this one we choose to not output a decimal point.
 	 F95 10.5.1.2.1  */

[-- Attachment #3: fmt_f0_1.f90 --]
[-- Type: text/x-fortran, Size: 1338 bytes --]

! { dg-do run )
! PR39304 write of  0.0 with F0.3 gives  **
! Test case developed from case provided by reporter.
 REAL :: x
 CHARACTER(80) :: str
 x = 0.0
 write (str,'(f0.0)') x
 if (str.ne."0.") call abort
 write (str,'(f0.1)') x
 if (str.ne."0.0") call abort
 write (str,'(f0.2)') x
 if (str.ne."0.00") call abort
 write (str,'(f0.3)') x
 if (str.ne."0.000") call abort
 write (str,'(f0.4)') x
 if (str.ne."0.0000") call abort
 write (str,'(F0.0)') 0.0
 if (str.ne."0.") call abort
 write (str,'(F0.0)') 0.001
 if (str.ne."0.") call abort
 write (str,'(F0.0)') 0.01
 if (str.ne."0.") call abort
 write (str,'(F0.0)') 0.1
 if (str.ne."0.") call abort
 write (str,'(F1.0)') -0.0
 if (str.ne."0") call abort
 write (str,'(F1.0)') 0.001
 if (str.ne."*") call abort
 write (str,'(F1.0)') 0.01
 if (str.ne."*") call abort
 write (str,'(F1.0)') 0.1
 if (str.ne."*") call abort
 write (str,'(F2.0)') -0.001
 if (str.ne."*") call abort
 write (str,'(F2.0)') -0.01
 if (str.ne."**") call abort
 write (str,'(F2.0)') -0.1
 if (str.ne."**") call abort
 write (str,'(F0.2)') 0.0
 if (str.ne.".00") call abort
 write (str,'(F0.0)') -0.0
 if (str.ne."-0.") call abort
 write (str,'(F0.1)') -0.0
 if (str.ne."-.0") call abort
 write (str,'(F0.2)') -0.0
 if (str.ne."-.00") call abort
 write (str,'(F0.3)') -0.0
 if (str.ne."-.000") call abort
 END