From 81a75e4657328daad0d63bdbf9555ef4d309c39d Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Wed, 17 Jan 2007 12:40:54 +0000 Subject: [PATCH] 1.0.1.30: Fix READ/WRITE-SEQUENCE on simple-vectors Broken by the recent bivalent stream fix. * Arbitrarily decide that READ-SEQUENCE into a simple-vector from a bivalent stream should read character data * More tests --- src/code/stream.lisp | 26 ++++++++++++++++++++++---- tests/stream.impure.lisp | 43 +++++++++++++++++++++++++++++++++++++++---- version.lisp-expr | 2 +- 3 files changed, 62 insertions(+), 9 deletions(-) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 61e786c..d13c3c5 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -1821,8 +1821,17 @@ (+ start bytes-read) end)) (let ((read-function - (if (subtypep (array-element-type data) 'character) - #'ansi-stream-read-char + (if (subtypep (stream-element-type stream) 'character) + ;; If the stream-element-type is CHARACTER, + ;; this might be a bivalent stream. If the + ;; sequence is a specialized unsigned-byte + ;; vector, try to read use binary IO. It'll + ;; signal an error if stream is an pure + ;; character stream. + (if (subtypep (array-element-type data) + 'unsigned-byte) + #'ansi-stream-read-byte + #'ansi-stream-read-char) #'ansi-stream-read-byte))) (do ((i offset-start (1+ i))) ((>= i offset-end) end) @@ -1874,8 +1883,17 @@ (labels ((output-seq-in-loop () (let ((write-function - (if (subtypep (array-element-type data) 'character) - (ansi-stream-out stream) + (if (subtypep (stream-element-type stream) 'character) + (lambda (stream object) + ;; This might be a bivalent stream, so we need + ;; to dispatch on a per-element basis, rather + ;; than just based on the sequence or stream + ;; element types. + (if (characterp object) + (funcall (ansi-stream-out stream) + stream object) + (funcall (ansi-stream-bout stream) + stream object))) (ansi-stream-bout stream)))) (do ((i offset-start (1+ i))) ((>= i offset-end)) diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp index e7036b2..c0830a6 100644 --- a/tests/stream.impure.lisp +++ b/tests/stream.impure.lisp @@ -209,6 +209,14 @@ (read-sequence sequence stream) (assert (equalp sequence #(255))))) + (let ((sequence (make-array 1))) + (with-open-file (stream pathname + :direction :input + :external-format :latin-1 + :element-type 'character) + (read-sequence sequence stream) + (assert (equalp sequence #(#.(code-char 255)))))) + ;; Check the fast path works for (UNSIGNED-BYTE 8) and (SIGNED-BYTE ;; 8) vectors. (let ((sequence (make-array 1 :element-type '(unsigned-byte 8)))) @@ -225,8 +233,8 @@ (read-sequence sequence stream) (assert (equalp sequence #(-1))))) - ;; A bivalent stream can be read to a unsigned-byte vector or a - ;; string + ;; A bivalent stream can be read to a unsigned-byte vector, a + ;; string, or a generic vector (let ((sequence (make-array 1 :element-type '(unsigned-byte 8)))) (with-open-file (stream pathname @@ -243,6 +251,14 @@ (read-sequence sequence stream) (assert (equalp sequence #(#.(code-char 255)))))) + (let ((sequence (make-array 1))) + (with-open-file (stream pathname + :direction :input + :external-format :latin-1 + :element-type :default) + (read-sequence sequence stream) + (assert (equalp sequence #(#.(code-char 255)))))) + ;; Check that a TYPE-ERROR is signalled for incompatible (sequence, ;; stream) pairs. @@ -280,7 +296,7 @@ (read-sequence sequence stream) (error "READ-SEQUENCE didn't signal an error")) (type-error (condition) - (assert (= (type-error-datum condition) 255)) + (assert (eql (type-error-datum condition) (code-char 255))) (assert (subtypep (type-error-expected-type condition) '(signed-byte 8)))))))) @@ -296,6 +312,8 @@ (let ((pathname "write-sequence.data") (generic-sequence (make-array 1 :initial-contents '(255))) + (generic-character-sequence (make-array 1 :initial-element #\a)) + (generic-mixed-sequence (make-array 2 :initial-element #\a)) (string (make-array 1 :element-type 'character :initial-element (code-char 255))) (unsigned-sequence (make-array 1 @@ -304,6 +322,9 @@ (signed-sequence (make-array 1 :element-type '(signed-byte 8) :initial-contents '(-1)))) + + (setf (aref generic-mixed-sequence 1) 255) + ;; Check the slow path for generic vectors. (with-open-file (stream pathname :direction :output @@ -311,6 +332,12 @@ :element-type '(unsigned-byte 8)) (write-sequence generic-sequence stream)) + (with-open-file (stream pathname + :direction :output + :if-exists :supersede + :element-type 'character) + (write-sequence generic-character-sequence stream)) + ;; Check the fast path for unsigned and signed vectors. (with-open-file (stream pathname :direction :output @@ -324,7 +351,8 @@ :element-type '(signed-byte 8)) (write-sequence signed-sequence stream)) - ;; Bivalent streams on unsigned-byte and strings + ;; Bivalent streams on unsigned-byte vectors, strings, and a simple + ;; vector with mixed characters and bytes (with-open-file (stream pathname :direction :output @@ -339,6 +367,13 @@ :element-type :default) (write-sequence string stream)) + (with-open-file (stream pathname + :direction :output + :external-format :latin-1 + :if-exists :supersede + :element-type :default) + (write-sequence generic-mixed-sequence stream)) + ;; Check a TYPE-ERROR is signalled for unsigned and signed vectors ;; which are incompatible with the stream element type. (with-open-file (stream pathname diff --git a/version.lisp-expr b/version.lisp-expr index cebbb42..b6c2a62 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".) -"1.0.1.29" +"1.0.1.30" -- 1.7.10.4