X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.pure.lisp;h=120c706e7ba6dd7300b4c5abcf0a2bf09dc99151;hb=2253ebaef8a0a1527d2282a1c10f48c62e0d4a83;hp=016b31c413b413455db47e2e5ff9250eead741c4;hpb=d4e550ede8beccef4312e621a644b89f9d76f74d;p=sbcl.git diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index 016b31c..120c706 100644 --- a/tests/stream.pure.lisp +++ b/tests/stream.pure.lisp @@ -74,6 +74,27 @@ ;; (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 "") @@ -91,14 +112,181 @@ ;;; Ideas? #+nil (assert (eq (interactive-stream-p *terminal-io*) t)) -;;; FILE-POSITION on string-input-streams should work, even with -;;; :START or :END new positions. -(let ((stream (make-string-input-stream "abc"))) - (assert (char= (read-char stream) #\a)) - (assert (= (file-position stream) 1)) - (assert (file-position stream 0)) +;;; 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 (char= (read-char stream) #\a)) + (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 (eq (read-char stream nil 'foo) 'foo))) + (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")))