1.0.12.17: Gray streams as part of composite streams

* READ-N-BYTES needs to deal with Gray streams.

diff --git a/NEWS b/NEWS
index ea84bba..28cef49 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -7,6 +7,8 @@ changes in sbcl-1.0.13 relative to sbcl-1.0.12:
   * optimizations: COPY-SEQ, FILL, and SUBSEQ are 30-80% faster for
     strings and vectors whose element-type or simplicity is not fully
     known at compile-time.
+  * bug fix: READ-SEQUENCE on composite stream wrapping a Gray stream
+    with STREAM-ELEMENT-TYPE (UNSIGNED-BYTE 8) signalled an error.
   * bug fix: COPY-SEQ on lists did not signal a type-error on improper
     lists in safe code.
   * bug fix: some sequence functions elided bounds checking when

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 799e242..c9e35cc 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -424,7 +424,17 @@
 ;;; some cases, but it wasn't being used in SBCL, so it was dropped.
 ;;; If we ever need it, it could be added later as a new variant N-BIN
 ;;; method (perhaps N-BIN-ASAP?) or something.
+#!-sb-fluid (declaim (inline read-n-bytes))
 (defun read-n-bytes (stream buffer start numbytes &optional (eof-error-p t))
+  (if (ansi-stream-p stream)
+      (ansi-stream-read-n-bytes stream buffer start numbytes eof-error-p)
+      ;; We don't need to worry about element-type size here is that
+      ;; callers are supposed to have checked everything is kosher.
+      (let* ((end (+ start numbytes))
+             (read-end (stream-read-sequence stream buffer start end)))
+        (eof-or-lose stream (and eof-error-p (< read-end end)) (- read-end start)))))
+
+(defun ansi-stream-read-n-bytes (stream buffer start numbytes eof-error-p)
   (declare (type ansi-stream stream)
            (type index numbytes start)
            (type (or (simple-array * (*)) system-area-pointer) buffer))

diff --git a/tests/gray-streams.impure.lisp b/tests/gray-streams.impure.lisp
index 181e0c1..5b87817 100644 (file)
--- a/tests/gray-streams.impure.lisp
+++ b/tests/gray-streams.impure.lisp
@@ -285,3 +285,49 @@
   (assert (= (file-position stream) 42))
   (assert (file-position stream 50))
   (assert (= (file-position stream) 50)))
+
+;;; Using gray streams as parts of two-way-, concatenate-, and synonym-streams.
+
+(defvar *gray-binary-data*
+  (let ((vector (make-array 1024 :element-type '(unsigned-byte 8) :fill-pointer 0)))
+    (dotimes (i (length vector))      
+      (setf (aref vector i) (random 256)))
+    vector))
+
+(defun vector-hop-or-eof (vector)
+  (let ((pos (fill-pointer vector)))
+    (if (< pos (array-total-size vector))
+        (prog1
+            (aref vector pos)
+          (incf (fill-pointer vector)))
+        :eof)))
+
+(defclass part-of-composite-stream (fundamental-binary-input-stream)
+  ())
+
+(defmethod stream-read-byte ((stream part-of-composite-stream))
+  (vector-hop-or-eof *gray-binary-data*))
+
+(defmethod stream-element-type ((stream part-of-composite-stream))
+  '(unsigned-byte 8))
+
+(defvar *part-of-composite* (make-instance 'part-of-composite-stream))
+
+(defun test-composite-reads (&rest streams)
+  (dolist (stream streams)
+    (setf (fill-pointer *gray-binary-data*) 0)
+    (let ((binary-buffer (make-array 1024 :element-type '(unsigned-byte 8))))
+      (assert (eql 1024 (read-sequence binary-buffer stream)))
+      (dotimes (i 1024)
+        (unless (eql (aref *gray-binary-data* i)
+                     (aref binary-buffer i))
+          (error "wanted ~S at ~S, got ~S (~S)" 
+                 (aref *gray-binary-data* i)
+                 i 
+                 (aref binary-buffer i)
+                 stream))))))
+
+(test-composite-reads
+ (make-two-way-stream *part-of-composite* *standard-output*)
+ (make-concatenated-stream *part-of-composite*)
+ (make-synonym-stream '*part-of-composite*))

diff --git a/version.lisp-expr b/version.lisp-expr
index 7464d29..cc2c417 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".)
-"1.0.12.16"
+"1.0.12.17"