This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] Fix PR 34370, 34323 and 34405
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Wed, 12 Dec 2007 22:03:25 +0100
- Subject: [patch, fortran] Fix PR 34370, 34323 and 34405
Hello world,
here is a fix for a few problems in Fortran I/O,
involving file-positioning after non-advancing I/O,
formatted stream non-advancing I/O and error reporting
for illegal operations.
Just trying to increase my standing in the year end list
here :-)
Regression-tested on i686-pc-linux-gnu.
OK?
Thomas
2007-12-12 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-12 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.
! { 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
! { 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
! { 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
Index: file_pos.c
===================================================================
--- file_pos.c (revision 130585)
+++ file_pos.c (working copy)
@@ -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
Index: io.h
===================================================================
--- io.h (revision 130585)
+++ io.h (working copy)
@@ -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 *);
Index: unit.c
===================================================================
--- unit.c (revision 130585)
+++ unit.c (working copy)
@@ -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");
+ }
+}
+
Index: transfer.c
===================================================================
--- transfer.c (revision 130585)
+++ transfer.c (working copy)
@@ -1891,6 +1891,8 @@ data_transfer_init (st_parameter_dt *dtp
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