mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

Avoid flushing buffers for ftell

Browse source 
* libguile/ports.c (scm_seek): Avoid flushing buffers for an ftell.
  Also allows non-random-access ports to ftell() if they have a seek
  implementation, as is the case for custom binary ports with a
  get-position function but no set-position function.
* test-suite/tests/ports.test: Adapt expectations, reverting changes
  made in April by me in b77fb752dd.
This commit is contained in:
Andy Wingo 2016-08-31 15:39:01 +02:00
parent 9996695f88
commit eeb23e776a
2 changed files with 15 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

14
libguile/ports.c
View file

@ -3544,13 +3544,21 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset); off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
off_t_or_off64_t rv; off_t_or_off64_t rv;
if (ptob->seek && how == SEEK_CUR && off == 0)
{
/* If we are just querying the current position, avoid
flushing buffers. We don't even need to require that the
port supports random access. */
rv = ptob->seek (fd_port, off, how);
rv -= scm_port_buffer_can_take (pt->read_buf);
rv += scm_port_buffer_can_take (pt->write_buf);
return scm_from_off_t_or_off64_t (rv);
}
if (!ptob->seek || !pt->rw_random) if (!ptob->seek || !pt->rw_random)
SCM_MISC_ERROR ("port is not seekable", SCM_MISC_ERROR ("port is not seekable",
scm_cons (fd_port, SCM_EOL)); scm_cons (fd_port, SCM_EOL));
/* FIXME: Avoid flushing buffers for SEEK_CUR with an offset of
0. */
scm_end_input (fd_port); scm_end_input (fd_port);
scm_flush (fd_port); scm_flush (fd_port);

8
test-suite/tests/ports.test
View file

@ -177,8 +177,8 @@
(unread-char #\z iport) (unread-char #\z iport)
(pass-if "file: in tell 0 after unread" (pass-if "file: in tell 0 after unread"
(= (seek iport 0 SEEK_CUR) 0)) (= (seek iport 0 SEEK_CUR) 0))
(pass-if "file: putback buffer flushed after seek" (pass-if "file: unread char still there"
(char=? (read-char iport) #\J)) (char=? (read-char iport) #\z))
(seek iport 7 SEEK_SET) (seek iport 7 SEEK_SET)
(pass-if "file: in last char" (pass-if "file: in last char"
(char=? (read-char iport) #\x)) (char=? (read-char iport) #\x))
@ -699,8 +699,8 @@
(unread-char #\x p) (unread-char #\x p)
(pass-if "input tell back to 0" (pass-if "input tell back to 0"
(= (seek p 0 SEEK_CUR) 0)) (= (seek p 0 SEEK_CUR) 0))
(pass-if "putback buffer discarded after seek" (pass-if "input ungetted char"
(char=? (read-char p) #\t)) (char=? (read-char p) #\x))
(seek p 0 SEEK_END) (seek p 0 SEEK_END)
(pass-if "input seek to end" (pass-if "input seek to end"
(= (seek p 0 SEEK_CUR) (= (seek p 0 SEEK_CUR)