X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.pure.lisp;h=64747589710aa492c667c2af521e725f46fe5179;hb=69ef68ba7393e3492c1b4a756d1140f71c2922bc;hp=d1f52f8ef79cd34582e1d2defb53c6ca7334c8f9;hpb=24407d11d34abdaaef6d839fd0b2665c73b0e6d5;p=sbcl.git diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index d1f52f8..6474758 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,199 @@ (get-output-stream-string out-stream)) ;; (Before the fix, the LET* expression just signalled an error.) "a")) + +;;; 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")))