This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, libgfortran] PR47434 Wrong field width for NaN with (F0.n) formatting
- From: Jerry DeLisle <jvdelisle at frontier dot com>
- To: gfortran <fortran at gcc dot gnu dot org>
- Cc: gcc patches <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 28 Jan 2011 14:55:24 -0800
- Subject: [patch, libgfortran] PR47434 Wrong field width for NaN with (F0.n) formatting
Hi,
The attached patches fix more than a few issues with Nan and Infinites related
to field widths and showing signs or not showing signs.
Previously we took the approach to show '+' on infinity to be consistent with
'-'. However in the case of f0.n formatting, this does not provide the minimum
possible width. The patch changes that behaviour. This results in quite a few
testsuite adjustments.
Another issue is the write_infnan function did not take into account the new
sign modes s, ss, and sp. We have this feature elsewhere and I used the
calculate_sign function to adjust the widths and determine whether or not to
emit signs, inf or infinity, and nan.
The program pr47434.f90 is not dejagnu-ized, but I used this to observe what we
are doing here. It mist be compiled with -fno-range-check. (We now closely
match intel on this)
Regression tested. OK for trunk?
Jerry
2011-01-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/47434
* io/write_float.def (write_infnan): Use calculate_sign to determine
if the sign should be given and check field widths accordingly.
Index: write_float.def
===================================================================
--- write_float.def (revision 169322)
+++ write_float.def (working copy)
@@ -660,15 +660,26 @@ write_infnan (st_parameter_dt *dtp, const fnode *f
{
char * p, fin;
int nb = 0;
+ sign_t sign;
+ int mark;
if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z)
{
+ sign = calculate_sign (dtp, sign_bit);
+ mark = (sign == S_PLUS || sign == S_MINUS) ? 8 : 7;
+
nb = f->u.real.w;
/* If the field width is zero, the processor must select a width
not zero. 4 is chosen to allow output of '-Inf' or '+Inf' */
- if (nb == 0) nb = 4;
+ if (nb == 0)
+ {
+ if (isnan_flag)
+ nb = 3;
+ else
+ nb = (sign == S_PLUS || sign == S_MINUS) ? 4 : 3;
+ }
p = write_block (dtp, nb);
if (p == NULL)
return;
@@ -720,24 +731,28 @@ write_infnan (st_parameter_dt *dtp, const fnode *f
if (unlikely (is_char4_unit (dtp)))
{
gfc_char4_t *p4 = (gfc_char4_t *) p;
- if (nb > 8)
+
+ if (nb > mark)
/* We have room, so output 'Infinity' */
memcpy4 (p4 + nb - 8, "Infinity", 8);
else
- /* For the case of width equals 8, there is not enough room
+ /* For the case of width equals mark, there is not enough room
for the sign and 'Infinity' so we go with 'Inf' */
memcpy4 (p4 + nb - 3, "Inf", 3);
- if (nb < 9 && nb > 3)
- /* Put the sign in front of Inf */
- p4[nb - 4] = (gfc_char4_t) fin;
- else if (nb > 8)
- /* Put the sign in front of Infinity */
- p4[nb - 9] = (gfc_char4_t) fin;
+ if (sign == S_PLUS || sign == S_MINUS)
+ {
+ if (nb < 9 && nb > 3)
+ /* Put the sign in front of Inf */
+ p4[nb - 4] = (gfc_char4_t) fin;
+ else if (nb > 8)
+ /* Put the sign in front of Infinity */
+ p4[nb - 9] = (gfc_char4_t) fin;
+ }
return;
}
- if (nb > 8)
+ if (nb > mark)
/* We have room, so output 'Infinity' */
memcpy(p + nb - 8, "Infinity", 8);
else
@@ -745,10 +760,13 @@ write_infnan (st_parameter_dt *dtp, const fnode *f
for the sign and 'Infinity' so we go with 'Inf' */
memcpy(p + nb - 3, "Inf", 3);
- if (nb < 9 && nb > 3)
- p[nb - 4] = fin; /* Put the sign in front of Inf */
- else if (nb > 8)
- p[nb - 9] = fin; /* Put the sign in front of Infinity */
+ if (sign == S_PLUS || sign == S_MINUS)
+ {
+ if (nb < 9 && nb > 3)
+ p[nb - 4] = fin; /* Put the sign in front of Inf */
+ else if (nb > 8)
+ p[nb - 9] = fin; /* Put the sign in front of Infinity */
+ }
}
else
{
Index: gfortran.dg/read_infnan_1.f90
===================================================================
--- gfortran.dg/read_infnan_1.f90 (revision 169374)
+++ gfortran.dg/read_infnan_1.f90 (working copy)
@@ -22,9 +22,9 @@ read(10,'(7f10.3)') x4
rewind(10)
read(10,'(7f10.3)') x8
write (output, '("x4 =",7G6.0)') x4
-if (output.ne."x4 = +Inf NaN +Inf NaN -Inf NaN +Inf") call abort
+if (output.ne."x4 = Inf NaN Inf NaN -Inf NaN Inf") call abort
write (output, '("x8 =",7G6.0)') x8
-if (output.ne."x8 = +Inf NaN +Inf NaN -Inf NaN +Inf") call abort
+if (output.ne."x8 = Inf NaN Inf NaN -Inf NaN Inf") call abort
!print '("x4 =",7G6.0)', x4
!print '("x8 =",7G6.0)', x8
end program pr43298
Index: gfortran.dg/module_nan.f90
===================================================================
--- gfortran.dg/module_nan.f90 (revision 169374)
+++ gfortran.dg/module_nan.f90 (working copy)
@@ -19,7 +19,7 @@ program a
if (log(abs(inf)) < huge(inf)) call abort()
if (log(abs(minf)) < huge(inf)) call abort()
if (.not. isnan(nan)) call abort()
- write(str,*) inf
+ write(str,"(sp,f10.2)") inf
if (adjustl(str) /= "+Infinity") call abort()
write(str,*) minf
if (adjustl(str) /= "-Infinity") call abort()
Index: gfortran.dg/char4_iunit_1.f03
===================================================================
--- gfortran.dg/char4_iunit_1.f03 (revision 169374)
+++ gfortran.dg/char4_iunit_1.f03 (working copy)
@@ -26,9 +26,9 @@ program char4_iunit_1
write(string, *) 1.2345e-06, 4.2846e+10_8
if (string .ne. 4_" 1.23450002E-06 42846000000.000000 ") 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
+ if (string .ne. 4_" NaN Infinity ") call abort
write(string, *) (1.2, 3.4 )
if (string .ne. 4_" ( 1.2000000 , 3.4000001 ) ") call abort
end program char4_iunit_1
Index: gfortran.dg/large_real_kind_1.f90
===================================================================
--- gfortran.dg/large_real_kind_1.f90 (revision 169374)
+++ gfortran.dg/large_real_kind_1.f90 (working copy)
@@ -56,7 +56,7 @@ program test
call testoutput (-7.51e-100_k,-7.51e-100_8,15,'(F15.10)')
x = huge(x)
- call outputstring (2*x,'(F20.15)',' +Infinity')
+ call outputstring (2*x,'(F20.15)',' Infinity')
call outputstring (-2*x,'(F20.15)',' -Infinity')
write (c1,'(G20.10E5)') x
Index: gfortran.dg/nan_7.f90
===================================================================
--- gfortran.dg/nan_7.f90 (revision 0)
+++ gfortran.dg/nan_7.f90 (revision 0)
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR47293 NAN not correctly read
+character(len=200) :: str
+real(16) :: r, x, y, z
+integer(16) :: k1, k2
+x = 0.0
+y = 0.0
+r = 1.0
+str = 'NAN' ; read(str,*) r
+z = x/y
+k1 = transfer(z,k1)
+k2 = transfer(r,k2)
+if (k1.ne.k2) call abort
+end
Index: gfortran.dg/real_const_3.f90
===================================================================
--- gfortran.dg/real_const_3.f90 (revision 169374)
+++ gfortran.dg/real_const_3.f90 (working copy)
@@ -16,7 +16,7 @@ program main
b = 1/exp(1000.0)
write(str,*) a
- if (trim(adjustl(str)) .ne. '+Infinity') call abort
+ if (trim(adjustl(str)) .ne. 'Infinity') call abort
if (b .ne. 0.) call abort
@@ -36,7 +36,7 @@ program main
if (trim(adjustl(str)) .ne. '-Infinity') call abort
write(str,*) 3.0/0.
- if (trim(adjustl(str)) .ne. '+Infinity') call abort
+ if (trim(adjustl(str)) .ne. 'Infinity') call abort
write(str,*) nan
if (trim(adjustl(str)) .ne. 'NaN') call abort
@@ -48,7 +48,7 @@ program main
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.0000000 , -0.0000000 )') call abort
Index: gfortran.fortran-torture/execute/nan_inf_fmt.f90
===================================================================
--- gfortran.fortran-torture/execute/nan_inf_fmt.f90 (revision 169374)
+++ gfortran.fortran-torture/execute/nan_inf_fmt.f90 (working copy)
@@ -1,4 +1,5 @@
!pr 12839- F2003 formatting of Inf /Nan
+! Modified for PR47434
implicit none
character*40 l
character*12 fmt
@@ -15,11 +16,11 @@
! check a field width = 0
fmt = '(F0.0)'
write(l,fmt=fmt)pos_inf
- if (l.ne.'+Inf') call abort
+ if (l.ne.'Inf') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.'-Inf') call abort
write(l,fmt=fmt)nan
- if (l.ne.' NaN') call abort
+ if (l.ne.'NaN') call abort
! check a field width < 3
fmt = '(F2.0)'
@@ -42,7 +43,7 @@
! check a field width > 3
fmt = '(F4.0)'
write(l,fmt=fmt)pos_inf
- if (l.ne.'+Inf') call abort
+ if (l.ne.' Inf') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.'-Inf') call abort
write(l,fmt=fmt)nan
@@ -51,7 +52,7 @@
! check a field width = 7
fmt = '(F7.0)'
write(l,fmt=fmt)pos_inf
- if (l.ne.' +Inf') call abort
+ if (l.ne.' Inf') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.' -Inf') call abort
write(l,fmt=fmt)nan
@@ -60,7 +61,7 @@
! check a field width = 8
fmt = '(F8.0)'
write(l,fmt=fmt)pos_inf
- if (l.ne.' +Inf') call abort
+ if (l.ne.'Infinity') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.' -Inf') call abort
write(l,fmt=fmt)nan
@@ -69,7 +70,7 @@
! check a field width = 9
fmt = '(F9.0)'
write(l,fmt=fmt)pos_inf
- if (l.ne.'+Infinity') call abort
+ if (l.ne.' Infinity') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.'-Infinity') call abort
write(l,fmt=fmt)nan
@@ -78,7 +79,7 @@
! check a field width = 14
fmt = '(F14.0)'
write(l,fmt=fmt)pos_inf
- if (l.ne.' +Infinity') call abort
+ if (l.ne.' Infinity') call abort
write(l,fmt=fmt)neg_inf
if (l.ne.' -Infinity') call abort
write(l,fmt=fmt)nan
module nonordinal
implicit none
real, parameter :: inf = 1./0., nan = 0./0., minf = -1./0.0
end module nonordinal
program testnan
use nonordinal
implicit none
character(kind=4,len=20) :: str
print "(F0.2)", nan
print "(F3.2)", nan
print "(sp,F0.2)", inf ! SIGN=PLUS
print "(ss,F0.2)", inf ! SIGN=SUPPRESS
print "(s, F0.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F1.2)", inf ! SIGN=PLUS
print "(ss,F1.2)", inf ! SIGN=SUPPRESS
print "(s, F1.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F2.2)", inf ! SIGN=PLUS
print "(ss,F2.2)", inf ! SIGN=SUPPRESS
print "(s, F2.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F3.2)", inf ! SIGN=PLUS
print "(ss,F3.2)", inf ! SIGN=SUPPRESS
print "(s, F3.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F4.2)", inf ! SIGN=PLUS
print "(ss,F4.2)", inf ! SIGN=SUPPRESS
print "(s, F4.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F5.2)", inf ! SIGN=PLUS
print "(ss,F5.2)", inf ! SIGN=SUPPRESS
print "(s, F5.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F6.2)", inf ! SIGN=PLUS
print "(ss,F6.2)", inf ! SIGN=SUPPRESS
print "(s, F6.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F7.2)", inf ! SIGN=PLUS
print "(ss,F7.2)", inf ! SIGN=SUPPRESS
print "(s, F7.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F8.2)", inf ! SIGN=PLUS
print "(ss,F8.2)", inf ! SIGN=SUPPRESS
print "(s, F8.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F9.2)", inf ! SIGN=PLUS
print "(ss,F9.2)", inf ! SIGN=SUPPRESS
print "(s, F9.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F10.2)", inf ! SIGN=PLUS
print "(ss,F10.2)", inf ! SIGN=SUPPRESS
print "(s, F10.2)", inf ! SIGN=PROCESSOR_DEFINED
print "(sp,F11.2)", inf ! SIGN=PLUS
print "(ss,F11.2)", inf ! SIGN=SUPPRESS
print "(s, F11.2)", inf ! SIGN=PROCESSOR_DEFINED
if (log(abs(inf)) < huge(inf)) print *, 49
if (log(abs(minf)) < huge(inf)) print *, 50
if (.not. isnan(nan)) print *, 51
write(str,"(sp,f10.2)") inf
if (adjustl(str) /= 4_"+Infinity") print *, 53, str
write(str,*) minf
if (adjustl(str) /= 4_"-Infinity") print *, 55
write(str,*) nan
if (adjustl(str) /= 4_"NaN") print *, 57
end program testnan