diff --git a/libguile/fports.c b/libguile/fports.c index 2b415b9a8..e33bfe58c 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -670,50 +670,12 @@ fport_fill_input (SCM port) static scm_t_off fport_seek (SCM port, scm_t_off offset, int whence) { - scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_fport *fp = SCM_FSTREAM (port); - off_t_or_off64_t rv; off_t_or_off64_t result; - if (pt->rw_active == SCM_PORT_WRITE) - { - if (offset != 0 || whence != SEEK_CUR) - { - fport_flush (port); - result = rv = lseek_or_lseek64 (fp->fdes, offset, whence); - } - else - { - /* read current position without disturbing the buffer. */ - rv = lseek_or_lseek64 (fp->fdes, offset, whence); - result = rv + (pt->write_pos - pt->write_buf); - } - } - else if (pt->rw_active == SCM_PORT_READ) - { - if (offset != 0 || whence != SEEK_CUR) - { - /* could expand to avoid a second seek. */ - scm_end_input_unlocked (port); - result = rv = lseek_or_lseek64 (fp->fdes, offset, whence); - } - else - { - /* read current position without disturbing the buffer - (particularly the unread-char buffer). */ - rv = lseek_or_lseek64 (fp->fdes, offset, whence); - result = rv - (pt->read_end - pt->read_pos); + result = lseek_or_lseek64 (fp->fdes, offset, whence); - if (pt->read_buf == pt->putback_buf) - result -= pt->saved_read_end - pt->saved_read_pos; - } - } - else /* SCM_PORT_NEITHER */ - { - result = rv = lseek_or_lseek64 (fp->fdes, offset, whence); - } - - if (rv == -1) + if (result == -1) scm_syserror ("fport_seek"); return result; diff --git a/libguile/ports.c b/libguile/ports.c index e51ac5e65..202f7f998 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -2851,16 +2851,26 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0, if (SCM_OPPORTP (fd_port)) { + scm_t_port *pt = SCM_PTAB_ENTRY (fd_port); scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (fd_port); scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (fd_port); off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset); off_t_or_off64_t rv; - if (!ptob->seek) + if (!ptob->seek || !pt->rw_random) SCM_MISC_ERROR ("port is not seekable", scm_cons (fd_port, SCM_EOL)); - else - rv = ptob->seek (fd_port, off, how); + + /* FIXME: Avoid flushing buffers for SEEK_CUR with an offset of + 0. */ + + if (pt->rw_active == SCM_PORT_READ) + scm_end_input_unlocked (pt->port); + else if (pt->rw_active == SCM_PORT_WRITE) + scm_flush_unlocked (pt->port); + pt->rw_active = SCM_PORT_NEITHER; + + rv = ptob->seek (fd_port, off, how); /* Set stream-start flags according to new position. */ pti->at_stream_start_for_bom_read = (rv == 0); diff --git a/libguile/strports.c b/libguile/strports.c index 6c65ec86c..064e2f04a 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -162,64 +162,44 @@ st_seek (SCM port, scm_t_off offset, int whence) scm_t_port *pt = SCM_PTAB_ENTRY (port); scm_t_off target; - if (pt->rw_active == SCM_PORT_READ && offset == 0 && whence == SEEK_CUR) - /* special case to avoid disturbing the unread-char buffer. */ + switch (whence) { - if (pt->read_buf == pt->putback_buf) - { - target = pt->saved_read_pos - pt->saved_read_buf - - (pt->read_end - pt->read_pos); - } - else - { - target = pt->read_pos - pt->read_buf; - } + case SEEK_CUR: + target = pt->read_pos - pt->read_buf + offset; + break; + case SEEK_END: + target = pt->read_end - pt->read_buf + offset; + break; + default: /* SEEK_SET */ + target = offset; + break; } - else - /* all other cases. */ - { - if (pt->rw_active == SCM_PORT_READ) - scm_end_input_unlocked (port); - pt->rw_active = SCM_PORT_NEITHER; - - switch (whence) - { - case SEEK_CUR: - target = pt->read_pos - pt->read_buf + offset; - break; - case SEEK_END: - target = pt->read_end - pt->read_buf + offset; - break; - default: /* SEEK_SET */ - target = offset; - break; - } - - if (target < 0) - scm_misc_error ("st_seek", "negative offset", SCM_EOL); + if (target < 0) + scm_misc_error ("st_seek", "negative offset", SCM_EOL); - if (target >= pt->write_buf_size) - { - if (!(SCM_CELL_WORD_0 (port) & SCM_WRTNG)) - { - if (target > pt->write_buf_size) - { - scm_misc_error ("st_seek", - "seek past end of read-only strport", - SCM_EOL); - } - } - else if (target == pt->write_buf_size) - st_resize_port (pt, target * 2); - } - pt->read_pos = pt->write_pos = pt->read_buf + target; - if (pt->read_pos > pt->read_end) - { - pt->read_end = (unsigned char *) pt->read_pos; - pt->read_buf_size = pt->read_end - pt->read_buf; - } + if (target >= pt->write_buf_size) + { + if (!(SCM_CELL_WORD_0 (port) & SCM_WRTNG)) + { + if (target > pt->write_buf_size) + { + scm_misc_error ("st_seek", + "seek past end of read-only strport", + SCM_EOL); + } + } + else if (target == pt->write_buf_size) + st_resize_port (pt, target * 2); } + + pt->read_pos = pt->write_pos = pt->read_buf + target; + if (pt->read_pos > pt->read_end) + { + pt->read_end = (unsigned char *) pt->read_pos; + pt->read_buf_size = pt->read_end - pt->read_buf; + } + return target; } diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 2bc719e90..33050fd7f 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -176,8 +176,8 @@ (unread-char #\z iport) (pass-if "file: in tell 0 after unread" (= (seek iport 0 SEEK_CUR) 0)) - (pass-if "file: unread char still there" - (char=? (read-char iport) #\z)) + (pass-if "file: putback buffer flushed after seek" + (char=? (read-char iport) #\J)) (seek iport 7 SEEK_SET) (pass-if "file: in last char" (char=? (read-char iport) #\x)) @@ -700,8 +700,8 @@ (unread-char #\x p) (pass-if "input tell back to 0" (= (seek p 0 SEEK_CUR) 0)) - (pass-if "input ungetted char" - (char=? (read-char p) #\x)) + (pass-if "putback buffer discarded after seek" + (char=? (read-char p) #\t)) (seek p 0 SEEK_END) (pass-if "input seek to end" (= (seek p 0 SEEK_CUR)