[Bug fortran/60128] [4.8/4.9 Regression] Wrong ouput using en edit descriptor

["dominiq at lps dot ens.fr" <gcc-bugzilla@gcc.gnu.org>]

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 } }