From f951835ea5201ee187661930550fdea99129f7fa Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 27 Apr 2017 22:42:24 -0700 Subject: [PATCH] Fix bug in textual->binary-port. --- src/runtime/binary-port.scm | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/runtime/binary-port.scm b/src/runtime/binary-port.scm index 10edd2410..dc8d16b4f 100644 --- a/src/runtime/binary-port.scm +++ b/src/runtime/binary-port.scm @@ -201,15 +201,17 @@ USA. (lambda (bv bs be) (let loop ((bi bs)) (if (fix:< bi be) - (let ((char (peek-char textual-port))) - (if (or (not char) (eof-object? char)) - (if (fix:> bi bs) - (fix:- bi bs) - char) - (let ((bi* ((char-codec-encoder codec) bv bi be char))) - (if bi* - (loop bi*) - (fix:- bi bs))))) + (let ((char (read-char textual-port))) + (cond ((not char) (if (fix:> bi bs) (fix:- bi bs) #f)) + ((eof-object? char) (fix:- bi bs)) + (else + (let ((bi* + ((char-codec-encoder codec) bv bi be char))) + (if bi* + (loop bi*) + (begin + (unread-char char textual-port) + (fix:- bi bs))))))) (fix:- bi bs)))) (lambda () (close-input-port textual-port)))) @@ -228,7 +230,7 @@ USA. (fix:- bi bs)))) (lambda () (close-output-port textual-port)))) - 'textual-port->binary))) + 'textual->binary-port))) ;;;; Closing operations -- 2.25.1