This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [patch, libgfortran] PR47434 Wrong field width for NaN with (F0.n) formatting
- From: Jack Howarth <howarth at bromo dot med dot uc dot edu>
- To: Jerry DeLisle <jvdelisle at frontier dot com>
- Cc: gfortran <fortran at gcc dot gnu dot org>, gcc patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 29 Jan 2011 10:10:58 -0500
- Subject: Re: [patch, libgfortran] PR47434 Wrong field width for NaN with (F0.n) formatting
- References: <4D43495C.5060207@frontier.com>
On Fri, Jan 28, 2011 at 02:55:24PM -0800, Jerry DeLisle wrote:
> 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,
This patch causes the regressions...
FAIL: gfortran.dg/nan_7.f90 -O0 (test for excess errors)
WARNING: gfortran.dg/nan_7.f90 -O0 compilation failed to produce executable
FAIL: gfortran.dg/nan_7.f90 -O1 (test for excess errors)
WARNING: gfortran.dg/nan_7.f90 -O1 compilation failed to produce executable
FAIL: gfortran.dg/nan_7.f90 -O2 (test for excess errors)
WARNING: gfortran.dg/nan_7.f90 -O2 compilation failed to produce executable
FAIL: gfortran.dg/nan_7.f90 -O3 -fomit-frame-pointer (test for excess errors)
WARNING: gfortran.dg/nan_7.f90 -O3 -fomit-frame-pointer compilation failed to produce executable
FAIL: gfortran.dg/nan_7.f90 -O3 -fomit-frame-pointer -funroll-loops (test for excess errors)
WARNING: gfortran.dg/nan_7.f90 -O3 -fomit-frame-pointer -funroll-loops compilation failed to produce executable
FAIL: gfortran.dg/nan_7.f90 -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions (test for excess errors)
WARNING: gfortran.dg/nan_7.f90 -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions compilation failed to produce executable
FAIL: gfortran.dg/nan_7.f90 -O3 -g (test for excess errors)
WARNING: gfortran.dg/nan_7.f90 -O3 -g compilation failed to produce executable
FAIL: gfortran.dg/nan_7.f90 -Os (test for excess errors)
WARNING: gfortran.dg/nan_7.f90 -Os compilation failed to produce executable
at -m32 and -m64 on x86_64-apple-darwin10. The failures are of the form...
/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/gcc/testsuite/gfortran/../../gfortran -B/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/gcc/testsuite/gfortran/../../ -B/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/x86_64-apple-darwin10.7.0/i386/libgfortran/ /sw/src/fink.build/gcc46-4.6.0-1000/gcc-4.6-20110128/gcc/testsuite/gfortran.dg/nan_7.f90 -O0 -pedantic-errors -B/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/x86_64-apple-darwin10.7.0/i386/libgfortran/.libs -L/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/x86_64-apple-darwin10.7.0/i386/libgfortran/.libs -L/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/x86_64-apple-darwin10.7.0/i386/libgfortran/.libs -B/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/x86_64-apple-darwin10.7.0/i386/libquadmath/.libs -L/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/x86_64-apple-darwin10.7.0/i386/libquadmath/.libs -L/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/x86_64-apple-darwin10.7.0/i386/libquadmath/.libs -L/sw/src/fink.build/gcc46-4.6.0-1000/darwin_objdir/x86_64-apple-darwin10.7.0/i386/libiberty -lm -m32 -o ./nan_7.exe
/sw/src/fink.build/gcc46-4.6.0-1000/gcc-4.6-20110128/gcc/testsuite/gfortran.dg/nan_7.f90:5.10:
integer(16) :: k1, k2
1
Error: Kind 16 not supported for type INTEGER at (1)
Jack
>
> 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