Paul Brook <paul@codesourcery.com>
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@84104
138bc75d-0d04-0410-961f-
82ee72b054a4
+2004-07-04 Bud Davis <bdavis9659@comcast.net>
+
+ * gfortran.fortran-torture/execute/seq_io.f90: New test.
+
2004-07-04 Neil Booth <neil@duron.akihabara.co.uk>
* gcc.dg/cpp/if-mop.c: Two new testcases.
--- /dev/null
+! 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
+2004-07-04 Bud Davis <bdavis9659@comcast.net>
+ Paul Brook <paul@codesourcery.com>
+
+ 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 <jblomqvi@cc.hut.fi>
Paul Brook <paul@codesourcery.com>
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;
}
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;
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 */
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;
}
/* 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;
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;
}
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
projects / platform / upstream / linaro-gcc.git / commitdiff