fix r6rs custom ports for flushing

svn: r11370
This commit is contained in:
Matthew Flatt 2008-08-21 19:43:45 +00:00
parent 8f12007984
commit c170f390a7

View File

@ -833,7 +833,9 @@
id id
always-evt ;; assuming that it never blocks! always-evt ;; assuming that it never blocks!
(lambda (bytes start end can-block/buffer? enable-break?) (lambda (bytes start end can-block/buffer? enable-break?)
(write! bytes start end)) (if (= start end)
0
(write! bytes start end)))
(or close void) (or close void)
#f #f
#f #f
@ -862,8 +864,10 @@
(bytes-utf-8-length bytes #f start end)) (bytes-utf-8-length bytes #f start end))
;; No old bytes saved, and bytes to write form a complete ;; No old bytes saved, and bytes to write form a complete
;; UTF-8 encoding, so we can write directly: ;; UTF-8 encoding, so we can write directly:
(let ([s (bytes->string/utf-8 bytes #f start end)]) (let* ([s (bytes->string/utf-8 bytes #f start end)]
(write! s 0 (string-length s))) [len (string-length s)])
(when (positive? len)
(write! s 0 len)))
;; Partial or need to use existing bytes, so use pipe ;; Partial or need to use existing bytes, so use pipe
(begin (begin
(write-bytes bytes out start end) (write-bytes bytes out start end)
@ -877,8 +881,10 @@
(let-values ([(amt used status) (bytes-convert c buffer 0 n cvt-buffer)]) (let-values ([(amt used status) (bytes-convert c buffer 0 n cvt-buffer)])
(when (positive? amt) (when (positive? amt)
(read-bytes! buffer in 0 amt) (read-bytes! buffer in 0 amt)
(let ([s (bytes->string/utf-8 buffer #f 0 amt)]) (let* ([s (bytes->string/utf-8 buffer #f 0 amt)]
(write! s 0 (string-length s)))) [len (string-length s)])
(when (positive? len)
(write! s 0 (string-length s)))))
(when (eq? status 'error) (when (eq? status 'error)
;; Discard an erroneous byte ;; Discard an erroneous byte
(read-byte in)) (read-byte in))