1! { dg-do run }
2! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF.
3! Patch derived from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
4program gfcbug61
5  implicit none
6  integer, parameter :: nmlunit = 12    ! Namelist unit
7  integer            :: stat
8
9  open (nmlunit, status="scratch")
10  write(nmlunit, '(a)') "&REPORT type='report1' /"
11  write(nmlunit, '(a)') "&REPORT type='report2' /"
12  write(nmlunit, '(a)') "!"
13  rewind (nmlunit)
14
15! The call to position_nml is contained in the subroutine
16  call read_report (nmlunit, stat)
17  rewind (nmlunit)
18  call position_nml (nmlunit, 'MISSING', stat)
19  rewind (nmlunit)
20  call read_report (nmlunit, stat)              ! gfortran fails here
21
22contains
23
24  subroutine position_nml (unit, name, status)
25    ! Check for presence of namelist 'name'
26    integer                      :: unit, status
27    character(len=*), intent(in) :: name
28
29    character(len=255) :: line
30    integer            :: ios, idx, k
31    logical            :: first
32
33    first = .true.
34    status = 0
35    do k=1,25
36       line = ""
37       read (unit,'(a)',iostat=ios) line
38       if (ios < 0) then
39          ! EOF encountered!
40          backspace (unit)
41          status = -1
42          return
43       else if (ios > 0) then
44          ! Error encountered!
45          status = +1
46          return
47       end if
48       idx = index (line, "&"//trim (name))
49       if (idx > 0) then
50          backspace (unit)
51          return
52       end if
53    end do
54    if (k.gt.10) call abort
55  end subroutine position_nml
56
57  subroutine read_report (unit, status)
58    integer :: unit, status
59
60    integer            :: iuse, ios, k
61    !------------------
62    ! Namelist 'REPORT'
63    !------------------
64    character(len=12) :: type
65    namelist /REPORT/ type
66    !-------------------------------------
67    ! Loop to read namelist multiple times
68    !-------------------------------------
69    iuse = 0
70    do k=1,25
71       !----------------------------------------
72       ! Preset namelist variables with defaults
73       !----------------------------------------
74       type      = ''
75       !--------------
76       ! Read namelist
77       !--------------
78       call position_nml (unit, "REPORT", status)
79       if (stat /= 0) then
80          ios = status
81          if (iuse /= 2) call abort()
82          return
83       end if
84       read (unit, nml=REPORT, iostat=ios)
85       if (ios /= 0) exit
86       iuse = iuse + 1
87    end do
88    if (k.gt.10) call abort
89    status = ios
90  end subroutine read_report
91
92end program gfcbug61
93