Buffered custom binary input ports correctly handle partial read requests.

* libguile/r6rs-ports.c (cbip_fill_input): Always initialize 'read_pos'
  when BUFFERED.
* test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports")["custom binary
  input port buffered partial reads"]: New test.

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