X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.impure.lisp;h=adf3986e7ba077b0d97cdf531d00b4b5c22ecf81;hb=4400b14fd1204e0afe89a37e9235dd3e5e31792b;hp=e7036b2c247e840a8602b3945c2fe0c76d7f66d1;hpb=c7c7bab2b37d8b9fbda8f955f09540db17573afa;p=sbcl.git diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp index e7036b2..adf3986 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 @@ -209,6 +212,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 +236,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 +254,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. @@ -275,15 +294,16 @@ (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 (= (type-error-datum condition) 255)) + (assert (eql (type-error-datum condition) (code-char 255))) (assert (subtypep (type-error-expected-type condition) - '(signed-byte 8)))))))) - + '(signed-byte 8))))))) + (delete-file pathname)) ;;; Check WRITE-SEQUENCE signals a TYPE-ERROR when the stream can't ;;; write a sequence element. @@ -296,6 +316,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 +326,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 +336,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 +355,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 +371,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 @@ -375,6 +414,197 @@ (type-error (condition) (assert (= (type-error-datum condition) -1)) (assert (subtypep (type-error-expected-type condition) - '(unsigned-byte 8))))))) + '(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)) +(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) + (let* ((n (truncate most-positive-fixnum 16)) + (m 18) + (p (* n m)) + (buffer (make-string n))) + (dotimes (i m) + (write-char #\.) + (finish-output) + (write-sequence buffer f)) + (assert (= p (sb-impl::fd-stream-char-pos f))) + (write-char #\! f) + (assert (= (+ 1 p) (sb-impl::fd-stream-char-pos f))) + (assert (typep p 'bignum)))) + (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)))))) + +(with-test (:name :regression-1.0.12.22) + (with-open-file (s "stream.impure.lisp" :direction :input) + (let ((buffer (make-string 20))) + (assert (= 2 (read-sequence buffer s :start 0 :end 2))) + (assert (= 3 (read-sequence buffer s :start 2 :end 3))) + (file-position s :end) + (assert (= 3 (read-sequence buffer s :start 3)))))) + +;;; In 1.0.27 (and also 0.9.16; presumably in between, too), binary +;;; input operations on a bivalent stream did something bad after +;;; unread-char: READ-BYTE would return the character, and +;;; READ-SEQUENCE into a byte buffer would lose when attempting to +;;; store the character in the vector. +(let ((pathname "bivalent-stream-unread-char-test.tmp")) + (with-open-file (s pathname + :element-type :default + :direction :io :if-exists :rename) + (write-char #\a s) + (file-position s :start) + (unread-char (read-char s) s) + (assert (integerp (read-byte s)))) + (delete-file pathname)) + +(let ((pathname "bivalent-stream-unread-char-test.tmp")) + (with-open-file (s pathname + :element-type :default + :direction :io :if-exists :rename) + (write-char #\a s) + (file-position s :start) + (unread-char (read-char s) s) + (assert (let ((buffer (make-array 10 :element-type '(unsigned-byte 8)))) + (read-sequence buffer s)))) + (delete-file pathname)) + +#+sb-unicode +(let ((pathname "bivalent-stream-unread-char-test.tmp")) + (with-open-file (s pathname + :element-type :default + :direction :io :if-exists :rename + :external-format :utf8) + (write-char (code-char 192) s) + (file-position s :start) + (unread-char (read-char s) s) + (assert (integerp (read-byte s)))) + (delete-file pathname)) + +#+sb-unicode +(let ((pathname "bivalent-stream-unread-char-test.tmp")) + (with-open-file (s pathname + :element-type :default + :direction :io :if-exists :rename + :external-format :utf8) + (write-char (code-char 192) s) + (file-position s :start) + (unread-char (read-char s) s) + (assert (let ((buffer (make-array 10 :element-type '(unsigned-byte 8)))) + (read-sequence buffer s)))) + (delete-file pathname)) + +(with-test (:name :delete-file-on-streams) + (with-open-file (f "delete-file-on-stream-test.tmp" + :direction :io) + (delete-file f) + #-win32 + (progn + (write-line "still open" f) + (file-position f :start) + (assert (equal "still open" (read-line f))))) + (assert (not (probe-file "delete-file-on-stream-test.tmp")))) + +;;; READ-CHAR-NO-HANG on bivalent streams (as returned by RUN-PROGRAM) +;;; was wrong. CSR managed to promote the wrongness to all streams in +;;; the 1.0.32.x series, breaking slime instantly. +(with-test (:name :read-char-no-hang-after-unread-char) + (let* ((process (run-program "/bin/sh" '("-c" "echo a && sleep 10") + :output :stream :wait nil)) + (stream (process-output process)) + (char (read-char stream))) + (assert (char= char #\a)) + (unread-char char stream) + (assert (char= (read-char stream) #\a)) + (assert (char= (read-char stream) #\Newline)) + (let ((time (get-universal-time))) + ;; no input, not yet known to be at EOF: should return + ;; immediately + (read-char-no-hang stream) + (assert (< (- (get-universal-time) time) 2))))) ;;; success