From patchwork Fri Jan 28 22:55:24 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 80903 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id EA0B5B7105 for ; Sat, 29 Jan 2011 09:54:34 +1100 (EST) Received: (qmail 16889 invoked by alias); 28 Jan 2011 22:54:31 -0000 Received: (qmail 16871 invoked by uid 22791); 28 Jan 2011 22:54:28 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_LOW, SPF_NEUTRAL, TW_CP X-Spam-Check-By: sourceware.org Received: from out03.roch.ny.frontiernet.net (HELO out03.roch.ny.frontiernet.net) (66.133.183.245) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 28 Jan 2011 22:54:22 +0000 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AvsEAF7XQk1Hc96T/2dsb2JhbACgG4RovHGDCoJFBIUY Received: from relay04.roch.ny.frontiernet.net ([66.133.182.167]) by out03.roch.ny.frontiernet.net with ESMTP; 28 Jan 2011 22:54:17 +0000 X-Previous-IP: 71.115.222.147 Received: from quava.localdomain (pool-71-115-222-147.spknwa.dsl-w.verizon.net [71.115.222.147]) by relay04.roch.ny.frontiernet.net (Postfix) with ESMTPA id A4E1818E2E8; Fri, 28 Jan 2011 22:54:15 +0000 (UTC) Message-ID: <4D43495C.5060207@frontier.com> Date: Fri, 28 Jan 2011 14:55:24 -0800 From: Jerry DeLisle User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.2.13) Gecko/20101209 Fedora/3.1.7-0.35.b3pre.fc14 Thunderbird/3.1.7 MIME-Version: 1.0 To: gfortran CC: gcc patches Subject: [patch, libgfortran] PR47434 Wrong field width for NaN with (F0.n) formatting Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 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: 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