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            :: stat
7
8  open (12, status="scratch")
9  write (12, '(a)')"!================"
10  write (12, '(a)')"! Namelist REPORT"
11  write (12, '(a)')"!================"
12  write (12, '(a)')" &REPORT type     = 'SYNOP' "
13  write (12, '(a)')"         use      = 'active'"
14  write (12, '(a)')"         max_proc = 20"
15  write (12, '(a)')" /"
16  write (12, '(a)')"! Other namelists..."
17  write (12, '(a)')" &OTHER  i = 1 /"
18  rewind (12)
19
20  ! Read /REPORT/ the first time
21  rewind (12)
22  call position_nml (12, "REPORT", stat)
23  if (stat.ne.0) call abort()
24  if (stat == 0)  call read_report (12, stat)
25
26  ! Comment out the following lines to hide the bug
27  rewind (12)
28  call position_nml (12, "MISSING", stat)
29  if (stat.ne.-1)  call abort ()
30
31  ! Read /REPORT/ again
32  rewind (12)
33  call position_nml (12, "REPORT", stat)
34  if (stat.ne.0)  call abort()
35
36contains
37
38  subroutine position_nml (unit, name, status)
39    ! Check for presence of namelist 'name'
40    integer                      :: unit, status
41    character(len=*), intent(in) :: name
42
43    character(len=255) :: line
44    integer            :: ios, idx, k
45    logical            :: first
46
47    first = .true.
48    status = 0
49    ios = 0
50    line = ""
51    do k=1,10
52       read (unit,'(a)',iostat=ios) line
53       if (first) then
54          first = .false.
55       end if
56       if (ios < 0) then
57          ! EOF encountered!
58          backspace (unit)
59          status = -1
60          return
61       else if (ios > 0) then
62          ! Error encountered!
63          status = +1
64          return
65       end if
66       idx = index (line, "&"//trim (name))
67       if (idx > 0) then
68          backspace (unit)
69          return
70       end if
71    end do
72  end subroutine position_nml
73
74  subroutine read_report (unit, status)
75    integer :: unit, status
76
77    integer            :: iuse, ios, k
78    !------------------
79    ! Namelist 'REPORT'
80    !------------------
81    character(len=12) :: type, use
82    integer           :: max_proc
83    namelist /REPORT/ type, use, max_proc
84    !-------------------------------------
85    ! Loop to read namelist multiple times
86    !-------------------------------------
87    iuse = 0
88    do k=1,5
89       !----------------------------------------
90       ! Preset namelist variables with defaults
91       !----------------------------------------
92       type      = ''
93       use       = ''
94       max_proc  = -1
95       !--------------
96       ! Read namelist
97       !--------------
98       read (unit, nml=REPORT, iostat=ios)
99       if (ios /= 0) exit
100       iuse = iuse + 1
101    end do
102    if (iuse.ne.1) call abort()
103    status = ios
104  end subroutine read_report
105
106end program gfcbug61
107