From f1a812d381347b942b50626aae3224dad98340af Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Wed, 14 Apr 2004 16:42:25 +0000
Subject: [PATCH] 0.8.9.40: 	Yay!  Finally, a patch inspired by PFD's
 ansi-tests 	... make ECHO-STREAMs understand
 READ-SEQUENCE; 	... add more tests than are in
 ansi-tests, because the interaction 		with
 UNREAD-CHAR is potentially tricky.

---
 NEWS                   |    2 ++
 src/code/stream.lisp   |   39 +++++++++++++++++++++++++++++++++------
 tests/stream.pure.lisp |   27 +++++++++++++++++++++++++++
 version.lisp-expr      |    2 +-
 4 files changed, 63 insertions(+), 7 deletions(-)

diff --git a/NEWS b/NEWS
index d87a4a0..93ad34f 100644
--- a/NEWS
+++ b/NEWS
@@ -2383,6 +2383,8 @@ changes in sbcl-0.8.10 relative to sbcl-0.8.9:
     values.  (thanks to Zach Beane)
   * bug fix: streams with element-type (SIGNED-BYTE <N>) for <N>
     greater than 32 handle EOF correctly.
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** READ-SEQUENCE now works on ECHO-STREAMs.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 2c008ba..9046767 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -882,7 +882,7 @@
 		      (in #'echo-in)
 		      (bin #'echo-bin)
 		      (misc #'echo-misc)
-		      (n-bin #'ill-bin))
+		      (n-bin #'echo-n-bin))
 	    (:constructor %make-echo-stream (input-stream output-stream))
 	    (:copier nil))
   unread-stuff)
@@ -921,6 +921,36 @@
 			(t (,out-fun result out) result)))))))
   (in-fun echo-in read-char write-char eof-error-p eof-value)
   (in-fun echo-bin read-byte write-byte eof-error-p eof-value))
+
+(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)))))
 
 ;;;; base STRING-STREAM stuff
 
@@ -1659,11 +1689,8 @@
 		(simple-array (signed-byte 8) (*))
 		simple-string)
 	    (let* ((numbytes (- end start))
-		   (bytes-read (sb!sys:read-n-bytes stream
-						    data
-						    offset-start
-						    numbytes
-						    nil)))
+		   (bytes-read (read-n-bytes stream data offset-start
+					     numbytes nil)))
 	      (if (< bytes-read numbytes)
 		  (+ start bytes-read)
 		  end)))
diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp
index 94da3af..6474758 100644
--- a/tests/stream.pure.lisp
+++ b/tests/stream.pure.lisp
@@ -242,3 +242,30 @@
 
 (with-open-file (s "/dev/null" :element-type '(signed-byte 48))
   (assert (eq :eof (read-byte s nil :eof))))
+
+(let* ((is (make-string-input-stream "foo"))
+       (os (make-string-output-stream))
+       (s (make-echo-stream is os))
+       (sequence (copy-seq "abcdef")))
+  (assert (= (read-sequence sequence s) 3))
+  (assert (string= sequence "foodef"))
+  (assert (string= (get-output-stream-string os) "foo")))
+
+(let* ((is (make-string-input-stream "foo"))
+       (os (make-string-output-stream))
+       (s (make-echo-stream is os))
+       (sequence (copy-seq "abcdef")))
+  (assert (char= #\f (read-char s)))
+  (assert (= (read-sequence sequence s) 2))
+  (assert (string= sequence "oocdef"))
+  (assert (string= (get-output-stream-string os) "foo")))
+
+(let* ((is (make-string-input-stream "foo"))
+       (os (make-string-output-stream))
+       (s (make-echo-stream is os))
+       (sequence (copy-seq "abcdef")))
+  (assert (char= #\f (read-char s)))
+  (unread-char #\f s)
+  (assert (= (read-sequence sequence s) 3))
+  (assert (string= sequence "foodef"))
+  (assert (string= (get-output-stream-string os) "foo")))
diff --git a/version.lisp-expr b/version.lisp-expr
index f2a8fb9..ec316cf 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.9.39"
+"0.8.9.40"
-- 
1.7.10.4