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