+2007-12-13 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ 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 <doug.gregor@gmail.com>
* g++.dg/cpp0x/__func__.C: New.
--- /dev/null
+! { 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
--- /dev/null
+! { 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
+
--- /dev/null
+! { 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
+2007-12-13 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ 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 <burnus@net-b.de>
PR fortran/34427
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. */
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;
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;
struncate (u->s);
u->endfile = AFTER_ENDFILE;
update_position (u);
+ done:
unlock_unit (u);
}
"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
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;
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 *);
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,
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
/* 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;
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");
+ }
+}
+
projects / thirdparty / gcc.git / commitdiff
