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