gcc/testsuite/gfortran.dg/namelist_28.f90

   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>
   4 program 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
  22 contains
  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
  31     logical            :: first
  32
  33     first = .true.
  34     status = 0
  35     do
  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   end subroutine position_nml
  55
  56   subroutine read_report (unit, status)
  57     integer :: unit, status
  58
  59     integer            :: iuse, ios
  60     !------------------
  61     ! Namelist 'REPORT'
  62     !------------------
  63     character(len=12) :: type
  64     namelist /REPORT/ type
  65     !-------------------------------------
  66     ! Loop to read namelist multiple times
  67     !-------------------------------------
  68     iuse = 0
  69     do
  70        !----------------------------------------
  71        ! Preset namelist variables with defaults
  72        !----------------------------------------
  73        type      = ''
  74        !--------------
  75        ! Read namelist
  76        !--------------
  77        call position_nml (unit, "REPORT", status)
  78        if (stat /= 0) then
  79           ios = status
  80           if (iuse /= 2) call abort()
  81           return
  82        end if
  83        read (unit, nml=REPORT, iostat=ios)
  84        if (ios /= 0) exit
  85        iuse = iuse + 1
  86     end do
  87     status = ios
  88   end subroutine read_report
  89
  90 end program gfcbug61