From: Bud Davis Date: Mon, 5 Jul 2004 01:19:08 +0000 (+0000) Subject: re PR libfortran/15472 (implicit open for unformatted file causes run-time error) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bf1df0a046ed0a4d272d0ee2c2a930e3ad9d1831;p=gcc.git re PR libfortran/15472 (implicit open for unformatted file causes run-time error) 2004-07-04 Bud Davis Paul Brook PR fortran/15472 * io/transfer.c(us_write): set recl for seq unform writes to max size. * io/transfer.c(data_transfer_init): handle un-opened seq unform unit. * io/unix.c(fd_alloc_w_at): handle requests at start, fd_flush at right time. * io/unix.c(is_seekable): set based upon the file/device, not the method being used to access it (fd or mmap). * io/unix.c(fd_flush): don't set file_size if !seekable. * io/unix.c(fd_truncate: ditto. * gfortran.fortran-torture/execute/seq_io.f90: New test. Co-Authored-By: Paul Brook From-SVN: r84104 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9f03b45a6c1..b90f61d17ac 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2004-07-04 Bud Davis + + * gfortran.fortran-torture/execute/seq_io.f90: New test. + 2004-07-04 Neil Booth * gcc.dg/cpp/if-mop.c: Two new testcases. diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 new file mode 100644 index 00000000000..e1688882989 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/seq_io.f90 @@ -0,0 +1,81 @@ +! pr 15472 +! sequential access files +! +! this test verifies the most basic sequential unformatted I/O +! write 3 records of various sizes +! then read them back +! and compare with what was written +! + implicit none + integer size + parameter(size=100) + logical debug + data debug /.FALSE./ +! set debug to true for help in debugging failures. + integer m(2) + integer n + real*4 r(size) + integer i + m(1) = Z'11111111' + m(2) = Z'22222222' + n = Z'33333333' + do i = 1,size + r(i) = i + end do + write(9)m ! an array of 2 + write(9)n ! an integer + write(9)r ! an array of reals +! zero all the results so we can compare after they are read back + do i = 1,size + r(i) = 0 + end do + m(1) = 0 + m(2) = 0 + n = 0 + + rewind(9) + read(9)m + read(9)n + read(9)r +! +! check results + if (m(1).ne.Z'11111111') then + if (debug) then + print '(A,Z8)','m(1) incorrect. m(1) = ',m(1) + else + call abort + endif + endif + + if (m(2).ne.Z'22222222') then + if (debug) then + print '(A,Z8)','m(2) incorrect. m(2) = ',m(2) + else + call abort + endif + endif + + if (n.ne.Z'33333333') then + if (debug) then + print '(A,Z8)','n incorrect. n = ',n + else + call abort + endif + endif + + do i = 1,size + if (int(r(i)).ne.i) then + if (debug) then + print*,'element ',i,' was ',r(i),' should be ',i + else + call abort + endif + endif + end do +! use hexdump to look at the file "fort.9" + if (debug) then + close(9) + else + close(9,status='DELETE') + endif + end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index ed0044d04e7..14a6349f023 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,16 @@ +2004-07-04 Bud Davis + Paul Brook + + PR fortran/15472 + * io/transfer.c(us_write): set recl for seq unform writes to max size. + * io/transfer.c(data_transfer_init): handle un-opened seq unform unit. + * io/unix.c(fd_alloc_w_at): handle requests at start, fd_flush at + right time. + * io/unix.c(is_seekable): set based upon the file/device, not the + method being used to access it (fd or mmap). + * io/unix.c(fd_flush): don't set file_size if !seekable. + * io/unix.c(fd_truncate: ditto. + 2004-07-04 Janne Blomqvist Paul Brook diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index b20f860bcef..ff4bc26f317 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -835,6 +835,11 @@ us_write (void) if (sfree (current_unit->s) == FAILURE) generate_error (ERROR_OS, NULL); + /* for sequential unformatted, we write until we have more bytes than + can fit in the record markers. if disk space runs out first it will + error on the write */ + current_unit->recl = g.max_offset; + current_unit->bytes_left = current_unit->recl; } @@ -890,7 +895,11 @@ data_transfer_init (int read_flag) memset (&u_flags, '\0', sizeof (u_flags)); u_flags.access = ACCESS_SEQUENTIAL; u_flags.action = ACTION_READWRITE; - u_flags.form = FORM_UNSPECIFIED; + /* is it unformatted ?*/ + if (ioparm.format == NULL && !ioparm.list_format) + u_flags.form = FORM_UNFORMATTED; + else + u_flags.form = FORM_UNSPECIFIED; u_flags.delim = DELIM_UNSPECIFIED; u_flags.blank = BLANK_UNSPECIFIED; u_flags.pad = PAD_UNSPECIFIED; diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index 0800447ba2e..0c652581c04 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -90,7 +90,7 @@ typedef struct gfc_offset physical_offset; /* Current physical file offset */ gfc_offset logical_offset; /* Current logical file offset */ gfc_offset dirty_offset; /* Start of modified bytes in buffer */ - gfc_offset file_length; /* Length of the file, -1 if not seekable. */ + gfc_offset file_length; /* Length of the file, -1 if not seekable. */ char *buffer; int len; /* Physical length of the current buffer */ @@ -280,7 +280,9 @@ fd_flush (unix_stream * s) return FAILURE; s->physical_offset = s->dirty_offset + s->ndirty; - if (s->physical_offset > s->file_length) + + /* don't increment file_length if the file is non-seekable */ + if (s->file_length != -1 && s->physical_offset > s->file_length) s->file_length = s->physical_offset; s->ndirty = 0; @@ -406,18 +408,28 @@ fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where) } /* Return a position within the current buffer */ - - if (s->ndirty == 0) - { /* First write into a clean buffer */ - s->dirty_offset = where; - s->ndirty = *len; + if (s->ndirty == 0 + || where > s->dirty_offset + s->ndirty + || s->dirty_offset > where + *len) + { /* Discontiguous blocks, start with a clean buffer. */ + /* Flush the buffer. */ + if (s->ndirty != 0) + fd_flush (s); + s->dirty_offset = where; + s->ndirty = *len; } else - { - if (s->dirty_offset + s->ndirty == where) - s->ndirty += *len; - else - fd_flush (s); /* Can't combine two dirty blocks */ + { + gfc_offset start; /* Merge with the existing data. */ + if (where < s->dirty_offset) + start = where; + else + start = s->dirty_offset; + if (where + *len > s->dirty_offset + s->ndirty) + s->ndirty = where + *len - start; + else + s->ndirty = s->dirty_offset + s->ndirty - start; + s->dirty_offset = start; } s->logical_offset = where + *len; @@ -461,13 +473,18 @@ static try fd_truncate (unix_stream * s) { - if (ftruncate (s->fd, s->logical_offset)) + if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1) return FAILURE; - s->physical_offset = s->file_length = s->logical_offset; + /* non-seekable files, like terminals and fifo's fail the lseek. + the fd is a regular file at this point */ - if (lseek (s->fd, s->file_length, SEEK_SET) == -1) + if (ftruncate (s->fd, s->logical_offset)) + { return FAILURE; + } + + s->physical_offset = s->file_length = s->logical_offset; return SUCCESS; } @@ -1390,8 +1407,10 @@ file_position (stream * s) int is_seekable (stream * s) { - - return ((unix_stream *) s)->mmaped; + /* by convention, if file_length == -1, the file is not seekable + note that a mmapped file is always seekable, an fd_ file may + or may not be. */ + return ((unix_stream *) s)->file_length!=-1; } try