This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [patch, libgfortran] PR31052 Bad IOSTAT values when readings NAMELISTs past EOF
:ADDPATCH fortran:
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.
To retain compatibility with g77 behavior and previous versions of gfortran, I
used this new function in st_rewind. The reason this is necessary is because a
read from /dev/null should always return EOF no matter what and if a user for
some reason does a rewind, we won't get the EOF because the following rewind
sets the NO_ENDFILE flag.
I have added some notes to identify where additional logic can be added for
special files in the future with rewind. We could, for example, generate a
diagnostic message.
I also cleaned up some comments and whitespace here and there.
Regression tested on x86-64-Gnu/Linux. New test case provided.
OK for trunk? and 4.2 after freeze and a little time for exercising on trunk?
Regards,
Jerry
2007-03-13 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/31052
* io/file_position (st_rewind): Fix comments. 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.
* io/io.h: Delete prototype for test_endfile. Add prototype
for is_special.
* io/unix.c (is_special): New function. Fix whitespace.
* io/transfer.c (next_record_r): Remove use of test_endfile.
Index: file_pos.c
===================================================================
*** file_pos.c (revision 122762)
--- file_pos.c (working copy)
*************** st_rewind (st_parameter_filepos *fpp)
*** 297,320 ****
else
{
/* Flush the buffers. If we have been writing to the file, the last
! written record is the last record in the file, so truncate the
! file now. Reset to read mode so two consecutive rewind
! statements do not delete the file contents. */
flush (u->s);
if (u->mode == WRITING && u->flags.access != ACCESS_STREAM)
struncate (u->s);
u->mode = READING;
u->last_record = 0;
! if (sseek (u->s, 0) == FAILURE)
generate_error (&fpp->common, ERROR_OS, NULL);
! u->endfile = NO_ENDFILE;
u->current_record = 0;
u->bytes_left = 0;
u->strm_pos = 1;
u->read_bad = 0;
- test_endfile (u);
}
/* Update position for INQUIRE. */
u->flags.position = POSITION_REWIND;
--- 297,332 ----
else
{
/* Flush the buffers. If we have been writing to the file, the last
! written record is the last record in the file, so truncate the
! file now. Reset to read mode so two consecutive rewind
! statements do not delete the file contents. */
flush (u->s);
if (u->mode == WRITING && u->flags.access != ACCESS_STREAM)
struncate (u->s);
u->mode = READING;
u->last_record = 0;
! if (file_position (u->s) != 0 && sseek (u->s, 0) == FAILURE)
generate_error (&fpp->common, ERROR_OS, NULL);
! /* Handle special files like /dev/null differently. */
! if (!is_special (u->s))
! {
! /* We are rewinding so we are not at the end. */
! u->endfile = NO_ENDFILE;
! }
! else
! {
! /* Set this for compatibilty with g77 for /dev/null. */
! if (file_length (u->s) == 0 && file_position (u->s) == 0)
! u->endfile = AT_ENDFILE;
! /* Future refinements on special files can go here. */
! }
!
u->current_record = 0;
u->bytes_left = 0;
u->strm_pos = 1;
u->read_bad = 0;
}
/* Update position for INQUIRE. */
u->flags.position = POSITION_REWIND;
Index: open.c
===================================================================
*** open.c (revision 122763)
--- 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
*** 486,498 ****
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 that 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;
--- 471,476 ----
Index: io.h
===================================================================
*** io.h (revision 122762)
--- io.h (working copy)
*************** internal_proto(file_position);
*** 622,627 ****
--- 622,630 ----
extern int is_seekable (stream *);
internal_proto(is_seekable);
+ extern int is_special (stream *);
+ internal_proto(is_special);
+
extern int is_preconnected (stream *);
internal_proto(is_preconnected);
*************** internal_proto(unlock_unit);
*** 691,699 ****
/* 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);
--- 694,699 ----
Index: unix.c
===================================================================
*** unix.c (revision 122762)
--- unix.c (working copy)
*************** file_length (stream * s)
*** 1872,1878 ****
/* file_position()-- Return the current position of the file */
gfc_offset
! file_position (stream * s)
{
return ((unix_stream *) s)->logical_offset;
}
--- 1872,1878 ----
/* file_position()-- Return the current position of the file */
gfc_offset
! file_position (stream *s)
{
return ((unix_stream *) s)->logical_offset;
}
*************** file_position (stream * s)
*** 1882,1894 ****
* it is not */
int
! is_seekable (stream * s)
{
/* By convention, if file_length == -1, the file is not
seekable. */
return ((unix_stream *) s)->file_length!=-1;
}
try
flush (stream *s)
{
--- 1882,1903 ----
* it is not */
int
! is_seekable (stream *s)
{
/* By convention, if file_length == -1, the file is not
seekable. */
return ((unix_stream *) s)->file_length!=-1;
}
+
+ /* is_special()-- Return nonzero if the stream is not a regular file. */
+
+ is_special (stream *s)
+ {
+ return ((unix_stream *) s)->special_file;
+ }
+
+
try
flush (stream *s)
{
Index: transfer.c
===================================================================
*** transfer.c (revision 122763)
--- transfer.c (working copy)
*************** next_record_r (st_parameter_dt *dtp)
*** 2217,2225 ****
break;
}
-
- if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
- test_endfile (dtp->u.p.current_unit);
}
--- 2217,2222 ----
*************** st_read (st_parameter_dt *dtp)
*** 2679,2688 ****
data_transfer_init (dtp, 1);
! /* Handle complications dealing with the endfile record. It is
! significant that this is the only place where ERROR_END is
! generated. Reading an end of file elsewhere is either end of
! record or an I/O error. */
if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
switch (dtp->u.p.current_unit->endfile)
--- 2676,2682 ----
data_transfer_init (dtp, 1);
! /* Handle complications dealing with the endfile record. */
if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
switch (dtp->u.p.current_unit->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 :: stat
open (12, status="scratch")
write (12, '(a)')"!================"
write (12, '(a)')"! Namelist REPORT"
write (12, '(a)')"!================"
write (12, '(a)')" &REPORT type = 'SYNOP' "
write (12, '(a)')" use = 'active'"
write (12, '(a)')" max_proc = 20"
write (12, '(a)')" /"
write (12, '(a)')"! Other namelists..."
write (12, '(a)')" &OTHER i = 1 /"
rewind (12)
! Read /REPORT/ the first time
rewind (12)
call position_nml (12, "REPORT", stat)
if (stat.ne.0) call abort()
if (stat == 0) call read_report (12, stat)
! Comment out the following lines to hide the bug
rewind (12)
call position_nml (12, "MISSING", stat)
if (stat.ne.-1) call abort ()
! Read /REPORT/ again
rewind (12)
call position_nml (12, "REPORT", stat)
if (stat.ne.0) call abort()
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
ios = 0
line = ""
do
read (unit,'(a)',iostat=ios) line
if (first) then
first = .false.
end if
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, use
integer :: max_proc
namelist /REPORT/ type, use, max_proc
!-------------------------------------
! Loop to read namelist multiple times
!-------------------------------------
iuse = 0
do
!----------------------------------------
! Preset namelist variables with defaults
!----------------------------------------
type = ''
use = ''
max_proc = -1
!--------------
! Read namelist
!--------------
read (unit, nml=REPORT, iostat=ios)
if (ios /= 0) exit
iuse = iuse + 1
end do
if (iuse.ne.1) call abort()
status = ios
end subroutine read_report
end program gfcbug61