From 108bc19009355ab635eb01262cb9e66a8f3e29c4 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Thu, 13 Dec 2007 19:35:09 +0000 Subject: [PATCH] re PR libfortran/34370 (file positioning after nonadvancing i/o) 2007-12-13 Thomas Koenig PR libfortran/34370 PR libfortran/34323 PR libfortran/34405 * io/io.h: Add previous_nonadvancing_write to gfc_unit. Add prototype for finish_last_advance_record. * io/file_pos.c (st_backspace): Generate error if backspace is attempted for direct access or unformatted stream. If there are bytes left from a previous ADVANCE="no", write them out before performing the backspace. (st_endfile): Generate error if endfile is attempted for direct access. If there are bytes left from a previous ADVANCE="no", write them out before performing the endfile. (st_rewind): Generate error if rewind is attempted for direct access. * unit.c (close_unit_1): Move functionality to write previously written bytes to... (finish_last_advance_record): ... here. * transfer.c (data_transfer_init): If reading, reset previous_nonadvancing_write. (finalize_transfer): Set the previous_noadvancing_write flag if we are writing and ADVANCE="no" was specified. Only call next_record() if advance="no" wasn't specified. 2007-12-13 Thomas Koenig PR libfortran/34370 PR libfortran/34323 PR libfortran/34405 * gfortran.dg/advance_6.f90: New test case. * gfortran.dg/direct_io_7.f90: New test case. * gfortran.dg/streamio_13.f90: New test case. From-SVN: r130912 --- gcc/testsuite/ChangeLog | 9 +++ gcc/testsuite/gfortran.dg/advance_6.f90 | 76 +++++++++++++++++++++++ gcc/testsuite/gfortran.dg/direct_io_7.f90 | 31 +++++++++ gcc/testsuite/gfortran.dg/streamio_13.f90 | 15 +++++ libgfortran/ChangeLog | 26 ++++++++ libgfortran/io/file_pos.c | 54 ++++++++++++++-- libgfortran/io/io.h | 6 +- libgfortran/io/transfer.c | 9 ++- libgfortran/io/unit.c | 47 +++++++------- 9 files changed, 245 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/advance_6.f90 create mode 100644 gcc/testsuite/gfortran.dg/direct_io_7.f90 create mode 100644 gcc/testsuite/gfortran.dg/streamio_13.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fc932025527..da2f7a573a4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2007-12-13 Thomas Koenig + + PR libfortran/34370 + PR libfortran/34323 + PR libfortran/34405 + * gfortran.dg/advance_6.f90: New test case. + * gfortran.dg/direct_io_7.f90: New test case. + * gfortran.dg/streamio_13.f90: New test case. + 2007-12-13 Douglas Gregor * g++.dg/cpp0x/__func__.C: New. diff --git a/gcc/testsuite/gfortran.dg/advance_6.f90 b/gcc/testsuite/gfortran.dg/advance_6.f90 new file mode 100644 index 00000000000..f1967b014ba --- /dev/null +++ b/gcc/testsuite/gfortran.dg/advance_6.f90 @@ -0,0 +1,76 @@ +! { dg-do run } +! PR 34370 - file positioning after non-advancing I/O didn't add +! a record marker. + +program main + implicit none + character(len=3) :: c + character(len=80), parameter :: fname = "advance_backspace_1.dat" + + call write_file + close (95) + call check_end_record + + call write_file + backspace 95 + c = 'xxx' + read (95,'(A)') c + if (c /= 'ab ') call abort + close (95) + call check_end_record + + call write_file + backspace 95 + close (95) + call check_end_record + + call write_file + endfile 95 + close (95) + call check_end_record + + call write_file + endfile 95 + rewind 95 + c = 'xxx' + read (95,'(A)') c + if (c /= 'ab ') call abort + close (95) + call check_end_record + + call write_file + rewind 95 + c = 'xxx' + read (95,'(A)') c + if (c /= 'ab ') call abort + close (95) + call check_end_record + +contains + + subroutine write_file + open(95, file=fname, status="replace", form="formatted") + write (95, '(A)', advance="no") 'a' + write (95, '(A)', advance="no") 'b' + end subroutine write_file + +! Checks for correct end record, then deletes the file. + + subroutine check_end_record + character(len=1) :: x + open(2003, file=fname, status="old", access="stream", form="unformatted") + read(2003) x + if (x /= 'a') call abort + read(2003) x + if (x /= 'b') call abort + read(2003) x + if (x /= achar(10)) then + read(2003) x + if (x /= achar(13)) then + else + call abort + end if + end if + close(2003,status="delete") + end subroutine check_end_record +end program main diff --git a/gcc/testsuite/gfortran.dg/direct_io_7.f90 b/gcc/testsuite/gfortran.dg/direct_io_7.f90 new file mode 100644 index 00000000000..ff116b0a109 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/direct_io_7.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! PR 34405 - direct access prohibits ENDFILE, BACKSPACE and REWIND +program test + implicit none + integer :: ios + character(len=80) :: msg + open (95, access="direct", recl=4, status="scratch") + write (95,rec=1) 'abcd' + + ios = 0 + msg = " " + backspace (95,iostat=ios,iomsg=msg) + if (ios == 0 .or. & + msg /= "Cannot BACKSPACE a file opened for DIRECT access") call abort + + ios = 0 + msg = " " + endfile (95,iostat=ios,iomsg=msg) + if (ios == 0 .or. & + msg /= "Cannot perform ENDFILE on a file opened for DIRECT access") & + call abort + + ios = 0 + msg = " " + rewind (95,iostat=ios,iomsg=msg) + if (ios == 0 .or. & + msg /= "Cannot REWIND a file opened for DIRECT access ") call abort + + close (95) +end program test + diff --git a/gcc/testsuite/gfortran.dg/streamio_13.f90 b/gcc/testsuite/gfortran.dg/streamio_13.f90 new file mode 100644 index 00000000000..e37535b7b6b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/streamio_13.f90 @@ -0,0 +1,15 @@ +! { dg-do run } +! PR 34405 - BACKSPACE for unformatted stream files is prohibited. +program main + implicit none + integer :: ios + character(len=80) :: msg + open(2003,form="unformatted",access="stream",status="scratch") + write (2003) 1 + write (2003) 2 + ios = 0 + msg = ' ' + backspace (2003,iostat=ios,iomsg=msg) + if (ios == 0 .or. msg /="Cannot BACKSPACE an unformatted stream file") & + call abort +end program main diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 12969af81d8..d9706df3ab1 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,29 @@ +2007-12-13 Thomas Koenig + + PR libfortran/34370 + PR libfortran/34323 + PR libfortran/34405 + * io/io.h: Add previous_nonadvancing_write to gfc_unit. + Add prototype for finish_last_advance_record. + * io/file_pos.c (st_backspace): Generate error if backspace is + attempted for direct access or unformatted stream. + If there are bytes left from a previous ADVANCE="no", write + them out before performing the backspace. + (st_endfile): Generate error if endfile is attempted for + direct access. + If there are bytes left from a previous ADVANCE="no", write + them out before performing the endfile. + (st_rewind): Generate error if rewind is attempted for + direct access. + * unit.c (close_unit_1): Move functionality to write + previously written bytes to... + (finish_last_advance_record): ... here. + * transfer.c (data_transfer_init): If reading, reset + previous_nonadvancing_write. + (finalize_transfer): Set the previous_noadvancing_write + flag if we are writing and ADVANCE="no" was specified. + Only call next_record() if advance="no" wasn't specified. + 2007-12-13 Tobias Burnus PR fortran/34427 diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 96e5e243787..94e29899fb1 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -199,12 +199,22 @@ st_backspace (st_parameter_filepos *fpp) goto done; } - /* Ignore direct access. Non-advancing I/O is only allowed for formatted - sequential I/O and the next direct access transfer repositions the file - anyway. */ + /* Direct access is prohibited, and so is unformatted stream access. */ - if (u->flags.access == ACCESS_DIRECT || u->flags.access == ACCESS_STREAM) - goto done; + + if (u->flags.access == ACCESS_DIRECT) + { + generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, + "Cannot BACKSPACE a file opened for DIRECT access"); + goto done; + } + + if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED) + { + generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, + "Cannot BACKSPACE an unformatted stream file"); + goto done; + } /* Check for special cases involving the ENDFILE record first. */ @@ -224,6 +234,15 @@ st_backspace (st_parameter_filepos *fpp) if (u->mode == WRITING) { + /* If there are previously written bytes from a write with + ADVANCE="no", add a record marker before performing the + BACKSPACE. */ + + if (u->previous_nonadvancing_write) + finish_last_advance_record (u); + + u->previous_nonadvancing_write = 0; + flush (u->s); struncate (u->s); u->mode = READING; @@ -261,6 +280,22 @@ st_endfile (st_parameter_filepos *fpp) u = find_unit (fpp->common.unit); if (u != NULL) { + if (u->flags.access == ACCESS_DIRECT) + { + generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, + "Cannot perform ENDFILE on a file opened" + " for DIRECT access"); + goto done; + } + + /* If there are previously written bytes from a write with ADVANCE="no", + add a record marker before performing the ENDFILE. */ + + if (u->previous_nonadvancing_write) + finish_last_advance_record (u); + + u->previous_nonadvancing_write = 0; + if (u->current_record) { st_parameter_dt dtp; @@ -274,6 +309,7 @@ st_endfile (st_parameter_filepos *fpp) struncate (u->s); u->endfile = AFTER_ENDFILE; update_position (u); + done: unlock_unit (u); } @@ -299,6 +335,14 @@ st_rewind (st_parameter_filepos *fpp) "Cannot REWIND a file opened for DIRECT access"); else { + /* If there are previously written bytes from a write with ADVANCE="no", + add a record marker before performing the ENDFILE. */ + + if (u->previous_nonadvancing_write) + finish_last_advance_record (u); + + u->previous_nonadvancing_write = 0; + /* 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 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 602f7b19b13..688a9cbbdc8 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -451,7 +451,8 @@ typedef struct gfc_unit struct gfc_unit *left, *right; int priority; - int read_bad, current_record, saved_pos; + int read_bad, current_record, saved_pos, previous_nonadvancing_write; + enum { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } endfile; @@ -692,6 +693,9 @@ internal_proto(unlock_unit); extern void update_position (gfc_unit *); internal_proto(update_position); +extern void finish_last_advance_record (gfc_unit *u); +internal_proto (finish_last_advance_record); + /* open.c */ extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 05711a06015..5dddcd31481 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1891,6 +1891,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (read_flag) { + dtp->u.p.current_unit->previous_nonadvancing_write = 0; + if ((cf & IOPARM_EOR) != 0 && dtp->u.p.advance_status != ADVANCE_NO) { generate_error (&dtp->common, LIBERROR_MISSING_OPTION, @@ -2644,9 +2646,14 @@ finalize_transfer (st_parameter_dt *dtp) return; } + if (dtp->u.p.mode == WRITING) + dtp->u.p.current_unit->previous_nonadvancing_write + = dtp->u.p.advance_status == ADVANCE_NO; + if (is_stream_io (dtp)) { - if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED) + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED + && dtp->u.p.advance_status != ADVANCE_NO) next_record (dtp, 1); if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index a293baba077..b81f4cce4d8 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -581,27 +581,8 @@ close_unit_1 (gfc_unit *u, int locked) /* If there are previously written bytes from a write with ADVANCE="no" Reposition the buffer before closing. */ - if (u->saved_pos > 0) - { - char *p; - - p = salloc_w (u->s, &u->saved_pos); - - if (!(u->unit_number == options.stdout_unit - || u->unit_number == options.stderr_unit)) - { - size_t len; - - const char crlf[] = "\r\n"; -#ifdef HAVE_CRLF - len = 2; -#else - len = 1; -#endif - if (swrite (u->s, &crlf[2-len], &len) != 0) - os_error ("Close after ADVANCE_NO failed"); - } - } + if (u->previous_nonadvancing_write) + finish_last_advance_record (u); rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE; @@ -718,3 +699,27 @@ filename_from_unit (int n) return (char *) NULL; } +void +finish_last_advance_record (gfc_unit *u) +{ + char *p; + + if (u->saved_pos > 0) + p = salloc_w (u->s, &u->saved_pos); + + if (!(u->unit_number == options.stdout_unit + || u->unit_number == options.stderr_unit)) + { + size_t len; + + const char crlf[] = "\r\n"; +#ifdef HAVE_CRLF + len = 2; +#else + len = 1; +#endif + if (swrite (u->s, &crlf[2-len], &len) != 0) + os_error ("Completing record after ADVANCE_NO failed"); + } +} +