X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.pure.lisp;h=50b2126be018014fc4bedcbf4df502ea5085ddff;hb=cf49f2d086069a9c1b57f501df9a6a0bd3a34c3c;hp=127333b5c5ef6fc87056595e543ffc419c76ec2a;hpb=954902abeb19dac4f79f0a5b800eac45179b8d7c;p=sbcl.git diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp index 127333b..50b2126 100644 --- a/tests/stream.pure.lisp +++ b/tests/stream.pure.lisp @@ -6,7 +6,7 @@ ;;;; 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. @@ -20,14 +20,14 @@ (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.")) + "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)) @@ -37,17 +37,17 @@ (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))) + (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)) + :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))))) @@ -55,24 +55,58 @@ ;;; 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")) + (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")) + (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")) +;;; ... and yet, a little over 6 years on, echo-streams were still +;;; broken when a read-char followed the unread/peek sequence. Do +;;; people not actually use echo-streams? RMK, 2009-04-02. +(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 nil echo-stream) + (read-char echo-stream) + (get-output-stream-string out-stream)) + ;; before ca. 1.0.27.18, the LET* returned "aa" + "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. @@ -122,11 +156,11 @@ ;;; MAKE-STRING-OUTPUT-STREAM ;;; ;;; * Observe FILE-POSITION :START and :END, and allow setting of -;;; FILE-POSITION to an arbitrary index. +;;; 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. +;;; the string/stream with uninitialized elements. ;;; ;;; * Rewinding the stream works with overwriting semantics. ;;; @@ -160,18 +194,19 @@ ;;; 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. +;;; 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. +;;; * Rewinding the stream works with overwriting semantics. ;;; #+nil (let ((str (make-array 0 - :element-type 'character - :adjustable nil - :fill-pointer t))) + :element-type 'character + :adjustable nil + :fill-pointer t))) (with-output-to-string (stream str) (princ "abcd" stream) (assert (= 4 (file-position stream))) @@ -193,9 +228,9 @@ (assert (equal "0b2d" str)))) (let ((str (make-array 0 - :element-type 'character - :adjustable nil - :fill-pointer t))) + :element-type 'character + :adjustable nil + :fill-pointer t))) (with-output-to-string (stream str) (princ "abcd" stream) (assert (= 4 (file-position stream))) @@ -222,19 +257,115 @@ ;;; 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))))))) + `(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 #-win32 "/dev/null" #+win32 "nul" :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"))) + +(with-standard-io-syntax + (open #-win32 "/dev/null" #+win32 "nul" )) + +;;; PEEK-CHAR T uses whitespace[2] +(let ((*readtable* (copy-readtable))) + (assert (char= (peek-char t (make-string-input-stream " a")) #\a)) + (set-syntax-from-char #\Space #\a) + (assert (char= (peek-char t (make-string-input-stream " a")) #\Space))) + +;;; It is actually easier to run into the problem exercised by this +;;; test with sockets, due to their delays between availabilities of +;;; data. However edgy the case may be for normal files, however, +;;; there is still a case to be found in which CL:LISTEN answers +;;; improperly. +;;; +;;; This test assumes that buffering is still done until a buffer of +;;; SB-IMPL::+BYTES-PER-BUFFER+ bytes is filled up, that the buffer may +;;; immediately be completely filled for normal files, and that the +;;; buffer-fill routine is responsible for figuring out when we've +;;; reached EOF. +(with-test (:name (stream :listen-vs-select) :fails-on :win32) + (let ((listen-testfile-name "stream.impure.lisp.testqfile") + ;; If non-NIL, size (in bytes) of the file that will exercise + ;; the LISTEN problem. + (bytes-per-buffer-sometime + (and (boundp 'sb-impl::+bytes-per-buffer+) + (symbol-value 'sb-impl::+bytes-per-buffer+)))) + (when bytes-per-buffer-sometime + (unwind-protect + (progn + (with-open-file (stream listen-testfile-name + :direction :output :if-exists :error + :element-type '(unsigned-byte 8)) + (dotimes (n bytes-per-buffer-sometime) + (write-byte 113 stream))) + (with-open-file (stream listen-testfile-name + :direction :input :element-type '(unsigned-byte 8)) + (dotimes (n bytes-per-buffer-sometime) + (read-byte stream)) + (assert (not (listen stream))))) + (ignore-errors (delete-file listen-testfile-name)))))) + +(with-test (:name :bug-395) + (let ((v (make-array 5 :fill-pointer 0 :element-type 'standard-char))) + (format v "foo") + (assert (equal (coerce "foo" 'base-string) v)))) + +;;; Circa 1.0.27.18, echo-streams were changed somewhat, so that +;;; unread-char on an echo-stream propagated the character down to the +;;; echo-stream's input stream. (All other implementations but CMUCL +;;; seemed to do this). The most useful argument for this behavior +;;; involves cases where an input operation on an echo-stream finishes +;;; up by unreading a delimiter, and the user wants to proceed to use the +;;; underlying stream, e.g., +(assert (equal + (with-input-from-string (in "foo\"bar\"") + (with-open-stream (out (make-broadcast-stream)) + (with-open-stream (echo (make-echo-stream in out)) + (read echo))) + (read in)) + ;; Before ca 1.0.27.18, the implicit UNREAD-CHAR at the end of + ;; the first READ wouldn't get back to IN, so the second READ + ;; returned BAR, not "BAR" (and then subsequent reads would + ;; lose). + "bar"))