X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.impure.lisp;h=851990f688297ea68fc9379e80cfe48f01c7731c;hb=5d5894082c39ca44da75d38859d669c7b2108f6a;hp=da980b0e2e22053cf0a15d737011d9b21a368548;hpb=175c318c892b0627b36fa3c4db66f59680242204;p=sbcl.git diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp index da980b0..851990f 100644 --- a/tests/stream.impure.lisp +++ b/tests/stream.impure.lisp @@ -91,7 +91,10 @@ (with-standard-io-syntax (prin1 'insert s))) (with-open-file (s p) - (assert (string= (read-line s) "THESE INSERTMBOLS"))) + (let ((line (read-line s)) + (want "THESE INSERTMBOLS")) + (unless (equal line want) + (error "wanted ~S, got ~S" want line)))) (delete-file p)) ;;; :DIRECTION :IO didn't work on non-existent pathnames @@ -178,5 +181,340 @@ (by-out size byte) (by-out size nb)))))) (delete-file file-name))) (loop for size from 2 to 40 do (bin-stream-test :size size :type 'signed-byte)) + +;;; Check READ-SEQUENCE signals a TYPE-ERROR when the sequence can't +;;; contain a stream element. +;;; +;;; These tests check READ-SEQUENCE correctness, not whether the fast +;;; or slow paths are being taken for each element type. To check the +;;; fast or slow paths, trace ANSI-STREAM-READ-BYTE (slow path) and/or +;;; READ-N-BYTES: +;;; +;;; (trace sb-impl::ansi-stream-read-byte sb-impl::read-n-bytes) +;;; +;;; The order should be ANSI-STREAM-READ-BYTE, READ-N-BYTES, +;;; READ-N-BYTES, ANSI-STREAM-READ-BYTE, ANSI-STREAM-READ-BYTE. + +(let ((pathname "read-sequence.data")) + + ;; Create the binary data. + (with-open-file (stream pathname + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)) + (write-byte 255 stream)) + + ;; Check the slow path for generic vectors. + (let ((sequence (make-array 1))) + (with-open-file (stream pathname + :direction :input + :element-type '(unsigned-byte 8)) + (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)))) + (with-open-file (stream pathname + :direction :input + :element-type '(unsigned-byte 8)) + (read-sequence sequence stream) + (assert (equalp sequence #(255))))) + + (let ((sequence (make-array 1 :element-type '(signed-byte 8)))) + (with-open-file (stream pathname + :direction :input + :element-type '(signed-byte 8)) + (read-sequence sequence stream) + (assert (equalp sequence #(-1))))) + + ;; 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 + :direction :input + :element-type :default) + (read-sequence sequence stream) + (assert (equalp sequence #(255))))) + + (let ((sequence (make-array 1 :element-type 'character))) + (with-open-file (stream pathname + :direction :input + :external-format :latin-1 + :element-type :default) + (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. + + (let ((sequence (make-array 1 :element-type '(signed-byte 8)))) + (with-open-file (stream pathname + :direction :input + :element-type '(unsigned-byte 8)) + (handler-case (progn + (read-sequence sequence stream) + (error "READ-SEQUENCE didn't signal an error")) + (type-error (condition) + (assert (= (type-error-datum condition) 255)) + (assert (subtypep (type-error-expected-type condition) + '(signed-byte 8))))))) + + (let ((sequence (make-array 1 :element-type '(unsigned-byte 8)))) + (with-open-file (stream pathname + :direction :input + :element-type '(signed-byte 8)) + (handler-case (progn + (read-sequence sequence stream) + (error "READ-SEQUENCE didn't signal an error")) + (type-error (condition) + (assert (= (type-error-datum condition) -1)) + (assert (subtypep (type-error-expected-type condition) + '(unsigned-byte 8))))))) + + ;; Can't read a signed-byte from a bivalent stream + + (let ((sequence (make-array 1 :element-type '(signed-byte 8)))) + (with-open-file (stream pathname + :direction :input + :external-format :latin1 + :element-type :default) + (handler-case (progn + (read-sequence sequence stream) + (error "READ-SEQUENCE didn't signal an error")) + (type-error (condition) + (assert (eql (type-error-datum condition) (code-char 255))) + (assert (subtypep (type-error-expected-type condition) + '(signed-byte 8))))))) + (delete-file pathname)) + +;;; Check WRITE-SEQUENCE signals a TYPE-ERROR when the stream can't +;;; write a sequence element. +;;; +;;; These tests check WRITE-SEQUENCE correctness, not whether the fast +;;; or slow paths are being taken for each element type. See the +;;; READ-SEQUENCE tests above for more information. +;;; +;;; (trace sb-impl::output-unsigned-byte-full-buffered sb-impl::output-signed-byte-full-buffered sb-impl::output-raw-bytes) + +(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 + :element-type '(unsigned-byte 8) + :initial-contents '(255))) + (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 + :if-exists :supersede + :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 + :if-exists :supersede + :element-type '(unsigned-byte 8)) + (write-sequence unsigned-sequence stream)) + (with-open-file (stream pathname + :direction :output + :if-exists :supersede + :element-type '(signed-byte 8)) + (write-sequence signed-sequence stream)) + + ;; Bivalent streams on unsigned-byte vectors, strings, and a simple + ;; vector with mixed characters and bytes + + (with-open-file (stream pathname + :direction :output + :if-exists :supersede + :element-type :default) + (write-sequence unsigned-sequence stream)) + + (with-open-file (stream pathname + :direction :output + :external-format :latin-1 + :if-exists :supersede + :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 + :direction :output + :if-exists :supersede + :element-type '(signed-byte 8)) + (handler-case (progn + (write-sequence unsigned-sequence stream) + (error "WRITE-SEQUENCE didn't signal an error")) + (type-error (condition) + (assert (= (type-error-datum condition) 255)) + (assert (subtypep (type-error-expected-type condition) + '(signed-byte 8)))))) + + (with-open-file (stream pathname + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)) + (handler-case (progn + (write-sequence signed-sequence stream) + (error "WRITE-SEQUENCE didn't signal an error")) + (type-error (condition) + (assert (= (type-error-datum condition) -1)) + (assert (subtypep (type-error-expected-type condition) + '(unsigned-byte 8)))))) + + (with-open-file (stream pathname + :direction :output + :if-exists :supersede + :element-type :default) + (handler-case (progn + (write-sequence signed-sequence stream) + (error "WRITE-SEQUENCE didn't signal an error")) + (type-error (condition) + (assert (= (type-error-datum condition) -1)) + (assert (subtypep (type-error-expected-type condition) + '(unsigned-byte 8)))))) + + (delete-file pathname)) + +;;; writing looong lines. takes way too long and way too much space +;;; to test on 64 bit platforms +#-#.(cl:if (cl:= sb-vm:n-word-bits 64) '(and) '(or)) +(progn + (defun write-n-chars (n stream) + (format t "~&/writing ~D chars on a single line~%" n) + (finish-output t) + (loop repeat n + do (write-char #\x stream)) + (terpri stream) + n) + + (let ((test "long-lines-write-test.tmp")) + (unwind-protect + (with-open-file (f test + :direction :output + :external-format :ascii + :element-type 'character + :if-does-not-exist :create + :if-exists :supersede) + (write-n-chars (+ most-positive-fixnum 7) f)) + (when (probe-file test) + (delete-file test))))) + +;;; read-sequence misreported the amount read and lost position +(let ((string (make-array (* 3 sb-impl::+ansi-stream-in-buffer-length+) + :element-type 'character))) + (dotimes (i (length string)) + (setf (char string i) (code-char (mod i char-code-limit)))) + (with-open-file (f "read-sequence-character-test-data.tmp" + :if-exists :supersede + :direction :output + :external-format :utf-8) + (write-sequence string f)) + (let ((copy + (with-open-file (f "read-sequence-character-test-data.tmp" + :if-does-not-exist :error + :direction :input + :external-format :utf-8) + (let ((buffer (make-array 128 :element-type 'character)) + (total 0)) + (with-output-to-string (datum) + (loop for n-read = (read-sequence buffer f) + do (write-sequence buffer datum :start 0 :end n-read) + (assert (<= (incf total n-read) (length string))) + while (and (= n-read 128)))))))) + (assert (equal copy string))) + (delete-file "read-sequence-character-test-data.tmp")) + +;;; ANSI-STREAM-OUTPUT-STREAM-P used to assume that a SYNONYM-STREAM's +;;; target was an ANSI stream, but it could be a user-defined stream, +;;; e.g., a SLIME stream. +(defclass user-output-stream (fundamental-output-stream) + ()) + +(let ((*stream* (make-instance 'user-output-stream))) + (declare (special *stream*)) + (with-open-stream (stream (make-synonym-stream '*stream*)) + (assert (output-stream-p stream)))) + +(defclass user-input-stream (fundamental-input-stream) + ()) + +(let ((*stream* (make-instance 'user-input-stream))) + (declare (special *stream*)) + (with-open-stream (stream (make-synonym-stream '*stream*)) + (assert (input-stream-p stream)))) + +;;; READ-LINE on ANSI-STREAM did not return T for the last line +;;; (reported by Yoshinori Tahara) +(let ((pathname "test-read-line-eol")) + (with-open-file (out pathname :direction :output :if-exists :supersede) + (format out "a~%b")) + (let ((result (with-open-file (in pathname) + (list (multiple-value-list (read-line in nil nil)) + (multiple-value-list (read-line in nil nil)) + (multiple-value-list (read-line in nil nil)))))) + (delete-file pathname) + (assert (equal result '(("a" nil) ("b" t) (nil t)))))) + +;;; READ-LINE used to work on closed streams because input buffers were left in place +(with-test (:name :bug-425) + ;; Normal close + (let ((f (open "stream.impure.lisp" :direction :input))) + (assert (stringp (read-line f))) + (close f) + (assert (eq :fii + (handler-case + (read-line f) + (sb-int:closed-stream-error () :fii))))) + ;; Abort + (let ((f (open "stream.impure.lisp" :direction :input))) + (assert (stringp (read-line f nil nil))) + (close f :abort t) + (assert (eq :faa + (handler-case + (read-line f) + (sb-int:closed-stream-error () :faa)))))) + ;;; success