Jerry DeLisle wrote:
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