;;;; tests related to Lisp streams ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. ;;;; ;;;; While most of SBCL is derived from the CMU CL system, the test ;;;; files (like this one) were written from scratch after the fork ;;;; from CMU CL. ;;;; ;;;; This software is in the public domain and is provided with ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. (in-package :cl-user) ;;; Until sbcl-0.6.11.31, we didn't have an N-BIN method for ;;; 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)) ;;; test for the new N-BIN method doing what it's supposed to (let* ((substrings (list "This " "is " "a " "" "test of concatenated streams behaving " "as ordinary streams do under READ-SEQUENCE. " (make-string 140041 :initial-element #\%) "For any size of read.." (make-string 4123 :initial-element #\.) "they should give the same results." (make-string (expt 2 14) :initial-element #\*) "There should be no differences.")) (substreams (mapcar #'make-string-input-stream substrings)) (concatenated-stream (apply #'make-concatenated-stream substreams)) (concatenated-string (apply #'concatenate 'string substrings)) (stream (make-string-input-stream concatenated-string)) (max-n-to-read 24) (buffer-1 (make-string max-n-to-read)) (buffer-2 (make-string max-n-to-read))) (loop (let* ((n-to-read (random max-n-to-read)) (n-actually-read-1 (read-sequence buffer-1 concatenated-stream :end n-to-read)) (n-actually-read-2 (read-sequence buffer-2 stream :end n-to-read))) ;; (format t "buffer-1=~S~%buffer-2=~S~%" buffer-1 buffer-2) (assert (= n-actually-read-1 n-actually-read-2)) (assert (string= buffer-1 buffer-2 :end1 n-actually-read-1 :end2 n-actually-read-2)) (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 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")))