Re: [patch, libgfortran] PR31052 Bad IOSTAT values when readings NAMELISTs past EOF

[Jerry DeLisle <jvdelisle at verizon dot net>]

Jerry DeLisle wrote:
:REVIEWMAIL:
> Here is a final installment with test case.  I eliminated the 
> test_endfile function.  Then I added a new function is_special () that 
> returns true if the special file bit is set in the stream structure.
The attached patch is identical to my first patch that fixed this bug but failed 
sixtrack in SPEC with the exception of the last hunk.

The last hunk adds the test for end file to st_read where it belongs.

Regression tested on x86-64 and SPEC tested by Seongbae Park.

Also tested with Harald Anlauf's new test case, modified and attached as well.

I want to especially thank Seongbae and Harald for their assistance testing and 
finding the test cases.

I hope this settles it with this bug. (humbly)

OK for Trunk?

Regards,

Jerry

2007-03-30  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

    PR libgfortran/31052
    * io/file_position (st_rewind): Remove use of
    test_endfile. Don't seek if already at 0 position.  Use new is_special
    function to set endfile state.
    * io/open.c (test_endfile): Delete this function.
    (edit_modes): Delete call to test_endfile.
    (new_unit): Likewise.
    * io/io.h: Delete prototype for test_endfile.  Add prototype
    for is_special.
    * io/transfer.c (next_record_r): Remove use of test_endfile.
    (st_read):  Add test for end file condition and adjust status.

Index: io/open.c
===================================================================
*** io/open.c	(revision 123355)
--- io/open.c	(working copy)
*************** static const st_option convert_opt[] =
*** 109,127 ****
    { NULL, 0}
  };
  
- /* Given a unit, test to see if the file is positioned at the terminal
-    point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
-    This prevents us from changing the state from AFTER_ENDFILE to
-    AT_ENDFILE.  */
- 
- void
- test_endfile (gfc_unit * u)
- {
-   if (u->endfile == NO_ENDFILE && file_length (u->s) == file_position (u->s))
-     u->endfile = AT_ENDFILE;
- }
- 
- 
  /* Change the modes of a file, those that are allowed * to be
     changed.  */
  
--- 109,114 ----
*************** edit_modes (st_parameter_open *opp, gfc_
*** 208,215 ****
  
        u->current_record = 0;
        u->last_record = 0;
- 
-       test_endfile (u);		/* We might be at the end.  */
        break;
  
      case POSITION_APPEND:
--- 195,200 ----
*************** new_unit (st_parameter_open *opp, gfc_un
*** 487,499 ****
    memmove (u->file, opp->file, opp->file_len);
    u->file_len = opp->file_len;
  
-   /* Curiously, the standard requires that the
-      position specifier be ignored for new files so a newly connected
-      file starts out at the initial point.  We still need to figure
-      out if the file is at the end or not.  */
- 
-   test_endfile (u);
- 
    if (flags->status == STATUS_SCRATCH && opp->file != NULL)
      free_mem (opp->file);
    return u;
--- 472,477 ----
Index: io/io.h
===================================================================
*** io/io.h	(revision 123355)
--- io/io.h	(working copy)
*************** internal_proto(unlock_unit);
*** 695,703 ****
  
  /* open.c */
  
- extern void test_endfile (gfc_unit *);
- internal_proto(test_endfile);
- 
  extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
  internal_proto(new_unit);
  
--- 695,700 ----
Index: io/transfer.c
===================================================================
*** io/transfer.c	(revision 123355)
--- io/transfer.c	(working copy)
*************** next_record_r (st_parameter_dt *dtp)
*** 2227,2236 ****
  
        break;
      }
- 
-   if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL
-       && !dtp->u.p.namelist_mode)
-     test_endfile (dtp->u.p.current_unit);
  }
  
  
--- 2227,2232 ----
*************** st_read (st_parameter_dt *dtp)
*** 2703,2708 ****
--- 2699,2707 ----
      switch (dtp->u.p.current_unit->endfile)
        {
        case NO_ENDFILE:
+ 	if (file_length (dtp->u.p.current_unit->s)
+ 	    == file_position (dtp->u.p.current_unit->s))
+ 	  dtp->u.p.current_unit->endfile = AT_ENDFILE;
  	break;
  
        case AT_ENDFILE:

! { dg-do run }
! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF.
! Patch derived from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
program gfcbug61
  implicit none
  integer, parameter :: nmlunit = 12    ! Namelist unit
  integer            :: stat

  open (nmlunit, file="gfcbug61a.nml", status='old', action="READ")

  ! The call to position_nml is contained in the subroutine
  rewind (nmlunit)
  call read_report (nmlunit, stat)
  rewind (nmlunit)
  call position_nml (nmlunit, 'MISSING', stat)
  rewind (nmlunit)
  call read_report (nmlunit, stat)              ! gfortran fails here

contains

  subroutine position_nml (unit, name, status)
    ! Check for presence of namelist 'name'
    integer                      :: unit, status
    character(len=*), intent(in) :: name

    character(len=255) :: line
    integer            :: ios, idx
    logical            :: first

    first = .true.
    status = 0
    do
       line = ""
       read (unit,'(a)',iostat=ios) line
       if (ios < 0) then
          ! EOF encountered!
          backspace (unit)
          status = -1
          return
       else if (ios > 0) then
          ! Error encountered!
          status = +1
          return
       end if
       idx = index (line, "&"//trim (name))
       if (idx > 0) then
          backspace (unit)
          return
       end if
    end do
  end subroutine position_nml

  subroutine read_report (unit, status)
    integer :: unit, status

    integer            :: iuse, ios
    !------------------
    ! Namelist 'REPORT'
    !------------------
    character(len=12) :: type
    namelist /REPORT/ type
    !-------------------------------------
    ! Loop to read namelist multiple times
    !-------------------------------------
    iuse = 0
    do
       !----------------------------------------
       ! Preset namelist variables with defaults
       !----------------------------------------
       type      = ''
       !--------------
       ! Read namelist
       !--------------
       call position_nml (unit, "REPORT", status)
       if (stat /= 0) then
          ios = status
	  if (iuse /= 2) call abort()
          return
       end if
       read (unit, nml=REPORT, iostat=ios)
       if (ios /= 0) exit
       iuse = iuse + 1
    end do
    status = ios
  end subroutine read_report

end program gfcbug61