From 48087ddde4ed39fbe4c891a030e2de62cd4422ba Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Thu, 15 Apr 2004 16:25:41 +0000 Subject: [PATCH] Fix ansi-test bug on read-sequence and echo-streams. Based on code from SBCL. --- code/stream.lisp | 35 +++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/code/stream.lisp b/code/stream.lisp index b50855e42..9ff217b16 100644 --- a/code/stream.lisp +++ b/code/stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.75 2004/04/15 01:34:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.76 2004/04/15 16:25:41 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1272,7 +1272,7 @@ streams." (in #'echo-in) (bin #'echo-bin) (misc #'echo-misc) - (n-bin #'ill-n-bin)) + (n-bin #'echo-n-bin)) (:print-function %print-echo-stream) (:constructor %make-echo-stream (input-stream output-stream))) unread-stuff) @@ -1358,6 +1358,37 @@ output to Output-stream" (funcall (lisp-stream-misc out) out operation arg1 arg2) (stream-misc-dispatch out operation arg1 arg2))))))) + +(defun echo-n-bin (stream buffer start numbytes eof-error-p) + (let ((new-start start) + (read 0)) + (loop + (let ((thing (pop (echo-stream-unread-stuff stream)))) + (cond + (thing + (setf (aref buffer new-start) thing) + (incf new-start) + (incf read) + (when (= read numbytes) + (return-from echo-n-bin numbytes))) + (t (return nil))))) + (let ((bytes-read (read-n-bytes (echo-stream-input-stream stream) buffer + new-start (- numbytes read) nil))) + (cond + ((not eof-error-p) + (write-sequence buffer (echo-stream-output-stream stream) + :start new-start :end (+ new-start bytes-read)) + (+ bytes-read read)) + ((> numbytes (+ read bytes-read)) + (write-sequence buffer (echo-stream-output-stream stream) + :start new-start :end (+ new-start bytes-read)) + (error 'end-of-file :stream stream)) + (t + (write-sequence buffer (echo-stream-output-stream stream) + :start new-start :end (+ new-start bytes-read)) + (aver (= numbytes (+ new-start bytes-read))) + numbytes))))) + (defun %print-echo-stream (s stream d) (declare (ignore d)) (format stream "#<Echo Stream, Input = ~S, Output = ~S>" -- GitLab