diff options
-rw-r--r-- | libguile/r6rs-ports.c | 9 | ||||
-rw-r--r-- | test-suite/tests/r6rs-ports.test | 20 |
2 files changed, 26 insertions, 3 deletions
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 30456a856..5f3b156c0 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -406,9 +406,12 @@ cbip_fill_input (SCM port) (c_port->read_buf == (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv)); if (buffered) - /* Make sure the buffer isn't corrupt. BV can be passed directly - to READ_PROC. */ - assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv)); + { + /* Make sure the buffer isn't corrupt. BV can be passed directly + to READ_PROC. */ + assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv)); + c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv); + } else { /* This is an unbuffered port. When called via the diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 213c8b7b1..07c9f4465 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -22,6 +22,7 @@ #:use-module (test-suite guile-test) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (ice-9 match) #:use-module (rnrs io ports) #:use-module (rnrs io simple) #:use-module (rnrs exceptions) @@ -456,6 +457,25 @@ not `set-port-position!'" (u8-list->bytevector (map char->integer (string->list "Port!"))))))) + (pass-if-equal "custom binary input port buffered partial reads" + "Hello Port!" + ;; Check what happens when READ! returns less than COUNT bytes. + (let* ((src (string->utf8 "Hello Port!")) + (chunks '(2 4 5)) ; provide 2 bytes, then 4, etc. + (offset 0) + (read! (lambda (bv start count) + (match chunks + ((count rest ...) + (bytevector-copy! src offset bv start count) + (set! chunks rest) + (set! offset (+ offset count)) + count) + (() + 0)))) + (port (make-custom-binary-input-port "the port" + read! #f #f #f))) + (get-string-all port))) + (pass-if-equal "custom binary input port unbuffered & 'port-position'" '(0 2 5 11) ;; Check that the value returned by 'port-position' is correct, and |