X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.impure.lisp;h=adf3986e7ba077b0d97cdf531d00b4b5c22ecf81;hb=57eae6573811f44abe167a9015116d95371543bb;hp=bc069b790a8647453eb03341d73c075077d5bc37;hpb=da8cb4801a3ab35070f380e22aea3d260f9df8aa;p=sbcl.git diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp index bc069b7..adf3986 100644 --- a/tests/stream.impure.lisp +++ b/tests/stream.impure.lisp @@ -415,22 +415,13 @@ (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")) +(let ((test "long-lines-write-test.tmp")) (unwind-protect (with-open-file (f test :direction :output @@ -438,8 +429,182 @@ :element-type 'character :if-does-not-exist :create :if-exists :supersede) - (write-n-chars (+ most-positive-fixnum 7) f)) + (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))))) + (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