summaryrefslogtreecommitdiff
path: root/test-suite/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-01-16 23:43:31 +0100
committerLudovic Courtès <ludo@gnu.org>2014-01-18 22:52:07 +0100
commit8ca97482b01cf1a6aa538cc5a2d1f71fb60f080c (patch)
tree71969fad76834a569c1b477b4069f7b72924fbd1 /test-suite/tests
parent122f24cc8a3637ed42d7792ad1ff8ec0c49c58df (diff)
downloadguile-8ca97482b01cf1a6aa538cc5a2d1f71fb60f080c.tar.gz
Custom binary input ports support 'setvbuf'.
* libguile/r6rs-ports.c (CBIP_BUFFER_SIZE): Adjust comment. Set to 8KiB. (SCM_SET_CBIP_BYTEVECTOR): New macro. (cbip_setvbuf): New function. (make_cbip): Set PORT's 'setvbuf' internal field. (cbip_fill_input): Check whether PORT is buffered. When unbuffered, check whether BV can hold C_REQUESTED bytes, and allocate a new bytevector if not; copy the data back from BV to c_port->read_pos. Remove 'again' label, and don't loop there. * test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports")["custom binary input port unbuffered & 'port-position'", "custom binary input port unbuffered & 'read!' calls", "custom binary input port, unbuffered then buffered", "custom binary input port, buffered then unbuffered"]: New tests. * doc/ref/api-io.texi (R6RS Binary Input): Document the buffering of custom binary input ports, and link to 'setvbuf'.
Diffstat (limited to 'test-suite/tests')
-rw-r--r--test-suite/tests/r6rs-ports.test123
1 files changed, 123 insertions, 0 deletions
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 2b62bedbf..213c8b7b1 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -456,6 +456,129 @@ not `set-port-position!'"
(u8-list->bytevector
(map char->integer (string->list "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
+ ;; that each 'port-position' call leads one call to the
+ ;; 'get-position' method.
+ (let* ((str "Hello Port!")
+ (output (make-bytevector (string-length str)))
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (read! (lambda (bv start count)
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (pos '())
+ (get-pos (lambda ()
+ (let ((p (port-position source)))
+ (set! pos (cons p pos))
+ p)))
+ (port (make-custom-binary-input-port "the port" read!
+ get-pos #f #f)))
+ (setvbuf port _IONBF)
+ (and (= 0 (port-position port))
+ (begin
+ (get-bytevector-n! port output 0 2)
+ (= 2 (port-position port)))
+ (begin
+ (get-bytevector-n! port output 2 3)
+ (= 5 (port-position port)))
+ (let ((bv (string->utf8 (get-string-all port))))
+ (bytevector-copy! bv 0 output 5 (bytevector-length bv))
+ (= (string-length str) (port-position port)))
+ (bytevector=? output (string->utf8 str))
+ (reverse pos))))
+
+ (pass-if-equal "custom binary input port unbuffered & 'read!' calls"
+ `((2 "He") (3 "llo") (42 " Port!"))
+ (let* ((str "Hello Port!")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IONBF)
+ (let ((ret (list (get-bytevector-n port 2)
+ (get-bytevector-n port 3)
+ (get-bytevector-n port 42))))
+ (zip (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
+ (pass-if-equal "custom binary input port, unbuffered then buffered"
+ `((6 "Lorem ") (12 "ipsum dolor ") (777 "sit amet, consectetur…")
+ (777 ,(eof-object)))
+ (let* ((str "Lorem ipsum dolor sit amet, consectetur…")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IONBF)
+ (let ((ret (list (get-bytevector-n port 6)
+ (get-bytevector-n port 12)
+ (begin
+ (setvbuf port _IOFBF 777)
+ (get-bytevector-n port 42))
+ (get-bytevector-n port 42))))
+ (zip (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
+ (pass-if-equal "custom binary input port, buffered then unbuffered"
+ `((18
+ 42 14 ; scm_c_read tries to fill the 42-byte buffer
+ 42)
+ ("Lorem " "ipsum dolor " "sit amet, consectetur bla…" ,(eof-object)))
+ (let* ((str "Lorem ipsum dolor sit amet, consectetur bla…")
+ (source (with-fluids ((%default-port-encoding "UTF-8"))
+ (open-string-input-port str)))
+ (reads '())
+ (read! (lambda (bv start count)
+ (set! reads (cons count reads))
+ (let ((r (get-bytevector-n! source bv start count)))
+ (if (eof-object? r)
+ 0
+ r))))
+ (port (make-custom-binary-input-port "the port" read!
+ #f #f #f)))
+
+ (setvbuf port _IOFBF 18)
+ (let ((ret (list (get-bytevector-n port 6)
+ (get-bytevector-n port 12)
+ (begin
+ (setvbuf port _IONBF)
+ (get-bytevector-n port 42))
+ (get-bytevector-n port 42))))
+ (list (reverse reads)
+ (map (lambda (obj)
+ (if (bytevector? obj)
+ (utf8->string obj)
+ obj))
+ ret)))))
+
(pass-if "custom binary input port `close-proc' is called"
(let* ((closed? #f)
(read! (lambda (bv start count) 0))