From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <gcc-bugs-return-447639-listarch-gcc-bugs=gcc.gnu.org@gcc.gnu.org>
Received: (qmail 27620 invoked by alias); 27 Mar 2014 15:00:16 -0000
Mailing-List: contact gcc-bugs-help@gcc.gnu.org; run by ezmlm
Precedence: bulk
List-Id: <gcc-bugs.gcc.gnu.org>
List-Archive: <http://gcc.gnu.org/ml/gcc-bugs/>
List-Post: <mailto:gcc-bugs@gcc.gnu.org>
List-Help: <mailto:gcc-bugs-help@gcc.gnu.org>
Sender: gcc-bugs-owner@gcc.gnu.org
Received: (qmail 27200 invoked by uid 48); 27 Mar 2014 15:00:11 -0000
From: "dominiq at lps dot ens.fr" <gcc-bugzilla@gcc.gnu.org>
To: gcc-bugs@gcc.gnu.org
Subject: [Bug fortran/60128] [4.8/4.9 Regression] Wrong ouput using en edit descriptor
Date: Thu, 27 Mar 2014 15:00:00 -0000
X-Bugzilla-Reason: CC
X-Bugzilla-Type: changed
X-Bugzilla-Watch-Reason: None
X-Bugzilla-Product: gcc
X-Bugzilla-Component: fortran
X-Bugzilla-Version: 4.8.1
X-Bugzilla-Keywords:
X-Bugzilla-Severity: normal
X-Bugzilla-Who: dominiq at lps dot ens.fr
X-Bugzilla-Status: REOPENED
X-Bugzilla-Priority: P4
X-Bugzilla-Assigned-To: unassigned at gcc dot gnu.org
X-Bugzilla-Target-Milestone: 4.8.3
X-Bugzilla-Flags:
X-Bugzilla-Changed-Fields:
Message-ID: <bug-60128-4-c3arClbMCG@http.gcc.gnu.org/bugzilla/>
In-Reply-To: <bug-60128-4@http.gcc.gnu.org/bugzilla/>
References: <bug-60128-4@http.gcc.gnu.org/bugzilla/>
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: 7bit
X-Bugzilla-URL: http://gcc.gnu.org/bugzilla/
Auto-Submitted: auto-generated
MIME-Version: 1.0
X-SW-Source: 2014-03/txt/msg02508.txt.bz2

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

--- Comment #53 from Dominique d'Humieres <dominiq at lps dot ens.fr> ---
Dave, Rainer,

Could you test the following code?


[karma] f90/bug% cat fmt_en_1.f90
! { dg-do run }
! PR60128 Invalid outputs with EN descriptors
! Test case provided by Walt Brainerd.
program pr60128
use ISO_FORTRAN_ENV
    implicit none
    integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
    logical :: l_skip(4) = .false.
    integer :: i
    integer :: n_tst = 0, n_cnt = 0
    character(len=20) :: s

    open (unit = 10, file = 'fmt_en.res')
!   Check that the default rounding mode is to nearest and to even on tie.
    do i=1,size(real_kinds)
      if (i == 1) then
        write(s, '(2(1PE9.1))') real(9950.0,kind=j(1)), &
                                real(9750.0,kind=j(1))
      else if (i == 2) then
        write(s, '(2(1PE9.1))') real(9950.0,kind=j(2)), &
                                real(9750.0,kind=j(2))
      else if (i == 3) then
        write(s, '(2(1PE9.1))') real(9950.0,kind=j(3)), &
                                real(9750.0,kind=j(3))
      else if (i == 4) then
        write(s, '(2(1PE9.1))') real(9950.0,kind=j(4)), &
                                real(9750.0,kind=j(4))
      end if
      if (s /= '  1.0E+04  9.8E+03') then
        l_skip(i) = .true.
        print "('Unsupported rounding for real(',i0,')')", j(i)
        write (10, "('Unsupported rounding for real(',i0,')')") j(i)
      end if
    end do

    call checkfmt("(en15.0)", 9500.0,     "        10.E+03")
    call checkfmt("(en15.1)", 9950.0,     "       10.0E+03")
    call checkfmt("(en15.0)", -9500.0,     "       -10.E+03")
    call checkfmt("(en15.1)", -9950.0,     "      -10.0E+03")
    call checkfmt("(en15.1)", 987350.,     "      987.4E+03")
    call checkfmt("(en15.2)", 98765.,      "      98.76E+03")
    call checkfmt("(en15.1)", -987350.,     "     -987.4E+03")
    call checkfmt("(en15.2)", -98765.,      "     -98.76E+03")

    print *, n_tst, n_cnt
    if (n_cnt /= 0) call abort

contains
    subroutine checkfmt(fmt, x, cmp)
        implicit none
        integer :: i
        character(len=*), intent(in) :: fmt
        real, intent(in) :: x
        character(len=*), intent(in) :: cmp
        do i=1,size(real_kinds)
          if (l_skip(i)) cycle
          if (i == 1) then
            write(s, fmt) real(x,kind=j(1))
          else if (i == 2) then
            write(s, fmt) real(x,kind=j(2))
          else if (i == 3) then
            write(s, fmt) real(x,kind=j(3))
          else if (i == 4) then
            write(s, fmt) real(x,kind=j(4))
          end if
          n_tst = n_tst + 1
          if (s /= cmp) then
             print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
             n_cnt = n_cnt + 1
           end if
        end do

    end subroutine
end program
! { dg-final { scan-file-not fmt_en.res "Unsupported rounding" { xfail {
i?86-*-solaris2.9* hppa*-*-hpux11* } } } }
! { dg-final { cleanup-saved-temps } }