! { dg-do run }
! PR70235 Incorrect output with PF format.
! Test case provided by Antoine Gardeux.
program pr70235
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, n_skip = 0
    character(len=20) :: s, s1

!   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, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
                                  real(9.49999905,kind=j(1)),  &
                                  real(9.5,kind=j(1)), real(8.5,kind=j(1))
        write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), &
                                       real(98765.0,kind=j(1))
      else if (i == 2) then
        write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
                                  real(9.49999905,kind=j(2)),  &
                                  real(9.5,kind=j(2)), real(8.5,kind=j(2))
        write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), &
                                       real(98765.0,kind=j(2))
      else if (i == 3) then
        write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
                                  real(9.49999905,kind=j(3)),  &
                                  real(9.5,kind=j(3)), real(8.5,kind=j(3))
        write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), &
                                       real(98765.0,kind=j(3))
      else if (i == 4) then
        write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
                                  real(9.49999905,kind=j(4)),  &
                                  real(9.5,kind=j(4)), real(8.5,kind=j(4))
        write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), &
                                       real(98765.0,kind=j(4))
      end if
      if (s /= '-9.5 9.5 10.  8.' .or. s1 /= ' 987.4E+03 98.76E+03') then
        l_skip(i) = .true.
!        print "('Unsupported rounding for real(',i0,')')", j(i)
      end if
    end do
        

! Original test.
    call checkfmt("(-6PF8.3)", 1.0e4,    "   0.010")
    call checkfmt("(-6PF8.3)",   0.0,    "   0.000")

