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.

diff --git a/NEWS b/NEWS
index d87a4a0..93ad34f 100644 (file)
--- 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 (file)
--- 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)))))
 \f
 ;;;; 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 (file)
--- 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 (file)
--- 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"