0.8.17.17:
[sbcl.git] / tests / stream.pure.lisp
1 ;;;; tests related to Lisp streams
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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
8 ;;;; from CMU CL.
9 ;;;; 
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.
13
14 (in-package :cl-user)
15
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))
35        (max-n-to-read 24)
36        (buffer-1 (make-string max-n-to-read))
37        (buffer-2 (make-string max-n-to-read)))
38   (loop
39    (let* ((n-to-read (random max-n-to-read))
40           (n-actually-read-1 (read-sequence buffer-1
41                                             concatenated-stream
42                                             :end n-to-read))
43           (n-actually-read-2 (read-sequence buffer-2
44                                             stream
45                                             :end n-to-read)))
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))
53        (return)))))
54
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...
57 (assert (string=
58          (with-output-to-string (out)
59            (peek-char #\]
60                       (make-echo-stream  
61                        (make-string-input-stream "ab cd e df s]") out)))
62          ;; (Before the fix, the result had a trailing #\] in it.)
63          "ab cd e df s"))
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
67 (assert (string=
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.)
75          "a"))
76
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)))
82       (peek-char nil r))))
83
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.
91 ;;; Ideas?
92 #+nil (assert (eq (interactive-stream-p *terminal-io*) t))
93
94 ;;; MAKE-STRING-INPUT-STREAM
95 ;;;
96 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
97 ;;;   FILE-POSITION beyond the end of string, signalling END-OF-FILE only
98 ;;;   on read.
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))
116     (assert (null val))
117     (assert (typep cond 'error)))
118   (multiple-value-bind (val cond) (ignore-errors (read-char stream))
119     (assert (null val))
120     (assert (typep cond 'end-of-file))))
121
122 ;;; MAKE-STRING-OUTPUT-STREAM
123 ;;;
124 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
125 ;;;   FILE-POSITION to an arbitrary index. 
126 ;;;
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. 
130 ;;;
131 ;;; * Rewinding the stream works with overwriting semantics.
132 ;;;
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)))
138   (princ "0" stream)
139   (assert (= 1 (file-position stream)))
140   (file-position stream 2)
141   (assert (= 2 (file-position stream)))
142   (princ "2" 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))
151     (assert (null val))
152     (assert (typep cond 'error)))
153   (princ "!!" stream)
154   (assert (equal "0b2d!!" (get-output-stream-string stream))))
155
156 ;;; WITH-OUTPUT-TO-STRING (when provided with a string argument)
157 ;;;
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)
164 ;;; adjustable.
165 ;;;
166 ;;; * END will refer to the ARRAY-TOTAL-SIZE of string, not
167 ;;; FILL-POINTER, since by definition the FILE-POSITION will always be
168 ;;; a FILL-POINTER, so that would be of limited use.
169 ;;;
170 ;;; * Rewinding the stream works with overwriting semantics.
171 ;;;
172 #+nil (let ((str (make-array 0
173                        :element-type 'character
174                        :adjustable nil
175                        :fill-pointer t)))
176   (with-output-to-string (stream str)
177     (princ "abcd" stream)
178     (assert (= 4 (file-position stream)))
179     (assert (file-position stream :start))
180     (assert (= 0 (file-position stream)))
181     (princ "0" stream)
182     (assert (= 1 (file-position stream)))
183     (file-position stream 2)
184     (assert (= 2 (file-position stream)))
185     (princ "2" stream)
186     (assert (file-position stream :end))
187     (assert (= 4 (file-position stream)))
188     (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
189       (assert (null val))
190       (assert (typep cond 'error)))
191     (multiple-value-bind (val cond) (ignore-errors (file-position stream 6))
192       (assert (null val))
193       (assert (typep cond 'error)))
194     (assert (equal "0b2d" str))))
195
196 (let ((str (make-array 0
197                        :element-type 'character
198                        :adjustable nil
199                        :fill-pointer t)))
200   (with-output-to-string (stream str)
201     (princ "abcd" stream)
202     (assert (= 4 (file-position stream)))
203     (assert (file-position stream :start))
204     (assert (= 0 (file-position stream)))
205     (princ "0" stream)
206     (assert (= 1 (file-position stream)))
207     (file-position stream 2)
208     (assert (= 2 (file-position stream)))
209     (princ "2" stream)
210     (assert (file-position stream :end))
211     (assert (= 4 (file-position stream)))
212     (assert (file-position stream 6))
213     (assert (file-position stream 4))
214     (assert (file-position stream :end))
215     (assert (= 6 (file-position stream)))
216     (assert (file-position stream 4))
217     (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
218       (assert (null val))
219       (assert (typep cond 'error)))
220     (princ "!!" stream)
221     (assert (equal "0b2d!!" str))))
222
223 ;;; MAKE-STRING-OUTPUT-STREAM and WITH-OUTPUT-TO-STRING take an
224 ;;; :ELEMENT-TYPE keyword argument
225 (macrolet ((frob (element-type-form)
226              `(progn
227                 (let ((s (with-output-to-string 
228                            (s nil ,@(when element-type-form
229                                       `(:element-type ,element-type-form))))))
230                   (assert (typep s '(simple-array ,(if element-type-form
231                                                        (eval element-type-form)
232                                                        'character)
233                                                   (0)))))
234                 (get-output-stream-string 
235                  (make-string-output-stream
236                   ,@(when element-type-form
237                       `(:element-type ,element-type-form)))))))
238   (frob nil)
239   (frob 'character)
240   (frob 'base-char)
241   (frob 'nil))
242
243 (with-open-file (s "/dev/null" :element-type '(signed-byte 48))
244   (assert (eq :eof (read-byte s nil :eof))))
245
246 (let* ((is (make-string-input-stream "foo"))
247        (os (make-string-output-stream))
248        (s (make-echo-stream is os))
249        (sequence (copy-seq "abcdef")))
250   (assert (= (read-sequence sequence s) 3))
251   (assert (string= sequence "foodef"))
252   (assert (string= (get-output-stream-string os) "foo")))
253
254 (let* ((is (make-string-input-stream "foo"))
255        (os (make-string-output-stream))
256        (s (make-echo-stream is os))
257        (sequence (copy-seq "abcdef")))
258   (assert (char= #\f (read-char s)))
259   (assert (= (read-sequence sequence s) 2))
260   (assert (string= sequence "oocdef"))
261   (assert (string= (get-output-stream-string os) "foo")))
262
263 (let* ((is (make-string-input-stream "foo"))
264        (os (make-string-output-stream))
265        (s (make-echo-stream is os))
266        (sequence (copy-seq "abcdef")))
267   (assert (char= #\f (read-char s)))
268   (unread-char #\f s)
269   (assert (= (read-sequence sequence s) 3))
270   (assert (string= sequence "foodef"))
271   (assert (string= (get-output-stream-string os) "foo")))