diff options
-rw-r--r-- | libguile/fports.c | 27 | ||||
-rw-r--r-- | libguile/ports.c | 17 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 25 |
3 files changed, 55 insertions, 14 deletions
diff --git a/libguile/fports.c b/libguile/fports.c index 3ac3ced8b..10cf6713a 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, - * 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. + * 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -174,7 +174,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, { int cmode; long csize; - SCM drained; + size_t ndrained; + char *drained; scm_t_port *pt; port = SCM_COERCE_OUTPORT (port); @@ -211,9 +212,21 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, pt = SCM_PTAB_ENTRY (port); if (SCM_INPUT_PORT_P (port)) - drained = scm_drain_input (port); + { + /* Drain pending input from PORT. Don't use `scm_drain_input' since + it returns a string, whereas we want binary input here. */ + ndrained = pt->read_end - pt->read_pos; + if (pt->read_buf == pt->putback_buf) + ndrained += pt->saved_read_end - pt->saved_read_pos; + + if (ndrained > 0) + { + drained = scm_gc_malloc_pointerless (ndrained, "file port"); + scm_take_from_input_buffers (port, drained, ndrained); + } + } else - drained = scm_nullstr; + ndrained = 0; if (SCM_OUTPUT_PORT_P (port)) scm_flush (port); @@ -232,8 +245,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, scm_fport_buffer_add (port, csize, csize); - if (scm_is_true (drained) && scm_c_string_length (drained)) - scm_unread_string (drained, port); + if (ndrained > 0) + /* Put DRAINED back to PORT. */ + while (ndrained-- > 0) + scm_unget_byte (drained[ndrained], port); return SCM_UNSPECIFIED; } diff --git a/libguile/ports.c b/libguile/ports.c index 2d8b9ed48..3ef92b902 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -289,19 +289,21 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0, } #undef FUNC_NAME -/* move up to read_len chars from port's putback and/or read buffers - into memory starting at dest. returns the number of chars moved. */ -size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len) +/* Move up to READ_LEN bytes from PORT's putback and/or read buffers + into memory starting at DEST. Return the number of bytes moved. + PORT's line/column numbers are left unchanged. */ +size_t +scm_take_from_input_buffers (SCM port, char *dest, size_t read_len) { scm_t_port *pt = SCM_PTAB_ENTRY (port); - size_t chars_read = 0; + size_t bytes_read = 0; size_t from_buf = min (pt->read_end - pt->read_pos, read_len); if (from_buf > 0) { memcpy (dest, pt->read_pos, from_buf); pt->read_pos += from_buf; - chars_read += from_buf; + bytes_read += from_buf; read_len -= from_buf; dest += from_buf; } @@ -314,10 +316,11 @@ size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len) { memcpy (dest, pt->saved_read_pos, from_buf); pt->saved_read_pos += from_buf; - chars_read += from_buf; + bytes_read += from_buf; } } - return chars_read; + + return bytes_read; } /* Clear a port's read buffers, returning the contents. */ diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index d4a333f56..5ca416daf 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -2,7 +2,7 @@ ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999 ;;;; ;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010, -;;;; 2011 Free Software Foundation, Inc. +;;;; 2011, 2012 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -1064,6 +1064,29 @@ (list read read-char read-line) '("read" "read-char" "read-line"))) + + +(with-test-prefix "setvbuf" + + (pass-if "line/column number preserved" + ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's + ;; line and/or column number. + (call-with-output-file (test-file) + (lambda (p) + (display "This is GNU Guile.\nWelcome." p))) + (call-with-input-file (test-file) + (lambda (p) + (and (eq? #\T (read-char p)) + (let ((line (port-line p)) + (col (port-column p))) + (and (= line 0) (= col 1) + (begin + (setvbuf p _IOFBF 777) + (let ((line* (port-line p)) + (col* (port-column p))) + (and (= line line*) + (= col col*))))))))))) + (delete-file (test-file)) ;;; Local Variables: |