1 ;;;; tests related to Lisp streams
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
16 ;;; Until sbcl-0.6.11.31, we didn't have an N-BIN method for
17 ;;; CONCATENATED-STREAM, so stuff like this would fail.
18 (let ((stream (make-concatenated-stream (make-string-input-stream "Demo")))
19 (buffer (make-string 4)))
20 (read-sequence buffer stream
))
21 ;;; test for the new N-BIN method doing what it's supposed to
22 (let* ((substrings (list "This " "is " "a " ""
23 "test of concatenated streams behaving "
24 "as ordinary streams do under READ-SEQUENCE. "
25 (make-string 140041 :initial-element
#\%
)
26 "For any size of read.."
27 (make-string 4123 :initial-element
#\.
)
28 "they should give the same results."
29 (make-string (expt 2 14) :initial-element
#\
*)
30 "There should be no differences."))
31 (substreams (mapcar #'make-string-input-stream substrings
))
32 (concatenated-stream (apply #'make-concatenated-stream substreams
))
33 (concatenated-string (apply #'concatenate
'string substrings
))
34 (stream (make-string-input-stream concatenated-string
))
36 (buffer-1 (make-string max-n-to-read
))
37 (buffer-2 (make-string max-n-to-read
)))
39 (let* ((n-to-read (random max-n-to-read
))
40 (n-actually-read-1 (read-sequence buffer-1
43 (n-actually-read-2 (read-sequence buffer-2
46 ;; (format t "buffer-1=~S~%buffer-2=~S~%" buffer-1 buffer-2)
47 (assert (= n-actually-read-1 n-actually-read-2
))
48 (assert (string= buffer-1 buffer-2
49 :end1 n-actually-read-1
50 :end2 n-actually-read-2
))
51 (unless (= n-actually-read-1 n-to-read
)
52 (assert (< n-actually-read-1 n-to-read
))
55 ;;; Entomotomy PEEK-CHAR-WRONGLY-ECHOS-TO-ECHO-STREAM bug, fixed by
56 ;;; MRD patch sbcl-devel 2002-11-02 merged ca. sbcl-0.7.9.32...
58 (with-output-to-string (out)
61 (make-string-input-stream "ab cd e df s]") out
)))
62 ;; (Before the fix, the result had a trailing #\] in it.)
64 ;;; ...and a missing wrinkle in the original patch, dealing with
65 ;;; PEEK-CHAR/UNREAD-CHAR on ECHO-STREAMs, fixed by MRD patch
66 ;;; sbcl-devel 2002-11-18, merged ca. sbcl-0.7.9.66
68 (let* ((in-stream (make-string-input-stream "abc"))
69 (out-stream (make-string-output-stream))
70 (echo-stream (make-echo-stream in-stream out-stream
)))
71 (unread-char (read-char echo-stream
) echo-stream
)
72 (peek-char #\a echo-stream
)
73 (get-output-stream-string out-stream
))
74 ;; (Before the fix, the LET* expression just signalled an error.)
77 ;;; 0.7.12 doesn't advance current stream in concatenated streams
78 ;;; correctly when searching a stream for a char to read.
79 (with-input-from-string (p "")
80 (with-input-from-string (q "foo")
81 (let* ((r (make-concatenated-stream p q
)))
84 ;;; 0.7.14 and previous SBCLs don't have a working INTERACTIVE-STREAM-P
85 ;;; because it called UNIX-ISATTY, which wasn't defined.
86 (with-input-from-string (s "a non-interactive stream")
87 (assert (not (interactive-stream-p s
))))
88 ;;; KLUDGE: Unfortunately it's hard to find a reliably interactive
89 ;;; stream to test, since it's reasonable for these tests to be run
90 ;;; from a script, conceivably even as something like a cron job.
92 #+nil
(assert (eq (interactive-stream-p *terminal-io
*) t
))
94 ;;; MAKE-STRING-INPUT-STREAM
96 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
97 ;;; FILE-POSITION beyond the end of string, signalling END-OF-FILE only
99 (let* ((string (copy-seq "abc"))
100 (stream (make-string-input-stream string
)))
101 (assert (char= (read-char stream
) #\a))
102 (assert (= 1 (file-position stream
)))
103 (assert (file-position stream
:start
))
104 (assert (= 0 (file-position stream
)))
105 (assert (file-position stream
:end
))
106 (assert (= (length string
) (file-position stream
)))
107 (assert (file-position stream
(1- (file-position stream
))))
108 (assert (char= (read-char stream
) #\c
))
109 (assert (file-position stream
(1- (file-position stream
))))
110 (assert (char= (read-char stream
) #\c
))
111 (assert (file-position stream
:end
))
112 (let ((eof (cons nil nil
)))
113 (assert (eq (read-char stream nil eof
) eof
)))
114 (assert (file-position stream
10))
115 (multiple-value-bind (val cond
) (ignore-errors (file-position stream -
1))
117 (assert (typep cond
'error
)))
118 (multiple-value-bind (val cond
) (ignore-errors (read-char stream
))
120 (assert (typep cond
'end-of-file
))))
122 ;;; MAKE-STRING-OUTPUT-STREAM
124 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
125 ;;; FILE-POSITION to an arbitrary index.
127 ;;; * END will always refer to the farthest position of stream so-far
128 ;;; seen, and setting FILE-POSITION beyond the current END will extend
129 ;;; the string/stream with uninitialized elements.
131 ;;; * Rewinding the stream works with overwriting semantics.
133 (let ((stream (make-string-output-stream)))
134 (princ "abcd" stream
)
135 (assert (= 4 (file-position stream
)))
136 (assert (file-position stream
:start
))
137 (assert (= 0 (file-position stream
)))
139 (assert (= 1 (file-position stream
)))
140 (file-position stream
2)
141 (assert (= 2 (file-position stream
)))
143 (assert (file-position stream
:end
))
144 (assert (= 4 (file-position stream
)))
145 (assert (file-position stream
6))
146 (assert (file-position stream
4))
147 (assert (file-position stream
:end
))
148 (assert (= 6 (file-position stream
)))
149 (assert (file-position stream
4))
150 (multiple-value-bind (val cond
) (ignore-errors (file-position stream -
1))
152 (assert (typep cond
'error
)))
154 (assert (equal "0b2d!!" (get-output-stream-string stream
))))
156 ;;; WITH-OUTPUT-TO-STRING (when provided with a string argument)
158 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
159 ;;; FILE-POSITION to an arbitrary index. If the new position is beyond
160 ;;; the end of string and the string is adjustable the string will be
161 ;;; implicitly extended, otherwise an error will be signalled. The
162 ;;; latter case is provided for in the code, but not currently
163 ;;; excercised since SBCL fill-pointer arrays are always (currently) adjustable.
165 ;;; * END will refer to the ARRAY-TOTAL-SIZE of string, not
166 ;;; FILL-POINTER, since by definition the FILE-POSITION will always be
167 ;;; a FILL-POINTER, so that would be of limited use.
169 ;;; * Rewinding the stream works with owerwriting semantics.
171 #+nil
(let ((str (make-array 0
172 :element-type
'character
175 (with-output-to-string (stream str
)
176 (princ "abcd" stream
)
177 (assert (= 4 (file-position stream
)))
178 (assert (file-position stream
:start
))
179 (assert (= 0 (file-position stream
)))
181 (assert (= 1 (file-position stream
)))
182 (file-position stream
2)
183 (assert (= 2 (file-position stream
)))
185 (assert (file-position stream
:end
))
186 (assert (= 4 (file-position stream
)))
187 (multiple-value-bind (val cond
) (ignore-errors (file-position stream -
1))
189 (assert (typep cond
'error
)))
190 (multiple-value-bind (val cond
) (ignore-errors (file-position stream
6))
192 (assert (typep cond
'error
)))
193 (assert (equal "0b2d" str
))))
195 (let ((str (make-array 0
196 :element-type
'character
199 (with-output-to-string (stream str
)
200 (princ "abcd" stream
)
201 (assert (= 4 (file-position stream
)))
202 (assert (file-position stream
:start
))
203 (assert (= 0 (file-position stream
)))
205 (assert (= 1 (file-position stream
)))
206 (file-position stream
2)
207 (assert (= 2 (file-position stream
)))
209 (assert (file-position stream
:end
))
210 (assert (= 4 (file-position stream
)))
211 (assert (file-position stream
6))
212 (assert (file-position stream
4))
213 (assert (file-position stream
:end
))
214 (assert (= 6 (file-position stream
)))
215 (assert (file-position stream
4))
216 (multiple-value-bind (val cond
) (ignore-errors (file-position stream -
1))
218 (assert (typep cond
'error
)))
220 (assert (equal "0b2d!!" str
))))
222 ;;; MAKE-STRING-OUTPUT-STREAM and WITH-OUTPUT-TO-STRING take an
223 ;;; :ELEMENT-TYPE keyword argument
224 (macrolet ((frob (element-type-form)
226 (let ((s (with-output-to-string
227 (s nil
,@(when element-type-form
228 `(:element-type
,element-type-form
))))))
229 (assert (typep s
'(simple-array ,(if element-type-form
230 (eval element-type-form
)
233 (get-output-stream-string
234 (make-string-output-stream
235 ,@(when element-type-form
236 `(:element-type
,element-type-form
)))))))