! { dg-do run } ! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF. ! Patch derived from PR, submitted by Jerry DeLisle program gfcbug61 implicit none integer, parameter :: nmlunit = 12 ! Namelist unit integer :: stat open (nmlunit, status="scratch") write(nmlunit, '(a)') "&REPORT type='report1' /" write(nmlunit, '(a)') "&REPORT type='report2' /" write(nmlunit, '(a)') "!" rewind (nmlunit) ! The call to position_nml is contained in the subroutine call read_report (nmlunit, stat) rewind (nmlunit) call position_nml (nmlunit, 'MISSING', stat) rewind (nmlunit) call read_report (nmlunit, stat) ! gfortran fails here contains subroutine position_nml (unit, name, status) ! Check for presence of namelist 'name' integer :: unit, status character(len=*), intent(in) :: name character(len=255) :: line integer :: ios, idx, k logical :: first first = .true. status = 0 do k=1,25 line = "" read (unit,'(a)',iostat=ios) line if (ios < 0) then ! EOF encountered! backspace (unit) status = -1 return else if (ios > 0) then ! Error encountered! status = +1 return end if idx = index (line, "&"//trim (name)) if (idx > 0) then backspace (unit) return end if end do if (k.gt.10) call abort end subroutine position_nml subroutine read_report (unit, status) integer :: unit, status integer :: iuse, ios, k !------------------ ! Namelist 'REPORT' !------------------ character(len=12) :: type namelist /REPORT/ type !------------------------------------- ! Loop to read namelist multiple times !------------------------------------- iuse = 0 do k=1,25 !---------------------------------------- ! Preset namelist variables with defaults !---------------------------------------- type = '' !-------------- ! Read namelist !-------------- call position_nml (unit, "REPORT", status) if (stat /= 0) then ios = status if (iuse /= 2) call abort() return end if read (unit, nml=REPORT, iostat=ios) if (ios /= 0) exit iuse = iuse + 1 end do if (k.gt.10) call abort status = ios end subroutine read_report end program gfcbug61