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.)
76 ;;; ... and yet, a little over 6 years on, echo-streams were still
77 ;;; broken when a read-char followed the unread/peek sequence. Do
78 ;;; people not actually use echo-streams? RMK, 2009-04-02.
80 (let* ((in-stream (make-string-input-stream "abc"))
81 (out-stream (make-string-output-stream))
82 (echo-stream (make-echo-stream in-stream out-stream)))
83 (unread-char (read-char echo-stream) echo-stream)
84 (peek-char nil echo-stream)
85 (read-char echo-stream)
86 (get-output-stream-string out-stream))
87 ;; before ca. 1.0.27.18, the LET* returned "aa"
90 ;;; Reported by Fredrik Sandstrom to sbcl-devel 2005-05-17 ("Bug in
92 ;;; Description: In (peek-char nil s nil foo), if foo happens to be
93 ;;; the same character that peek-char returns, the character is
94 ;;; removed from the input stream, as if read by read-char.
95 (assert (equal (with-input-from-string (s "123")
96 (list (peek-char nil s nil #\1) (read-char s) (read-char s)))
99 ;;; ... and verify that the fix does not break echo streams
100 (assert (string= (let ((out (make-string-output-stream)))
101 (with-open-stream (s (make-echo-stream
102 (make-string-input-stream "123")
105 (list (peek-char nil s nil #\1)
108 (get-output-stream-string out)))
111 ;;; 0.7.12 doesn't advance current stream in concatenated streams
112 ;;; correctly when searching a stream for a char to read.
113 (with-input-from-string (p "")
114 (with-input-from-string (q "foo")
115 (let* ((r (make-concatenated-stream p q)))
118 ;;; 0.7.14 and previous SBCLs don't have a working INTERACTIVE-STREAM-P
119 ;;; because it called UNIX-ISATTY, which wasn't defined.
120 (with-input-from-string (s "a non-interactive stream")
121 (assert (not (interactive-stream-p s))))
122 ;;; KLUDGE: Unfortunately it's hard to find a reliably interactive
123 ;;; stream to test, since it's reasonable for these tests to be run
124 ;;; from a script, conceivably even as something like a cron job.
126 #+nil (assert (eq (interactive-stream-p *terminal-io*) t))
128 ;;; MAKE-STRING-INPUT-STREAM
130 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
131 ;;; FILE-POSITION beyond the end of string, signalling END-OF-FILE only
133 (let* ((string (copy-seq "abc"))
134 (stream (make-string-input-stream string)))
135 (assert (char= (read-char stream) #\a))
136 (assert (= 1 (file-position stream)))
137 (assert (file-position stream :start))
138 (assert (= 0 (file-position stream)))
139 (assert (file-position stream :end))
140 (assert (= (length string) (file-position stream)))
141 (assert (file-position stream (1- (file-position stream))))
142 (assert (char= (read-char stream) #\c))
143 (assert (file-position stream (1- (file-position stream))))
144 (assert (char= (read-char stream) #\c))
145 (assert (file-position stream :end))
146 (let ((eof (cons nil nil)))
147 (assert (eq (read-char stream nil eof) eof)))
148 (assert (file-position stream 10))
149 (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
151 (assert (typep cond 'error)))
152 (multiple-value-bind (val cond) (ignore-errors (read-char stream))
154 (assert (typep cond 'end-of-file))))
156 ;;; MAKE-STRING-OUTPUT-STREAM
158 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
159 ;;; FILE-POSITION to an arbitrary index.
161 ;;; * END will always refer to the farthest position of stream so-far
162 ;;; seen, and setting FILE-POSITION beyond the current END will extend
163 ;;; the string/stream with uninitialized elements.
165 ;;; * Rewinding the stream works with overwriting semantics.
167 (let ((stream (make-string-output-stream)))
168 (princ "abcd" stream)
169 (assert (= 4 (file-position stream)))
170 (assert (file-position stream :start))
171 (assert (= 0 (file-position stream)))
173 (assert (= 1 (file-position stream)))
174 (file-position stream 2)
175 (assert (= 2 (file-position stream)))
177 (assert (file-position stream :end))
178 (assert (= 4 (file-position stream)))
179 (assert (file-position stream 6))
180 (assert (file-position stream 4))
181 (assert (file-position stream :end))
182 (assert (= 6 (file-position stream)))
183 (assert (file-position stream 4))
184 (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
186 (assert (typep cond 'error)))
188 (assert (equal "0b2d!!" (get-output-stream-string stream))))
190 ;;; WITH-OUTPUT-TO-STRING (when provided with a string argument)
192 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
193 ;;; FILE-POSITION to an arbitrary index. If the new position is beyond
194 ;;; the end of string and the string is adjustable the string will be
195 ;;; implicitly extended, otherwise an error will be signalled. The
196 ;;; latter case is provided for in the code, but not currently
197 ;;; excercised since SBCL fill-pointer arrays are always (currently)
200 ;;; * END will refer to the ARRAY-TOTAL-SIZE of string, not
201 ;;; FILL-POINTER, since by definition the FILE-POSITION will always be
202 ;;; a FILL-POINTER, so that would be of limited use.
204 ;;; * Rewinding the stream works with overwriting semantics.
206 #+nil (let ((str (make-array 0
207 :element-type 'character
210 (with-output-to-string (stream str)
211 (princ "abcd" stream)
212 (assert (= 4 (file-position stream)))
213 (assert (file-position stream :start))
214 (assert (= 0 (file-position stream)))
216 (assert (= 1 (file-position stream)))
217 (file-position stream 2)
218 (assert (= 2 (file-position stream)))
220 (assert (file-position stream :end))
221 (assert (= 4 (file-position stream)))
222 (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
224 (assert (typep cond 'error)))
225 (multiple-value-bind (val cond) (ignore-errors (file-position stream 6))
227 (assert (typep cond 'error)))
228 (assert (equal "0b2d" str))))
230 (let ((str (make-array 0
231 :element-type 'character
234 (with-output-to-string (stream str)
235 (princ "abcd" stream)
236 (assert (= 4 (file-position stream)))
237 (assert (file-position stream :start))
238 (assert (= 0 (file-position stream)))
240 (assert (= 1 (file-position stream)))
241 (file-position stream 2)
242 (assert (= 2 (file-position stream)))
244 (assert (file-position stream :end))
245 (assert (= 4 (file-position stream)))
246 (assert (file-position stream 6))
247 (assert (file-position stream 4))
248 (assert (file-position stream :end))
249 (assert (= 6 (file-position stream)))
250 (assert (file-position stream 4))
251 (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
253 (assert (typep cond 'error)))
255 (assert (equal "0b2d!!" str))))
257 ;;; MAKE-STRING-OUTPUT-STREAM and WITH-OUTPUT-TO-STRING take an
258 ;;; :ELEMENT-TYPE keyword argument
259 (macrolet ((frob (element-type-form)
261 (let ((s (with-output-to-string
262 (s nil ,@(when element-type-form
263 `(:element-type ,element-type-form))))))
264 (assert (typep s '(simple-array ,(if element-type-form
265 (eval element-type-form)
268 (get-output-stream-string
269 (make-string-output-stream
270 ,@(when element-type-form
271 `(:element-type ,element-type-form)))))))
277 (with-open-file (s #-win32 "/dev/null" #+win32 "nul" :element-type '(signed-byte 48))
278 (assert (eq :eof (read-byte s nil :eof))))
280 (let* ((is (make-string-input-stream "foo"))
281 (os (make-string-output-stream))
282 (s (make-echo-stream is os))
283 (sequence (copy-seq "abcdef")))
284 (assert (= (read-sequence sequence s) 3))
285 (assert (string= sequence "foodef"))
286 (assert (string= (get-output-stream-string os) "foo")))
288 (let* ((is (make-string-input-stream "foo"))
289 (os (make-string-output-stream))
290 (s (make-echo-stream is os))
291 (sequence (copy-seq "abcdef")))
292 (assert (char= #\f (read-char s)))
293 (assert (= (read-sequence sequence s) 2))
294 (assert (string= sequence "oocdef"))
295 (assert (string= (get-output-stream-string os) "foo")))
297 (let* ((is (make-string-input-stream "foo"))
298 (os (make-string-output-stream))
299 (s (make-echo-stream is os))
300 (sequence (copy-seq "abcdef")))
301 (assert (char= #\f (read-char s)))
303 (assert (= (read-sequence sequence s) 3))
304 (assert (string= sequence "foodef"))
305 (assert (string= (get-output-stream-string os) "foo")))
307 (with-standard-io-syntax
308 (open #-win32 "/dev/null" #+win32 "nul" ))
310 ;;; PEEK-CHAR T uses whitespace[2]
311 (let ((*readtable* (copy-readtable)))
312 (assert (char= (peek-char t (make-string-input-stream " a")) #\a))
313 (set-syntax-from-char #\Space #\a)
314 (assert (char= (peek-char t (make-string-input-stream " a")) #\Space)))
316 ;;; It is actually easier to run into the problem exercised by this
317 ;;; test with sockets, due to their delays between availabilities of
318 ;;; data. However edgy the case may be for normal files, however,
319 ;;; there is still a case to be found in which CL:LISTEN answers
322 ;;; This test assumes that buffering is still done until a buffer of
323 ;;; SB-IMPL::+BYTES-PER-BUFFER+ bytes is filled up, that the buffer may
324 ;;; immediately be completely filled for normal files, and that the
325 ;;; buffer-fill routine is responsible for figuring out when we've
327 (with-test (:name (stream :listen-vs-select) :fails-on :win32)
328 (let ((listen-testfile-name "stream.impure.lisp.testqfile")
329 ;; If non-NIL, size (in bytes) of the file that will exercise
330 ;; the LISTEN problem.
331 (bytes-per-buffer-sometime
332 (and (boundp 'sb-impl::+bytes-per-buffer+)
333 (symbol-value 'sb-impl::+bytes-per-buffer+))))
334 (when bytes-per-buffer-sometime
337 (with-open-file (stream listen-testfile-name
338 :direction :output :if-exists :error
339 :element-type '(unsigned-byte 8))
340 (dotimes (n bytes-per-buffer-sometime)
341 (write-byte 113 stream)))
342 (with-open-file (stream listen-testfile-name
343 :direction :input :element-type '(unsigned-byte 8))
344 (dotimes (n bytes-per-buffer-sometime)
346 (assert (not (listen stream)))))
347 (ignore-errors (delete-file listen-testfile-name))))))
349 (with-test (:name :bug-395)
350 (let ((v (make-array 5 :fill-pointer 0 :element-type 'standard-char)))
352 (assert (equal (coerce "foo" 'base-string) v))))
354 ;;; Circa 1.0.27.18, echo-streams were changed somewhat, so that
355 ;;; unread-char on an echo-stream propagated the character down to the
356 ;;; echo-stream's input stream. (All other implementations but CMUCL
357 ;;; seemed to do this). The most useful argument for this behavior
358 ;;; involves cases where an input operation on an echo-stream finishes
359 ;;; up by unreading a delimiter, and the user wants to proceed to use the
360 ;;; underlying stream, e.g.,
362 (with-input-from-string (in "foo\"bar\"")
363 (with-open-stream (out (make-broadcast-stream))
364 (with-open-stream (echo (make-echo-stream in out))
367 ;; Before ca 1.0.27.18, the implicit UNREAD-CHAR at the end of
368 ;; the first READ wouldn't get back to IN, so the second READ
369 ;; returned BAR, not "BAR" (and then subsequent reads would