X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.pure.lisp;h=ace7840c3f34de34f90fb7782306694ce8c72e43;hb=1714224f33ba559eab11af8827a78f9a5aebd698;hp=d1f52f8ef79cd34582e1d2defb53c6ca7334c8f9;hpb=24407d11d34abdaaef6d839fd0b2665c73b0e6d5;p=sbcl.git diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index d1f52f8..ace7840 100644 --- a/tests/stream.pure.lisp +++ b/tests/stream.pure.lisp @@ -53,7 +53,7 @@ (return))))) ;;; Entomotomy PEEK-CHAR-WRONGLY-ECHOS-TO-ECHO-STREAM bug, fixed by -;;; by MRD patch sbcl-devel 2002-11-02 merged ca. sbcl-0.7.9.32... +;;; MRD patch sbcl-devel 2002-11-02 merged ca. sbcl-0.7.9.32... (assert (string= (with-output-to-string (out) (peek-char #\] @@ -73,3 +73,223 @@ (get-output-stream-string out-stream)) ;; (Before the fix, the LET* expression just signalled an error.) "a")) + +;;; Reported by Fredrik Sandstrom to sbcl-devel 2005-05-17 ("Bug in +;;; peek-char"): +;;; Description: In (peek-char nil s nil foo), if foo happens to be +;;; the same character that peek-char returns, the character is +;;; removed from the input stream, as if read by read-char. +(assert (equal (with-input-from-string (s "123") + (list (peek-char nil s nil #\1) (read-char s) (read-char s))) + '(#\1 #\1 #\2))) + +;;; ... and verify that the fix does not break echo streams +(assert (string= (let ((out (make-string-output-stream))) + (with-open-stream (s (make-echo-stream + (make-string-input-stream "123") + out)) + (format s "=>~{~A~}" + (list (peek-char nil s nil #\1) + (read-char s) + (read-char s))) + (get-output-stream-string out))) + "12=>112")) + +;;; 0.7.12 doesn't advance current stream in concatenated streams +;;; correctly when searching a stream for a char to read. +(with-input-from-string (p "") + (with-input-from-string (q "foo") + (let* ((r (make-concatenated-stream p q))) + (peek-char nil r)))) + +;;; 0.7.14 and previous SBCLs don't have a working INTERACTIVE-STREAM-P +;;; because it called UNIX-ISATTY, which wasn't defined. +(with-input-from-string (s "a non-interactive stream") + (assert (not (interactive-stream-p s)))) +;;; KLUDGE: Unfortunately it's hard to find a reliably interactive +;;; stream to test, since it's reasonable for these tests to be run +;;; from a script, conceivably even as something like a cron job. +;;; Ideas? +#+nil (assert (eq (interactive-stream-p *terminal-io*) t)) + +;;; MAKE-STRING-INPUT-STREAM +;;; +;;; * Observe FILE-POSITION :START and :END, and allow setting of +;;; FILE-POSITION beyond the end of string, signalling END-OF-FILE only +;;; on read. +(let* ((string (copy-seq "abc")) + (stream (make-string-input-stream string))) + (assert (char= (read-char stream) #\a)) + (assert (= 1 (file-position stream))) + (assert (file-position stream :start)) + (assert (= 0 (file-position stream))) + (assert (file-position stream :end)) + (assert (= (length string) (file-position stream))) + (assert (file-position stream (1- (file-position stream)))) + (assert (char= (read-char stream) #\c)) + (assert (file-position stream (1- (file-position stream)))) + (assert (char= (read-char stream) #\c)) + (assert (file-position stream :end)) + (let ((eof (cons nil nil))) + (assert (eq (read-char stream nil eof) eof))) + (assert (file-position stream 10)) + (multiple-value-bind (val cond) (ignore-errors (file-position stream -1)) + (assert (null val)) + (assert (typep cond 'error))) + (multiple-value-bind (val cond) (ignore-errors (read-char stream)) + (assert (null val)) + (assert (typep cond 'end-of-file)))) + +;;; MAKE-STRING-OUTPUT-STREAM +;;; +;;; * Observe FILE-POSITION :START and :END, and allow setting of +;;; FILE-POSITION to an arbitrary index. +;;; +;;; * END will always refer to the farthest position of stream so-far +;;; seen, and setting FILE-POSITION beyond the current END will extend +;;; the string/stream with uninitialized elements. +;;; +;;; * Rewinding the stream works with overwriting semantics. +;;; +(let ((stream (make-string-output-stream))) + (princ "abcd" stream) + (assert (= 4 (file-position stream))) + (assert (file-position stream :start)) + (assert (= 0 (file-position stream))) + (princ "0" stream) + (assert (= 1 (file-position stream))) + (file-position stream 2) + (assert (= 2 (file-position stream))) + (princ "2" stream) + (assert (file-position stream :end)) + (assert (= 4 (file-position stream))) + (assert (file-position stream 6)) + (assert (file-position stream 4)) + (assert (file-position stream :end)) + (assert (= 6 (file-position stream))) + (assert (file-position stream 4)) + (multiple-value-bind (val cond) (ignore-errors (file-position stream -1)) + (assert (null val)) + (assert (typep cond 'error))) + (princ "!!" stream) + (assert (equal "0b2d!!" (get-output-stream-string stream)))) + +;;; WITH-OUTPUT-TO-STRING (when provided with a string argument) +;;; +;;; * Observe FILE-POSITION :START and :END, and allow setting of +;;; FILE-POSITION to an arbitrary index. If the new position is beyond +;;; the end of string and the string is adjustable the string will be +;;; implicitly extended, otherwise an error will be signalled. The +;;; latter case is provided for in the code, but not currently +;;; excercised since SBCL fill-pointer arrays are always (currently) +;;; adjustable. +;;; +;;; * END will refer to the ARRAY-TOTAL-SIZE of string, not +;;; FILL-POINTER, since by definition the FILE-POSITION will always be +;;; a FILL-POINTER, so that would be of limited use. +;;; +;;; * Rewinding the stream works with overwriting semantics. +;;; +#+nil (let ((str (make-array 0 + :element-type 'character + :adjustable nil + :fill-pointer t))) + (with-output-to-string (stream str) + (princ "abcd" stream) + (assert (= 4 (file-position stream))) + (assert (file-position stream :start)) + (assert (= 0 (file-position stream))) + (princ "0" stream) + (assert (= 1 (file-position stream))) + (file-position stream 2) + (assert (= 2 (file-position stream))) + (princ "2" stream) + (assert (file-position stream :end)) + (assert (= 4 (file-position stream))) + (multiple-value-bind (val cond) (ignore-errors (file-position stream -1)) + (assert (null val)) + (assert (typep cond 'error))) + (multiple-value-bind (val cond) (ignore-errors (file-position stream 6)) + (assert (null val)) + (assert (typep cond 'error))) + (assert (equal "0b2d" str)))) + +(let ((str (make-array 0 + :element-type 'character + :adjustable nil + :fill-pointer t))) + (with-output-to-string (stream str) + (princ "abcd" stream) + (assert (= 4 (file-position stream))) + (assert (file-position stream :start)) + (assert (= 0 (file-position stream))) + (princ "0" stream) + (assert (= 1 (file-position stream))) + (file-position stream 2) + (assert (= 2 (file-position stream))) + (princ "2" stream) + (assert (file-position stream :end)) + (assert (= 4 (file-position stream))) + (assert (file-position stream 6)) + (assert (file-position stream 4)) + (assert (file-position stream :end)) + (assert (= 6 (file-position stream))) + (assert (file-position stream 4)) + (multiple-value-bind (val cond) (ignore-errors (file-position stream -1)) + (assert (null val)) + (assert (typep cond 'error))) + (princ "!!" stream) + (assert (equal "0b2d!!" str)))) + +;;; MAKE-STRING-OUTPUT-STREAM and WITH-OUTPUT-TO-STRING take an +;;; :ELEMENT-TYPE keyword argument +(macrolet ((frob (element-type-form) + `(progn + (let ((s (with-output-to-string + (s nil ,@(when element-type-form + `(:element-type ,element-type-form)))))) + (assert (typep s '(simple-array ,(if element-type-form + (eval element-type-form) + 'character) + (0))))) + (get-output-stream-string + (make-string-output-stream + ,@(when element-type-form + `(:element-type ,element-type-form))))))) + (frob nil) + (frob 'character) + (frob 'base-char) + (frob 'nil)) + +(with-open-file (s "/dev/null" :element-type '(signed-byte 48)) + (assert (eq :eof (read-byte s nil :eof)))) + +(let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os)) + (sequence (copy-seq "abcdef"))) + (assert (= (read-sequence sequence s) 3)) + (assert (string= sequence "foodef")) + (assert (string= (get-output-stream-string os) "foo"))) + +(let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os)) + (sequence (copy-seq "abcdef"))) + (assert (char= #\f (read-char s))) + (assert (= (read-sequence sequence s) 2)) + (assert (string= sequence "oocdef")) + (assert (string= (get-output-stream-string os) "foo"))) + +(let* ((is (make-string-input-stream "foo")) + (os (make-string-output-stream)) + (s (make-echo-stream is os)) + (sequence (copy-seq "abcdef"))) + (assert (char= #\f (read-char s))) + (unread-char #\f s) + (assert (= (read-sequence sequence s) 3)) + (assert (string= sequence "foodef")) + (assert (string= (get-output-stream-string os) "foo"))) + +(with-standard-io-syntax + (open "/dev/null"))