X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.pure.lisp;h=127333b5c5ef6fc87056595e543ffc419c76ec2a;hb=64ec717cf13c44fb4571c1fd7fbd508551ecfe01;hp=f62da092b89fc6d8234c2ca6b1d115706bf5e388;hpb=b4dcc81361b084a1ed9e3212ae4abbb174720780;p=sbcl.git diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index f62da09..127333b 100644 --- a/tests/stream.pure.lisp +++ b/tests/stream.pure.lisp @@ -14,7 +14,7 @@ (in-package :cl-user) ;;; Until sbcl-0.6.11.31, we didn't have an N-BIN method for -;;; CONCATENATED-STRING, so stuff like this would fail. +;;; CONCATENATED-STREAM, so stuff like this would fail. (let ((stream (make-concatenated-stream (make-string-input-stream "Demo"))) (buffer (make-string 4))) (read-sequence buffer stream)) @@ -51,3 +51,190 @@ (unless (= n-actually-read-1 n-to-read) (assert (< n-actually-read-1 n-to-read)) (return))))) + +;;; Entomotomy PEEK-CHAR-WRONGLY-ECHOS-TO-ECHO-STREAM bug, fixed by +;;; MRD patch sbcl-devel 2002-11-02 merged ca. sbcl-0.7.9.32... +(assert (string= + (with-output-to-string (out) + (peek-char #\] + (make-echo-stream + (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))