X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.pure.lisp;h=127333b5c5ef6fc87056595e543ffc419c76ec2a;hb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;hp=845c87e2d11cce9c039b3fce06a3a9848cd1e281;hpb=f3ea7a91cddd3ce35290ddd4e54abbe8a7a3a452;p=sbcl.git diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index 845c87e..127333b 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 #\] @@ -61,3 +61,180 @@ (make-string-input-stream "ab cd e df s]") out))) ;; (Before the fix, the result had a trailing #\] in it.) "ab cd e df s")) +;;; ...and a missing wrinkle in the original patch, dealing with +;;; PEEK-CHAR/UNREAD-CHAR on ECHO-STREAMs, fixed by MRD patch +;;; sbcl-devel 2002-11-18, merged ca. sbcl-0.7.9.66 +(assert (string= + (let* ((in-stream (make-string-input-stream "abc")) + (out-stream (make-string-output-stream)) + (echo-stream (make-echo-stream in-stream out-stream))) + (unread-char (read-char echo-stream) echo-stream) + (peek-char #\a echo-stream) + (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 owerwriting 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))