! Test for the bug in comment 6.
    call checkfmt("(-8pf18.3)", 643.125, "             0.000")
    call checkfmt("(-7pf18.3)", 643.125, "             0.000")
    call checkfmt("(-6pf18.3)", 643.125, "             0.001")
    call checkfmt("(-5pf18.3)", 643.125, "             0.006")
    call checkfmt("(-4pf18.3)", 643.125, "             0.064")
    call checkfmt("(-3pf18.3)", 643.125, "             0.643")
    call checkfmt("(-2pf18.3)", 643.125, "             6.431")
    call checkfmt("(-1pf18.3)", 643.125, "            64.312")
    call checkfmt("( 0pf18.3)", 643.125, "           643.125")

    call checkfmt("(ru,-8pf18.3)", 643.125, "             0.001")
    call checkfmt("(ru,-7pf18.3)", 643.125, "             0.001")
    call checkfmt("(ru,-6pf18.3)", 643.125, "             0.001")
    call checkfmt("(ru,-5pf18.3)", 643.125, "             0.007")
    call checkfmt("(ru,-4pf18.3)", 643.125, "             0.065")
    call checkfmt("(ru,-3pf18.3)", 643.125, "             0.644")
    call checkfmt("(ru,-2pf18.3)", 643.125, "             6.432")
    call checkfmt("(ru,-1pf18.3)", 643.125, "            64.313")
    call checkfmt("(ru, 0pf18.3)", 643.125, "           643.125")

    call checkfmt("(rd,-8pf18.3)", 643.125, "             0.000")
    call checkfmt("(rd,-7pf18.3)", 643.125, "             0.000")
    call checkfmt("(rd,-6pf18.3)", 643.125, "             0.000")
    call checkfmt("(rd,-5pf18.3)", 643.125, "             0.006")
    call checkfmt("(rd,-4pf18.3)", 643.125, "             0.064")
    call checkfmt("(rd,-3pf18.3)", 643.125, "             0.643")
    call checkfmt("(rd,-2pf18.3)", 643.125, "             6.431")
    call checkfmt("(rd,-1pf18.3)", 643.125, "            64.312")
    call checkfmt("(rd, 0pf18.3)", 643.125, "           643.125")

    call checkfmt("(rz,-8pf18.3)", 643.125, "             0.000")
    call checkfmt("(rz,-7pf18.3)", 643.125, "             0.000")
    call checkfmt("(rz,-6pf18.3)", 643.125, "             0.000")
    call checkfmt("(rz,-5pf18.3)", 643.125, "             0.006")
    call checkfmt("(rz,-4pf18.3)", 643.125, "             0.064")
    call checkfmt("(rz,-3pf18.3)", 643.125, "             0.643")
    call checkfmt("(rz,-2pf18.3)", 643.125, "             6.431")
    call checkfmt("(rz,-1pf18.3)", 643.125, "            64.312")
    call checkfmt("(rz, 0pf18.3)", 643.125, "           643.125")

    call checkfmt("(rc,-8pf18.3)", 643.125, "             0.000")
    call checkfmt("(rc,-7pf18.3)", 643.125, "             0.000")
    call checkfmt("(rc,-6pf18.3)", 643.125, "             0.001")
    call checkfmt("(rc,-5pf18.3)", 643.125, "             0.006")
    call checkfmt("(rc,-4pf18.3)", 643.125, "             0.064")
    call checkfmt("(rc,-3pf18.3)", 643.125, "             0.643")
    call checkfmt("(rc,-2pf18.3)", 643.125, "             6.431")
    call checkfmt("(rc,-1pf18.3)", 643.125, "            64.313")
    call checkfmt("(rc, 0pf18.3)", 643.125, "           643.125")

    call checkfmt("(rn,-8pf18.3)", 643.125, "             0.000")
    call checkfmt("(rn,-7pf18.3)", 643.125, "             0.000")
    call checkfmt("(rn,-6pf18.3)", 643.125, "             0.001")
    call checkfmt("(rn,-5pf18.3)", 643.125, "             0.006")
    call checkfmt("(rn,-4pf18.3)", 643.125, "             0.064")
    call checkfmt("(rn,-3pf18.3)", 643.125, "             0.643")
    call checkfmt("(rn,-2pf18.3)", 643.125, "             6.431")
    call checkfmt("(rn,-1pf18.3)", 643.125, "            64.312")
    call checkfmt("(rn, 0pf18.3)", 643.125, "           643.125")

    call checkfmt("(rp,-8pf18.3)", 643.125, "             0.000")
    call checkfmt("(rp,-7pf18.3)", 643.125, "             0.000")
    call checkfmt("(rp,-6pf18.3)", 643.125, "             0.001")
    call checkfmt("(rp,-5pf18.3)", 643.125, "             0.006")
    call checkfmt("(rp,-4pf18.3)", 643.125, "             0.064")
    call checkfmt("(rp,-3pf18.3)", 643.125, "             0.643")
    call checkfmt("(rp,-2pf18.3)", 643.125, "             6.431")
    call checkfmt("(rp,-1pf18.3)", 643.125, "            64.312")
    call checkfmt("(rp, 0pf18.3)", 643.125, "           643.125")

    call checkfmt("(-8pf18.3)", -643.125, "            -0.000")
    call checkfmt("(-7pf18.3)", -643.125, "            -0.000")
    call checkfmt("(-6pf18.3)", -643.125, "            -0.001")
    call checkfmt("(-5pf18.3)", -643.125, "            -0.006")
    call checkfmt("(-4pf18.3)", -643.125, "            -0.064")
    call checkfmt("(-3pf18.3)", -643.125, "            -0.643")
    call checkfmt("(-2pf18.3)", -643.125, "            -6.431")
    call checkfmt("(-1pf18.3)", -643.125, "           -64.312")
    call checkfmt("( 0pf18.3)", -643.125, "          -643.125")

    call checkfmt("(ru,-8pf18.3)", -643.125, "            -0.000")
    call checkfmt("(ru,-7pf18.3)", -643.125, "            -0.000")
    call checkfmt("(ru,-6pf18.3)", -643.125, "            -0.000")
    call checkfmt("(ru,-5pf18.3)", -643.125, "            -0.006")
    call checkfmt("(ru,-4pf18.3)", -643.125, "            -0.064")
    call checkfmt("(ru,-3pf18.3)", -643.125, "            -0.643")
    call checkfmt("(ru,-2pf18.3)", -643.125, "            -6.431")
    call checkfmt("(ru,-1pf18.3)", -643.125, "           -64.312")
    call checkfmt("(ru, 0pf18.3)", -643.125, "          -643.125")

    call checkfmt("(rd,-8pf18.3)", -643.125, "            -0.001")
    call checkfmt("(rd,-7pf18.3)", -643.125, "            -0.001")
    call checkfmt("(rd,-6pf18.3)", -643.125, "            -0.001")
    call checkfmt("(rd,-5pf18.3)", -643.125, "            -0.007")
    call checkfmt("(rd,-4pf18.3)", -643.125, "            -0.065")
    call checkfmt("(rd,-3pf18.3)", -643.125, "            -0.644")
    call checkfmt("(rd,-2pf18.3)", -643.125, "            -6.432")
    call checkfmt("(rd,-1pf18.3)", -643.125, "           -64.313")
    call checkfmt("(rd, 0pf18.3)", -643.125, "          -643.125")

    call checkfmt("(rz,-8pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rz,-7pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rz,-6pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rz,-5pf18.3)", -643.125, "            -0.006")
    call checkfmt("(rz,-4pf18.3)", -643.125, "            -0.064")
    call checkfmt("(rz,-3pf18.3)", -643.125, "            -0.643")
    call checkfmt("(rz,-2pf18.3)", -643.125, "            -6.431")
    call checkfmt("(rz,-1pf18.3)", -643.125, "           -64.312")
    call checkfmt("(rz, 0pf18.3)", -643.125, "          -643.125")

    call checkfmt("(rc,-8pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rc,-7pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rc,-6pf18.3)", -643.125, "            -0.001")
    call checkfmt("(rc,-5pf18.3)", -643.125, "            -0.006")
    call checkfmt("(rc,-4pf18.3)", -643.125, "            -0.064")
    call checkfmt("(rc,-3pf18.3)", -643.125, "            -0.643")
    call checkfmt("(rc,-2pf18.3)", -643.125, "            -6.431")
    call checkfmt("(rc,-1pf18.3)", -643.125, "           -64.313")
    call checkfmt("(rc, 0pf18.3)", -643.125, "          -643.125")

    call checkfmt("(rn,-8pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rn,-7pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rn,-6pf18.3)", -643.125, "            -0.001")
    call checkfmt("(rn,-5pf18.3)", -643.125, "            -0.006")
    call checkfmt("(rn,-4pf18.3)", -643.125, "            -0.064")
    call checkfmt("(rn,-3pf18.3)", -643.125, "            -0.643")
    call checkfmt("(rn,-2pf18.3)", -643.125, "            -6.431")
    call checkfmt("(rn,-1pf18.3)", -643.125, "           -64.312")
    call checkfmt("(rn, 0pf18.3)", -643.125, "          -643.125")

    call checkfmt("(rp,-8pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rp,-7pf18.3)", -643.125, "            -0.000")
    call checkfmt("(rp,-6pf18.3)", -643.125, "            -0.001")
    call checkfmt("(rp,-5pf18.3)", -643.125, "            -0.006")
    call checkfmt("(rp,-4pf18.3)", -643.125, "            -0.064")
    call checkfmt("(rp,-3pf18.3)", -643.125, "            -0.643")
    call checkfmt("(rp,-2pf18.3)", -643.125, "            -6.431")
    call checkfmt("(rp,-1pf18.3)", -643.125, "           -64.312")
    call checkfmt("(rp, 0pf18.3)", -643.125, "          -643.125")

    ! print *, n_tst, n_cnt, n_skip
    if (n_cnt /= 0) STOP 1
    if (all(.not. l_skip)) print *, "All kinds rounded to nearest"

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 (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
            if (l_skip(i)) then
              n_skip = n_skip + 1
            else
              print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
              n_cnt = n_cnt + 1
            end if
          end if
        end do
        
    end subroutine
end program
! { dg-output "All kinds rounded to nearest" { xfail { hppa*-*-hpux* } } }