Hi,
currently when writing a value of type real or complex using
list-directed output, the G0 edit descriptor, or namelist output,
gfortran chooses the number of significant digits such that a
binary->ascii->binary roundtrip recovers the original value exactly,
per IEEE 754-2008. Assuming, of course, that the target snprintf() and
strto{f,d,ld,q} functions are up to the task. However, I think this
choice is not a good idea:
- The standard doesn't require this behavior, it merely says something
along "reasonable processor-dependent values for w, d, and e shall be
chosen". Thus, a user who requires an exact roundtrip must specify the
number of digits (d) himself anyway.
- If an exact roundtrip is required, the standard provides the B, O,
and Z edit descriptors which do guarantee this.
- G formatting doesn't work very well when d is large (in libgfortran,
list-directed and namelist real output uses G formatting, so this
applies in these cases as well). Somewhat simplified, G formatting
works such that when the exponent is in the range [-1, d], F editing
is used, otherwise E editing. Thus, with a large d, F editing is used
for numbers with a large magnitude, making the result more or less
unreadable. For instance, what is the magnitude of
"-3333333333333333333333333333333.33350"? This output is for quad
precision, but the same problem exists to a lesser extent for smaller
real kinds as well.
- In many if not most uses, printing out the result in full precision
is not needed or just pointless if precision loss has already occured
during the calculation.
Thus, I suggest that the choice of d should be based on readability
and usefulness for the common case rather than guaranteeing an exact
roundtrip. The attached patch does this. Based on my own unscientific
tests, the patch chooses d=6 significant digits, as with 6 digits it's
still relatively easy to eyeball the magnitude of a number when F
editing is used without having to explicitly count digits. At the same
time, 6 significant digits is usually more than enough when reading
the output of a program. Incidentally, 6 significant digits is also
what is used with the printf() "%g" specifier if the precision is not
explicitly specified, presumably for roughly similar reasons as stated
above.
Regtested on x86_64-unknown-linux-gnu, Ok for trunk?
libgfortran ChangeLog:
2012-03-12 Janne Blomqvist <[email protected]>
* io/write.c (set_fnode_default): Set precision to 6 significant
digits.
(write_real): Fix comment.
testsuite ChangeLog:
2012-03-12 Janne Blomqvist <[email protected]>
* gfortran.dg/char4_iunit_1.f03: Fix test of result.
* gfortran.dg/char4_iunit_2.f03: Likewise.
* gfortran.dg/coarray_15.f90: Likewise.
* gfortran.dg/default_format_1.inc: Likewise.
* gfortran.dg/default_format_2.inc: Likewise.
* gfortran.dg/f2003_io_5.f03: Likewise.
* gfortran.dg/fmt_g0_1.f08: Likewise.
* gfortran.dg/large_real_kind_form_io_2.f90: Likewise.
* gfortran.dg/namelist_65.f90: Likewise.
* gfortran.dg/namelist_print_1.f: Likewise.
* gfortran.dg/quad_2.f90: Likewise.
* gfortran.dg/real_const_3.f90: Likewise.
--
Janne Blomqvist
diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03
index f02cc1a..f326523 100644
--- a/gcc/testsuite/gfortran.dg/char4_iunit_1.f03
+++ b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03
@@ -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.23450E-06 4.28460E+010 ") print *, string !call abort
write(string, *) nan, inf
- if (string .ne. 4_" NaN Infinity ") call abort
+ if (string .ne. 4_" NaN Infinity ") call abort
write(string, '(10x,f3.1,3x,f9.1)') nan, inf
if (string .ne. 4_" NaN Infinity ") call abort
write(string, *) (1.2, 3.4 )
- if (string .ne. 4_" ( 1.20000005 , 3.40000010 ) ") call abort
+ if (string .ne. 4_" ( 1.20000 , 3.40000 ) ") call abort
end program char4_iunit_1
diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03
index cbf0f7f..2c59205 100644
--- a/gcc/testsuite/gfortran.dg/char4_iunit_2.f03
+++ b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03
@@ -43,5 +43,5 @@ program char4_iunit_2
write(widestring,*)"test",i, x, str_default,&
trim(str_char4)
if (widestring .ne. &
- k_" test 345 52.5429993 0 hijklmnp qwertyuiopasd") call abort
+ k_" test 345 52.5430 0 hijklmnp qwertyuiopasd") call abort
end program char4_iunit_2
diff --git a/gcc/testsuite/gfortran.dg/coarray_15.f90 b/gcc/testsuite/gfortran.dg/coarray_15.f90
index 0aecb2f..6198c88 100644
--- a/gcc/testsuite/gfortran.dg/coarray_15.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_15.f90
@@ -25,17 +25,17 @@ program ex2
str = repeat('X', len(str))
write(str,*) 'z=',z(:),' on image',this_image()
- if (str /= " z= 1.20000005 1.20000005 1.20000005 on image 1") &
+ if (str /= " z= 1.20000 1.20000 1.20000 on image 1") &
call abort
str = repeat('X', len(str))
write(str,*) 'z=',z,' on image',this_image()
- if (str /= " z= 1.20000005 1.20000005 1.20000005 on image 1") &
+ if (str /= " z= 1.20000 1.20000 1.20000 on image 1") &
call abort
str = repeat('X', len(str))
write(str,*) 'z=',z(1:3)[this_image()],' on image',this_image()
- if (str /= " z= 1.20000005 1.20000005 1.20000005 on image 1") &
+ if (str /= " z= 1.20000 1.20000 1.20000 on image 1") &
call abort
call ex2a()
@@ -62,12 +62,12 @@ subroutine ex2a()
str = repeat('X', len(str))
write(str,*) 'z=',z(:,:),' on image',this_image()
- if (str /= " z= 1.20000005 1.20000005 1.20000005 1.20000005 on image 1") &
+ if (str /= " z= 1.20000 1.20000 1.20000 1.20000 on image 1") &
call abort
str = repeat('X', len(str))
write(str,*) 'z=',z,' on image',this_image()
- if (str /= " z= 1.20000005 1.20000005 1.20000005 1.20000005 on image 1") &
+ if (str /= " z= 1.20000 1.20000 1.20000 1.20000 on image 1") &
call abort
end subroutine ex2a
@@ -82,17 +82,17 @@ subroutine ex5
str = repeat('X', len(str))
write(str,*) 'In main on image',this_image(), 'w= ',w
- if (str /= " In main on image 1 w= 1.00000000 1.00000000 1.00000000 1.00000000") &
+ if (str /= " In main on image 1 w= 1.00000 1.00000 1.00000 1.00000") &
call abort
str = repeat('X', len(str))
write(str,*) 'In main on image',this_image(), 'w= ',w(1:4)
- if (str /= " In main on image 1 w= 1.00000000 1.00000000 1.00000000 1.00000000") &
+ if (str /= " In main on image 1 w= 1.00000 1.00000 1.00000 1.00000") &
call abort
str = repeat('X', len(str))
write(str,*) 'In main on image',this_image(), 'w= ',w(:)[1]
- if (str /= " In main on image 1 w= 1.00000000 1.00000000 1.00000000 1.00000000") &
+ if (str /= " In main on image 1 w= 1.00000 1.00000 1.00000 1.00000") &
call abort
sync all
@@ -107,6 +107,6 @@ subroutine ex5_sub(n,w)
str = repeat('X', len(str))
write(str,*) 'In sub on image',this_image(), 'w= ',w
- if (str /= " In sub on image 1 w= 1.00000000") &
+ if (str /= " In sub on image 1 w= 1.00000") &
call abort
end subroutine ex5_sub
diff --git a/gcc/testsuite/gfortran.dg/default_format_1.inc b/gcc/testsuite/gfortran.dg/default_format_1.inc
index e5d711c..f750c6c 100644
--- a/gcc/testsuite/gfortran.dg/default_format_1.inc
+++ b/gcc/testsuite/gfortran.dg/default_format_1.inc
@@ -23,7 +23,7 @@ contains
do i = 0, count
write (s,*) x
read (s,*) y
- if (y /= x) res = res + 1
+ if (abs((y - x) / x) > 1e-5) res = res + 1
x = nearest(x,huge(x))
end do
end if
@@ -33,7 +33,7 @@ contains
do i = 0, count
write (s,*) x
read (s,*) y
- if (y /= x) res = res + 1
+ if (abs((y - x) / x) > 1e-5) res = res + 1
x = nearest(x,-huge(x))
end do
end if
@@ -55,7 +55,7 @@ contains
do i = 0, count
write (s,*) x
read (s,*) y
- if (y /= x) res = res + 1
+ if (abs ((y - x) / x) > 1e-5) res = res + 1
x = nearest(x,huge(x))
end do
end if
@@ -65,7 +65,7 @@ contains
do i = 0, count
write (s,*) x
read (s,*) y
- if (y /= x) res = res + 1
+ if (abs ((y - x) / x) > 1e-5) res = res + 1
x = nearest(x,-huge(x))
end do
end if
diff --git a/gcc/testsuite/gfortran.dg/default_format_2.inc b/gcc/testsuite/gfortran.dg/default_format_2.inc
index 7306f07..91d2976 100644
--- a/gcc/testsuite/gfortran.dg/default_format_2.inc
+++ b/gcc/testsuite/gfortran.dg/default_format_2.inc
@@ -24,7 +24,7 @@ contains
do i = 0, count
write (s,*) x
read (s,*) y
- if (y /= x) res = res + 1
+ if (abs((y - x) / x) > 1e-5) res = res + 1
x = nearest(x,huge(x))
end do
end if
@@ -34,7 +34,7 @@ contains
do i = 0, count
write (s,*) x
read (s,*) y
- if (y /= x) res = res + 1
+ if (abs((y - x) / x) > 1e-5) res = res + 1
x = nearest(x,-huge(x))
end do
end if
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_5.f03 b/gcc/testsuite/gfortran.dg/f2003_io_5.f03
index c064e0c..8d1170e 100644
--- a/gcc/testsuite/gfortran.dg/f2003_io_5.f03
+++ b/gcc/testsuite/gfortran.dg/f2003_io_5.f03
@@ -13,14 +13,14 @@ write(99,nml=nm,decimal="comma")
a = 5.55
rewind(99)
read(99,nml=nm,decimal="comma")
-if (any (a /= [ (i*1.3, i=1,10) ])) call abort
+if (any (abs(a - [ (i*1.3, i=1,10) ]) > 1e-6)) call abort
close(99, status="delete")
c = (3.123,4.456)
write(complex,*,decimal="comma") c
-if (complex.ne." ( 3,12299991 ; 4,45599985 )") call abort
+if (complex.ne." ( 3,12300 ; 4,45600 )") call abort
c = (0.0, 0.0)
read(complex,*,decimal="comma") c
-if (complex.ne." ( 3,12299991 ; 4,45599985 )") call abort
+if (complex.ne." ( 3,12300 ; 4,45600 )") call abort
end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_1.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_1.f08
index ead6f81..32350a6 100644
--- a/gcc/testsuite/gfortran.dg/fmt_g0_1.f08
+++ b/gcc/testsuite/gfortran.dg/fmt_g0_1.f08
@@ -8,13 +8,13 @@
write(buffer, string) ':',0,':'
if (buffer.ne.":0:") call abort
write(buffer, string) ':',1.0_8/3.0_8,':'
- if (buffer.ne.":.33333333333333331:") call abort
+ if (buffer.ne.":.333333:") call abort
write(buffer, '(1x,a,g0,a)') ':',1.0_8/3.0_8,':'
- if (buffer.ne." :.33333333333333331:") call abort
+ if (buffer.ne." :.333333:") call abort
write(buffer, string) ':',"hello",':'
if (buffer.ne.":hello:") call abort
write(buffer, "(g0,g0,g0,g0)") ':',.true.,.false.,':'
if (buffer.ne.":TF:") call abort
write(buffer, "(g0,g0,',',g0,g0)") '(',( 1.2345_8, 2.4567_8 ),')'
- if (buffer.ne."(1.2344999999999999,2.4567000000000001)") call abort
+ if (buffer.ne."(1.23450,2.45670)") call abort
end
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90 b/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90
index a72c718..88da14e 100644
--- a/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90
+++ b/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90
@@ -12,24 +12,24 @@ program large_real_kind_form_io_2
b(:) = huge(0.0_k)
write (tmp, *) b
read (tmp, *) a, c
- if (a /= b(1)) call abort ()
- if (c /= b(2)) call abort ()
+ if (abs((a - b(1)) / b(1)) > 1e-5) call abort ()
+ if (abs((c - b(2)) / b(2)) > 1e-5) call abort ()
b(:) = -huge(0.0_k)
write (tmp, *) b
read (tmp, *) a, c
- if (a /= b(1)) call abort ()
- if (c /= b(2)) call abort ()
+ if (abs((a - b(1)) / b(1)) > 1e-5) call abort ()
+ if (abs((c - b(2)) / b(2)) > 1e-5) call abort ()
b(:) = nearest(tiny(0.0_k),1.0_k)
write (tmp, *) b
read (tmp, *) a, c
- if (a /= b(1)) call abort ()
- if (c /= b(2)) call abort ()
+ if (abs((a - b(1)) / b(1)) > 1e-5) call abort ()
+ if (abs((c - b(2)) / b(2)) > 1e-5) call abort ()
b(:) = nearest(-tiny(0.0_k),-1.0_k)
write (tmp, *) b
read (tmp, *) a, c
- if (a /= b(1)) call abort ()
- if (c /= b(2)) call abort ()
+ if (abs((a - b(1)) / b(1)) > 1e-5) call abort ()
+ if (abs((c - b(2)) / b(2)) > 1e-5) call abort ()
end program large_real_kind_form_io_2
diff --git a/gcc/testsuite/gfortran.dg/namelist_65.f90 b/gcc/testsuite/gfortran.dg/namelist_65.f90
index 7efbe70..e9be7b2 100644
--- a/gcc/testsuite/gfortran.dg/namelist_65.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_65.f90
@@ -14,9 +14,9 @@ enddo
write(out,nl1)
if (out(1).ne."&NL1") call abort
-if (out(2).ne." A= 1.00000000 ,") call abort
-if (out(3).ne." B= 2.00000000 ,") call abort
-if (out(4).ne." C= 3.00000000 ,") call abort
+if (out(2).ne." A= 1.00000 ,") call abort
+if (out(3).ne." B= 2.00000 ,") call abort
+if (out(4).ne." C= 3.00000 ,") call abort
if (out(5).ne." /") call abort
end program oneline
diff --git a/gcc/testsuite/gfortran.dg/namelist_print_1.f b/gcc/testsuite/gfortran.dg/namelist_print_1.f
index 2e5de83..ce64558 100644
--- a/gcc/testsuite/gfortran.dg/namelist_print_1.f
+++ b/gcc/testsuite/gfortran.dg/namelist_print_1.f
@@ -9,5 +9,5 @@
namelist /mynml/ x
x = 1
! ( dg-output "^" }
- print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X= 1.00000000 ,(\n|\r\n|\r) /(\n|\r\n|\r)" }
+ print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X= 1.00000 ,(\n|\r\n|\r) /(\n|\r\n|\r)" }
end
diff --git a/gcc/testsuite/gfortran.dg/quad_2.f90 b/gcc/testsuite/gfortran.dg/quad_2.f90
index d3c90a0..eed6d6c 100644
--- a/gcc/testsuite/gfortran.dg/quad_2.f90
+++ b/gcc/testsuite/gfortran.dg/quad_2.f90
@@ -13,53 +13,52 @@ program test_qp
implicit none
integer, parameter :: QP = real_kinds(ubound(real_kinds,dim=1))
real(qp) :: fp1, fp2, fp3, fp4
- character(len=80) :: str1, str2, str3, str4
+ character(len=80) :: str2, str4, fmt
+
+ select case (qp)
+ case (8)
+ fmt = '(g0.17)'
+ case (10)
+ fmt = '(g0.21)'
+ case (16)
+ fmt = '(g0.36)'
+ case default
+ call abort()
+ end select
+
fp1 = 1
fp2 = sqrt (2.0_qp)
- write (str1,*) fp1
- write (str2,'(g0)') fp1
- write (str3,*) fp2
- write (str4,'(g0)') fp2
+ write (str2, fmt) fp1
+ write (str4, fmt) fp2
! print '(3a)', '>',trim(str1),'<'
! print '(3a)', '>',trim(str2),'<'
! print '(3a)', '>',trim(str3),'<'
! print '(3a)', '>',trim(str4),'<'
- read (str1, *) fp3
- if (fp1 /= fp3) call abort()
read (str2, *) fp3
if (fp1 /= fp3) call abort()
- read (str3, *) fp4
- if (fp2 /= fp4) call abort()
read (str4, *) fp4
if (fp2 /= fp4) call abort()
select case (qp)
case (8)
- if (str1 /= " 1.0000000000000000") call abort()
if (str2 /= "1.0000000000000000") call abort()
- if (str3 /= " 1.4142135623730951") call abort()
if (str4 /= "1.4142135623730951") call abort()
case (10)
- if (str1 /= " 1.00000000000000000000") call abort()
if (str2 /= "1.00000000000000000000") call abort()
- if (str3 /= " 1.41421356237309504876") call abort()
if (str4 /= "1.41421356237309504876") call abort()
case (16)
- if (str1 /= " 1.00000000000000000000000000000000000") call abort()
if (str2 /= "1.00000000000000000000000000000000000") call abort()
if (digits(1.0_qp) == 113) then
! IEEE 754 binary 128 format
! e.g. libquadmath/__float128 on i686/x86_64/ia64
- if (str3 /= " 1.41421356237309504880168872420969798") call abort()
if (str4 /= "1.41421356237309504880168872420969798") call abort()
else if (digits(1.0_qp) == 106) then
! IBM binary 128 format
- if (str3(1:37) /= " 1.41421356237309504880168872420969") call abort()
if (str4(1:34) /= "1.41421356237309504880168872420969") call abort()
end if
diff --git a/gcc/testsuite/gfortran.dg/real_const_3.f90 b/gcc/testsuite/gfortran.dg/real_const_3.f90
index e4b5de7..6162191 100644
--- a/gcc/testsuite/gfortran.dg/real_const_3.f90
+++ b/gcc/testsuite/gfortran.dg/real_const_3.f90
@@ -42,15 +42,15 @@ program main
if (trim(adjustl(str)) .ne. 'NaN') call abort
write(str,*) z
- if (trim(adjustl(str)) .ne. '( NaN, NaN)') call abort
+ if (trim(adjustl(str)) .ne. '( NaN, NaN)') call abort
write(str,*) z2
- if (trim(adjustl(str)) .ne. '( NaN, NaN)') call abort
+ if (trim(adjustl(str)) .ne. '( NaN, NaN)') call abort
write(str,*) z3
- if (trim(adjustl(str)) .ne. '( Infinity, -Infinity)') call abort
+ if (trim(adjustl(str)) .ne. '( Infinity, -Infinity)') call abort
write(str,*) z4
- if (trim(adjustl(str)) .ne. '( 0.00000000 , -0.00000000 )') call abort
+ if (trim(adjustl(str)) .ne. '( 0.00000 , -0.00000 )') call abort
end program main
diff --git a/libgcc/configure b/libgcc/configure
old mode 100644
new mode 100755
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 8be3a5a..1af7080 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1421,45 +1421,40 @@ static void
set_fnode_default (st_parameter_dt *dtp, fnode *f, int length)
{
f->format = FMT_G;
+ f->u.real.d = 6;
+
switch (length)
{
case 4:
- f->u.real.w = 16;
- f->u.real.d = 9;
f->u.real.e = 2;
break;
case 8:
- f->u.real.w = 25;
- f->u.real.d = 17;
f->u.real.e = 3;
break;
case 10:
- f->u.real.w = 30;
- f->u.real.d = 21;
- f->u.real.e = 4;
- break;
case 16:
- f->u.real.w = 45;
- f->u.real.d = 36;
f->u.real.e = 4;
break;
default:
internal_error (&dtp->common, "bad real kind");
break;
}
+
+ /* 5 extra characters: Initial sign, digit before decimal, decimal,
+ exponent character, exponent sign. */
+ f->u.real.w = f->u.real.d + f->u.real.e + 5;
}
-/* Output a real number with default format. To guarantee that a
- binary -> decimal -> binary roundtrip conversion recovers the
- original value, IEEE 754-2008 requires 9, 17, 21 and 36 significant
- digits for REAL kinds 4, 8, 10, and 16, respectively. Thus, we use
- 1PG16.9E2 for REAL(4), 1PG25.17E3 for REAL(8), 1PG30.21E4 for
- REAL(10) and 1PG45.36E4 for REAL(16). The exception is that the
- Fortran standard requires outputting an extra digit when the scale
- factor is 1 and when the magnitude of the value is such that E
- editing is used. However, gfortran compensates for this, and thus
- for list formatted the same number of significant digits is
- generated both when using F and E editing. */
+
+/* Output a real number with default format, used by list formatted
+ output. We use a scale factor of 1, meaning that when the magnitude
+ is such that E editing is used, there is one digit before the
+ decimal point. The Fortran standard requires outputting an extra
+ digit when the scale factor is 1 and when the magnitude of the
+ value is such that E editing is used. However, gfortran compensates
+ for this, and thus for list formatted the same number of
+ significant digits is generated both when using F and E
+ editing. */
void
write_real (st_parameter_dt *dtp, const char *source, int length)
