3 (defpackage sb-simple-streams-test
4 (:use
#:common-lisp
#:sb-simple-streams
#:sb-rt
))
7 (in-package #:sb-simple-streams-test
)
9 (defparameter *dumb-string
*
10 "This file was created by simple-stream-tests.lisp. Nothing to see here, move along.")
12 (defparameter *test-path
*
13 (merge-pathnames (make-pathname :name
:unspecific
:type
:unspecific
16 "Directory for temporary test files.")
18 (defparameter *test-file
*
19 (merge-pathnames #p
"test-data.tmp" *test-path
*))
21 (eval-when (:load-toplevel
) (ensure-directories-exist *test-path
* :verbose t
))
23 ;;; Non-destructive functional analog of REMF
24 (defun remove-key (key list
)
25 (loop for
(current-key val . rest
) on list by
#'cddr
26 until
(eql current-key key
)
27 collect current-key into result
28 collect val into result
29 finally
(return (nconc result rest
))))
31 (defun create-test-file (&key
(filename *test-file
*) (content *dumb-string
*))
32 (with-open-file (s filename
:direction
:output
33 :if-does-not-exist
:create
34 :if-exists
:supersede
)
35 (write-sequence content s
)))
37 (defun remove-test-file (&key
(filename *test-file
*))
38 (delete-file filename
))
40 (defmacro with-test-file
((stream file
&rest open-arguments
41 &key
(delete-afterwards t
)
45 (setq open-arguments
(remove-key :delete-afterwards open-arguments
))
46 (setq open-arguments
(remove-key :initial-content open-arguments
))
48 (let ((create-file-stream (gensym)))
50 (with-open-file (,create-file-stream
,file
:direction
:output
52 :if-does-not-exist
:create
)
53 (write-sequence ,initial-content
,create-file-stream
))
55 (with-open-file (,stream
,file
,@open-arguments
)
57 ,(when delete-afterwards
`(ignore-errors (delete-file ,file
))))))
59 (with-open-file (,stream
,file
,@open-arguments
)
61 ,(when delete-afterwards
`(ignore-errors (delete-file ,file
))))))
63 (deftest non-existent-class
65 (with-test-file (s *test-file
* :class
'non-existent-stream
)
67 ;; find-class will raise a simple-error
68 (simple-error (c) (search "There is no class" (simple-condition-format-control c
))))
71 (deftest non-stream-class
73 (with-test-file (s *test-file
* :class
'standard-class
)
75 ;; Will fall through sb-simple-streams:open as it is no stream class.
76 (simple-error (c) (search "Don't know how to handle" (simple-condition-format-control c
))))
79 (deftest create-file-1
80 ;; Create a file-simple-stream, write data.
82 (with-open-stream (s (make-instance 'file-simple-stream
86 :if-does-not-exist
:create
))
87 (string= (write-string *dumb-string
* s
) *dumb-string
*))
88 (delete-file *test-file
*))
91 (deftest create-file-2
92 ;; Create a file-simple-stream via :class argument to open, write data.
93 (with-test-file (s *test-file
* :class
'file-simple-stream
94 :direction
:output
:if-exists
:overwrite
95 :if-does-not-exist
:create
)
96 (string= (write-string *dumb-string
* s
) *dumb-string
*))
99 (deftest create-read-file-1
100 ;; Via file-simple-stream objects, write and then re-read data.
102 (with-test-file (s *test-file
* :class
'file-simple-stream
103 :direction
:output
:if-exists
:overwrite
104 :if-does-not-exist
:create
:delete-afterwards nil
)
105 (write-line *dumb-string
* s
)
106 (setf result
(and result
(string= (write-string *dumb-string
* s
)
109 (with-test-file (s *test-file
* :class
'file-simple-stream
110 :direction
:input
:if-does-not-exist
:error
)
112 (multiple-value-bind (string missing-newline-p
)
114 (setf result
(and result
(string= string
*dumb-string
*)
115 (not missing-newline-p
))))
117 (multiple-value-bind (string missing-newline-p
)
119 (setf result
(and result
(string= string
*dumb-string
*)
120 missing-newline-p
))))
124 (deftest create-read-mapped-file-1
125 ;; Read data via a mapped-file-simple-stream object.
127 (with-test-file (s *test-file
* :class
'mapped-file-simple-stream
128 :direction
:input
:if-does-not-exist
:error
129 :initial-content
*dumb-string
*)
130 (setf result
(and result
(string= (read-line s
) *dumb-string
*))))
134 (deftest write-read-inet
136 (with-open-stream (s (make-instance 'socket-simple-stream
137 :remote-host
#(127 0 0 1)
140 (string= (prog1 (write-line "Got it!" s
) (finish-output s
))
142 ;; Fail gracefully if echo isn't activated on the system
143 (sb-bsd-sockets::connection-refused-error
() t
)
144 ;; Timeout may occur on the restricted systems (e.g. FreeBSD
145 ;; with jail(8) or blackhole(4) is used).
146 (sb-bsd-sockets::operation-timeout-error
() t
))
149 (deftest write-read-large-sc-1
150 ;; Do write and read with more data than the buffer will hold
151 ;; (single-channel simple-stream)
152 (let* ((stream (make-instance 'file-simple-stream
153 :filename
*test-file
* :direction
:output
154 :if-exists
:overwrite
155 :if-does-not-exist
:create
))
156 (content (make-string (1+ (device-buffer-length stream
))
157 :initial-element
#\x
)))
158 (with-open-stream (s stream
)
159 (write-string content s
))
160 (with-test-file (s *test-file
* :class
'file-simple-stream
161 :direction
:input
:if-does-not-exist
:error
)
162 (string= content
(read-line s
))))
165 (deftest write-read-large-sc-2
166 (let* ((stream (make-instance 'file-simple-stream
167 :filename
*test-file
* :direction
:output
168 :if-exists
:overwrite
169 :if-does-not-exist
:create
))
170 (length (1+ (* 3 (device-buffer-length stream
))))
171 (content (make-string length
)))
172 (dotimes (i (length content
))
173 (setf (aref content i
) (code-char (random 256))))
174 (with-open-stream (s stream
)
175 (write-string content s
))
176 (with-test-file (s *test-file
* :class
'file-simple-stream
177 :direction
:input
:if-does-not-exist
:error
)
178 (let ((seq (make-string length
)))
179 #+nil
(read-sequence seq s
)
180 #-nil
(dotimes (i length
)
181 (setf (char seq i
) (read-char s
)))
182 (string= content seq
))))
185 (deftest write-read-large-sc-3
186 (let* ((stream (make-instance 'file-simple-stream
187 :filename
*test-file
* :direction
:output
188 :if-exists
:overwrite
189 :if-does-not-exist
:create
))
190 (length (1+ (* 3 (device-buffer-length stream
))))
191 (content (make-array length
:element-type
'(unsigned-byte 8))))
192 (dotimes (i (length content
))
193 (setf (aref content i
) (random 256)))
194 (with-open-stream (s stream
)
195 (write-sequence content s
))
196 (with-test-file (s *test-file
* :class
'file-simple-stream
197 :direction
:input
:if-does-not-exist
:error
)
198 (let ((seq (make-array length
:element-type
'(unsigned-byte 8))))
199 #+nil
(read-sequence seq s
)
200 #-nil
(dotimes (i length
)
201 (setf (aref seq i
) (read-byte s
)))
202 (equalp content seq
))))
205 (deftest write-read-large-dc-1
206 ;; Do write and read with more data than the buffer will hold
207 ;; (dual-channel simple-stream; we only have socket streams atm)
209 (let* ((stream (make-instance 'socket-simple-stream
210 :remote-host
#(127 0 0 1)
213 (content (make-string (1+ (device-buffer-length stream
))
214 :initial-element
#\x
)))
215 (with-open-stream (s stream
)
216 (string= (prog1 (write-line content s
) (finish-output s
))
218 ;; Fail gracefully if echo isn't activated on the system
219 (sb-bsd-sockets::connection-refused-error
() t
)
220 ;; Timeout may occur on the restricted systems (e.g. FreeBSD
221 ;; with jail(8) or blackhole(4) is used).
222 (sb-bsd-sockets::operation-timeout-error
() t
))
226 (deftest file-position-1
227 ;; Test reading of file-position
228 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:input
229 :initial-content
*dumb-string
*)
233 (deftest file-position-2
234 ;; Test reading of file-position
235 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:input
236 :initial-content
*dumb-string
*)
241 (deftest file-position-3
242 ;; Test reading of file-position in the presence of unsaved data
243 (with-test-file (s *test-file
* :class
'file-simple-stream
244 :direction
:output
:if-exists
:supersede
245 :if-does-not-exist
:create
)
250 (deftest file-position-4
251 ;; Test reading of file-position in the presence of unsaved data and
253 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:io
254 :if-exists
:overwrite
:if-does-not-exist
:create
255 :initial-content
*dumb-string
*)
256 (read-byte s
) ; fill buffer
257 (write-byte 50 s
) ; advance file-position
261 (deftest file-position-5
262 ;; Test file position when opening with :if-exists :append
263 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:io
264 :if-exists
:append
:if-does-not-exist
:create
265 :initial-content
*dumb-string
*)
266 (= (file-length s
) (file-position s
)))
269 (deftest write-read-unflushed-sc-1
270 ;; Write something into a single-channel stream and read it back
271 ;; without explicitly flushing the buffer in-between
272 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:io
273 :if-does-not-exist
:create
:if-exists
:supersede
)
275 (file-position s
:start
)
279 (deftest write-read-unflushed-sc-2
280 ;; Write something into a single-channel stream, try to read back too much
282 (with-test-file (s *test-file
* :class
'file-simple-stream
283 :direction
:io
:if-does-not-exist
:create
284 :if-exists
:supersede
)
286 (file-position s
:start
)
293 (deftest write-read-unflushed-sc-3
294 ;; Test writing in a buffer filled with previous file contents
296 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:io
297 :if-exists
:overwrite
:if-does-not-exist
:create
298 :initial-content
*dumb-string
*)
299 (setq result
(and result
(char= (read-char s
) (schar *dumb-string
* 0))))
300 (setq result
(and result
(= (file-position s
) 1)))
301 (let ((pos (file-position s
)))
303 (file-position s pos
)
304 (setq result
(and result
(char= (read-char s
) #\x
)))))
308 (deftest write-read-unflushed-sc-4
309 ;; Test flushing of buffers
311 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:io
312 :if-exists
:overwrite
:if-does-not-exist
:create
313 :initial-content
"Foo"
314 :delete-afterwards nil
)
315 (read-char s
) ; Fill the buffer.
316 (file-position s
:start
) ; Change existing data.
318 (file-position s
:end
) ; Extend file.
320 (with-test-file (s *test-file
* :class
'file-simple-stream
321 :direction
:input
:if-does-not-exist
:error
)
326 (deftest write-read-append-sc-1
327 ;; Test writing in the middle of a stream opened in append mode
329 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:io
330 :if-exists
:append
:if-does-not-exist
:create
331 :initial-content
"Foo"
332 :delete-afterwards nil
)
333 (file-position s
:start
) ; Jump to beginning.
335 (file-position s
:end
) ; Extend file.
337 (with-test-file (s *test-file
* :class
'file-simple-stream
338 :direction
:input
:if-does-not-exist
:error
)
343 (deftest write-read-mixed-sc-1
344 ;; Test read/write-sequence of types string and (unsigned-byte 8)
345 (let ((uvector (make-array '(10) :element-type
'(unsigned-byte 8)
346 :initial-element
64))
347 (svector (make-array '(10) :element-type
'(signed-byte 8)
348 :initial-element -
1))
349 (result-uvector (make-array '(10) :element-type
'(unsigned-byte 8)
351 (result-svector (make-array '(10) :element-type
'(signed-byte 8)
353 (result-string (make-string (length *dumb-string
*)
354 :initial-element
#\Space
)))
355 (with-test-file (s *test-file
* :class
'file-simple-stream
:direction
:io
356 :if-exists
:overwrite
:if-does-not-exist
:create
357 :delete-afterwards nil
)
358 (write-sequence svector s
)
359 (write-sequence uvector s
)
360 (write-sequence *dumb-string
* s
))
361 (with-test-file (s *test-file
* :class
'file-simple-stream
362 :direction
:input
:if-does-not-exist
:error
363 :delete-afterwards nil
)
364 (read-sequence result-svector s
)
365 (read-sequence result-uvector s
)
366 (read-sequence result-string s
))
367 (and (string= *dumb-string
* result-string
)
368 (equalp uvector result-uvector
)
369 (equalp svector result-svector
)))
372 (defparameter *multi-line-string
*
373 "This file was created by simple-stream-tests.lisp.
374 Nothing to see here, move along.")
376 (defmacro with-dc-test-stream
((s &key initial-content
) &body body
)
381 :if-exists
:overwrite
382 :initial-content
,(or initial-content
'*multi-line-string
*))
383 (let ((,s
(make-instance 'terminal-simple-stream
384 :input-handle
(sb-kernel::fd-stream-fd .ansi-stream.
)
385 :output-handle
(sb-kernel::fd-stream-fd .ansi-stream.
))))
388 (defmacro with-sc-test-stream
((s &key initial-content
) &body body
)
392 :class
'file-simple-stream
394 :if-exists
:overwrite
395 :initial-content
,(or initial-content
'*multi-line-string
*))
399 ;; LISTEN with filled buffer
400 (with-dc-test-stream (s) (read-char s
) (listen s
))
404 ;; LISTEN with empty buffer
405 (with-dc-test-stream (s) (listen s
))
410 (with-dc-test-stream (s)
416 ;;; the following tests are for problems fixed in SBCL 0.8.6.2:
419 ;; check for bug involving the -1 vs. 0 oddity in std-dc-newline-in-handler
421 ;; Note: It not not clear to me that input should affect the CHARPOS at
422 ;; all. (Except for a terminal stream perhaps, which our test stream
423 ;; happens to be. Hmm.)
425 ;; But CHARPOS must not be -1, so much is sure, hence this test is right
427 (with-dc-test-stream (s)
429 (sb-simple-streams:charpos s
))
433 ;; FIXME: It not not clear to me that input should affect the CHARPOS at
434 ;; all, and indeed it does not. That is, except for newlines?! (see above)
436 ;; What this test does is (a) check that the CHARPOS works at all without
437 ;; erroring and (b) force anyone changing the CHARPOS behaviour to read
438 ;; this comment and start thinking things through better than I can.
439 (with-dc-test-stream (s)
441 (and (eql (sb-kernel:charpos s
) 0)
442 (eql (sb-simple-streams:charpos s
) 0)))
446 ;; does the reader support simple streams? Note that, say, "123" instead
447 ;; of "(1 2)" does not trigger the bugs present in SBCL 0.8.6.
448 (with-dc-test-stream (s :initial-content
"(1 2)")
449 (equal (read s
) '(1 2)))
452 (deftest line-length-dc-1
453 ;; does LINE-LENGTH support simple streams?
454 (with-dc-test-stream (s)
455 (eql (sb-simple-streams:line-length s
)
456 (sb-kernel:line-length s
)))
461 ;; the biggest change in 0.8.6.2:
462 ;; support composite streams writing to simple streams
464 ;; first, SYNONYM-STREAM:
466 (deftest synonym-stream-1
468 (with-dc-test-stream (*synonym
*)
469 (read-char (make-synonym-stream '*synonym
*)))
472 (deftest synonym-stream-2
473 ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
474 (with-dc-test-stream (*synonym
*)
475 (let ((s (make-synonym-stream '*synonym
*)))
476 (unread-char (read-char s
) s
)
480 (deftest synonym-stream-3
482 (with-dc-test-stream (*synonym
*)
483 (read-byte (make-synonym-stream '*synonym
*)))
486 (deftest synonym-stream-4
488 (with-sc-test-stream (*synonym
*)
489 (let ((s (make-synonym-stream '*synonym
*)))
495 (deftest synonym-stream-5
497 (with-sc-test-stream (*synonym
*)
498 (let ((s (make-synonym-stream '*synonym
*)))
504 (deftest synonym-stream-6
506 (with-sc-test-stream (*synonym
*)
507 (let ((s (make-synonym-stream '*synonym
*)))
508 (write-string "ab" s
)
510 (and (char= (read-char s
) #\a)
511 (char= (read-char s
) #\b))))
514 (deftest synonym-stream-7
515 ;; LISTEN (via STREAM-MISC-DISPATCH)
516 (with-sc-test-stream (*synonym
*)
517 (let ((s (make-synonym-stream '*synonym
*)))
521 (deftest synonym-stream-8
522 ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
523 (with-sc-test-stream (*synonym
*)
524 (let ((s (make-synonym-stream '*synonym
*)))
528 (deftest synonym-stream-9
529 ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
530 (with-sc-test-stream (*synonym
*)
531 ;; could test more here
532 (force-output (make-synonym-stream '*synonym
*)))
535 (deftest synonym-stream-10
536 ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
537 (with-sc-test-stream (*synonym
*)
538 ;; could test more here
539 (finish-output (make-synonym-stream '*synonym
*)))
542 (deftest synonym-stream-11
543 ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
544 (with-sc-test-stream (*synonym
*)
545 (eql (stream-element-type (make-synonym-stream '*synonym
*))
546 (stream-element-type *synonym
*)))
549 (deftest synonym-stream-12
550 ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
551 (with-sc-test-stream (*synonym
*)
552 (eql (interactive-stream-p (make-synonym-stream '*synonym
*))
553 (interactive-stream-p *synonym
*)))
556 (deftest synonym-stream-13
557 ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
558 (with-sc-test-stream (*synonym
*)
559 (eql (sb-kernel:line-length
(make-synonym-stream '*synonym
*))
560 (sb-kernel:line-length
*synonym
*)))
563 (deftest synonym-stream-14
564 ;; CHARPOS (via STREAM-MISC-DISPATCH)
565 (with-sc-test-stream (*synonym
*)
566 (eql (sb-kernel:charpos
(make-synonym-stream '*synonym
*))
567 (sb-kernel:charpos
*synonym
*)))
570 (deftest synonym-stream-15
571 ;; FILE-LENGTH (via STREAM-MISC-DISPATCH)
572 (with-sc-test-stream (*synonym
*)
573 (eql (file-length (make-synonym-stream '*synonym
*))
574 (file-length *synonym
*)))
577 (deftest synonym-stream-16
578 ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
579 (with-sc-test-stream (*synonym
*)
580 (eql (file-position (make-synonym-stream '*synonym
*))
581 (file-position *synonym
*)))
584 ;; SYNONYM-STREAM tests repeated for BROADCAST-STREAM, where applicable
586 (deftest broadcast-stream-4
588 (with-sc-test-stream (synonym)
589 (let ((s (make-broadcast-stream synonym
)))
592 (file-position synonym
0)
596 (deftest broadcast-stream-5
598 (with-sc-test-stream (synonym)
599 (let ((s (make-broadcast-stream synonym
)))
602 (file-position synonym
0)
606 (deftest broadcast-stream-6
608 (with-sc-test-stream (synonym)
609 (let ((s (make-broadcast-stream synonym
)))
610 (write-string "ab" s
)
612 (file-position synonym
0)
613 (and (char= (read-char synonym
) #\a)
614 (char= (read-char synonym
) #\b)))
617 (deftest broadcast-stream-9
618 ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
619 (with-sc-test-stream (synonym)
620 ;; could test more here
621 (force-output (make-broadcast-stream synonym
)))
624 (deftest broadcast-stream-10
625 ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
626 (with-sc-test-stream (synonym)
627 ;; could test more here
628 (finish-output (make-broadcast-stream synonym
)))
631 (deftest broadcast-stream-11
632 ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
633 (with-sc-test-stream (synonym)
634 (eql (stream-element-type (make-broadcast-stream synonym
))
635 (stream-element-type synonym
)))
638 (deftest broadcast-stream-12
639 ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
640 (with-sc-test-stream (synonym)
641 (eql (interactive-stream-p (make-broadcast-stream synonym
))
642 (interactive-stream-p synonym
)))
645 (deftest broadcast-stream-13
646 ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
647 (with-sc-test-stream (synonym)
648 (eql (sb-kernel:line-length
(make-broadcast-stream synonym
))
649 (sb-kernel:line-length synonym
)))
652 (deftest broadcast-stream-14
653 ;; CHARPOS (via STREAM-MISC-DISPATCH)
654 (with-sc-test-stream (synonym)
655 (eql (sb-kernel:charpos
(make-broadcast-stream synonym
))
656 (sb-kernel:charpos synonym
)))
659 (deftest broadcast-stream-16
660 ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
661 (with-sc-test-stream (synonym)
662 (eql (file-position (make-broadcast-stream synonym
))
663 (file-position synonym
)))
666 ;; SYNONYM-STREAM tests repeated for TWO-WAY-STREAM, where applicable
668 (deftest two-way-stream-1
670 (with-dc-test-stream (synonym)
671 (read-char (make-two-way-stream synonym synonym
)))
674 (deftest two-way-stream-2
675 ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
676 (with-dc-test-stream (synonym)
677 (let ((s (make-two-way-stream synonym synonym
)))
678 (unread-char (read-char s
) s
)
682 (deftest two-way-stream-3
684 (with-dc-test-stream (synonym)
685 (read-byte (make-two-way-stream synonym synonym
)))
688 (deftest two-way-stream-4
690 (with-sc-test-stream (synonym)
691 (let ((s (make-two-way-stream synonym synonym
)))
694 (file-position synonym
0)
698 (deftest two-way-stream-5
700 (with-sc-test-stream (synonym)
701 (let ((s (make-two-way-stream synonym synonym
)))
704 (file-position synonym
0)
708 (deftest two-way-stream-6
710 (with-sc-test-stream (synonym)
711 (let ((s (make-two-way-stream synonym synonym
)))
712 (write-string "ab" s
)
714 (file-position synonym
0)
715 (and (char= (read-char synonym
) #\a)
716 (char= (read-char synonym
) #\b)))
719 (deftest two-way-stream-7
720 ;; LISTEN (via STREAM-MISC-DISPATCH)
721 (with-sc-test-stream (synonym)
722 (let ((s (make-two-way-stream synonym synonym
)))
726 (deftest two-way-stream-8
727 ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
728 (with-sc-test-stream (synonym)
729 (let ((s (make-two-way-stream synonym synonym
)))
733 (deftest two-way-stream-9
734 ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
735 (with-sc-test-stream (synonym)
736 ;; could test more here
737 (force-output (make-two-way-stream synonym synonym
)))
740 (deftest two-way-stream-10
741 ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
742 (with-sc-test-stream (synonym)
743 ;; could test more here
744 (finish-output (make-two-way-stream synonym synonym
)))
747 (deftest two-way-stream-11
748 ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
749 (with-sc-test-stream (synonym)
750 (eql (stream-element-type (make-two-way-stream synonym synonym
))
751 (stream-element-type synonym
)))
754 (deftest two-way-stream-12
755 ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
756 (with-sc-test-stream (synonym)
757 (eql (interactive-stream-p (make-two-way-stream synonym synonym
))
758 (interactive-stream-p synonym
)))
761 (deftest two-way-stream-13
762 ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
763 (with-sc-test-stream (synonym)
764 (eql (sb-kernel:line-length
(make-two-way-stream synonym synonym
))
765 (sb-kernel:line-length synonym
)))
768 (deftest two-way-stream-14
769 ;; CHARPOS (via STREAM-MISC-DISPATCH)
770 (with-sc-test-stream (synonym)
771 (eql (sb-kernel:charpos
(make-two-way-stream synonym synonym
))
772 (sb-kernel:charpos synonym
)))
775 (deftest two-way-stream-16
776 ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
777 (with-sc-test-stream (synonym)
778 (eql (file-position (make-two-way-stream synonym synonym
))
779 (file-position synonym
)))
782 ;; SYNONYM-STREAM tests repeated for ECHO-STREAM, where applicable
784 (deftest echo-stream-1
786 (with-dc-test-stream (*synonym
*)
787 (read-char (make-echo-stream *synonym
* *synonym
*)))
790 (deftest echo-stream-2
791 ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
792 (with-dc-test-stream (*synonym
*)
793 (let ((s (make-echo-stream *synonym
* *synonym
*)))
794 (unread-char (read-char s
) s
)
798 (deftest echo-stream-3
800 (with-dc-test-stream (*synonym
*)
801 (read-byte (make-echo-stream *synonym
* *synonym
*)))
804 (deftest echo-stream-7
805 ;; LISTEN (via STREAM-MISC-DISPATCH)
806 (with-sc-test-stream (*synonym
*)
807 (let ((s (make-echo-stream *synonym
* *synonym
*)))
811 (deftest echo-stream-8
812 ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
813 (with-sc-test-stream (*synonym
*)
814 (let ((s (make-echo-stream *synonym
* *synonym
*)))
818 (deftest echo-stream-11
819 ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
820 (with-sc-test-stream (*synonym
*)
821 (eql (stream-element-type (make-echo-stream *synonym
* *synonym
*))
822 (stream-element-type *synonym
*)))
825 (deftest echo-stream-12
826 ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
827 (with-sc-test-stream (*synonym
*)
828 (eql (interactive-stream-p (make-echo-stream *synonym
* *synonym
*))
829 (interactive-stream-p *synonym
*)))
832 (deftest echo-stream-13
833 ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
834 (with-sc-test-stream (*synonym
*)
835 (eql (sb-kernel:line-length
(make-echo-stream *synonym
* *synonym
*))
836 (sb-kernel:line-length
*synonym
*)))
839 (deftest echo-stream-14
840 ;; CHARPOS (via STREAM-MISC-DISPATCH)
841 (with-sc-test-stream (*synonym
*)
842 (eql (sb-kernel:charpos
(make-echo-stream *synonym
* *synonym
*))
843 (sb-kernel:charpos
*synonym
*)))
846 (deftest echo-stream-16
847 ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
848 (with-sc-test-stream (*synonym
*)
849 (eql (file-position (make-echo-stream *synonym
* *synonym
*))
850 (file-position *synonym
*)))
853 ;; SYNONYM-STREAM tests repeated for CONCATENATED-STREAM, where applicable
855 (deftest concatenated-stream-1
857 (with-dc-test-stream (*synonym
*)
858 (read-char (make-concatenated-stream *synonym
*)))
861 (deftest concatenated-stream-2
862 ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
863 (with-dc-test-stream (*synonym
*)
864 (let ((s (make-concatenated-stream *synonym
*)))
865 (unread-char (read-char s
) s
)
869 (deftest concatenated-stream-3
871 (with-dc-test-stream (*synonym
*)
872 (read-byte (make-concatenated-stream *synonym
*)))
875 (deftest concatenated-stream-7
876 ;; LISTEN (via STREAM-MISC-DISPATCH)
877 (with-sc-test-stream (*synonym
*)
878 (let ((s (make-concatenated-stream *synonym
*)))
882 (deftest concatenated-stream-8
883 ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
884 (with-sc-test-stream (*synonym
*)
885 (let ((s (make-concatenated-stream *synonym
*)))
889 (deftest concatenated-stream-11
890 ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
891 (with-sc-test-stream (*synonym
*)
892 (eql (stream-element-type (make-concatenated-stream *synonym
*))
893 (stream-element-type *synonym
*)))
896 (deftest concatenated-stream-12
897 ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
898 (with-sc-test-stream (*synonym
*)
899 (eql (interactive-stream-p (make-concatenated-stream *synonym
*))
900 (interactive-stream-p *synonym
*)))
903 (deftest concatenated-stream-13
904 ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
905 (with-sc-test-stream (*synonym
*)
906 (eql (sb-kernel:line-length
(make-concatenated-stream *synonym
*))
907 (sb-kernel:line-length
*synonym
*)))
910 (deftest concatenated-stream-14
911 ;; CHARPOS (via STREAM-MISC-DISPATCH)
912 (with-sc-test-stream (*synonym
*)
913 (eql (sb-kernel:charpos
(make-concatenated-stream *synonym
*))
914 (sb-kernel:charpos
*synonym
*)))
917 (deftest concatenated-stream-16
918 ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
919 (with-sc-test-stream (*synonym
*)
920 (eql (file-position (make-concatenated-stream *synonym
*))
921 (file-position *synonym
*)))
924 ;; uncovered by synonym-stream-15
926 (deftest file-simple-stream-1
927 (values (subtypep 'file-simple-stream
'file-stream
))
930 (deftest string-simple-stream-1
931 (values (subtypep 'string-simple-stream
'string-stream
))
934 ;; don't break fd-stream external-format support:
936 (deftest external-format-1
938 (with-open-file (s *test-file
*
940 :if-exists
:supersede
941 :element-type
'(unsigned-byte 8))
944 (with-open-file (s *test-file
*
946 :external-format
:utf-8
)
947 (char-code (read-char s
))))
950 ;; launchpad bug #491087
953 (labels ((read-big-int (stream)
954 (let ((b (make-array 1 :element-type
'(signed-byte 32)
955 :initial-element
0)))
956 (declare (dynamic-extent b
))
957 (sb-simple-streams::read-vector b stream
958 :endian-swap
:network-order
)
960 (with-open-file (stream
961 (merge-pathnames #P
"lp491087.txt" *test-path
*)
962 :class
'file-simple-stream
)
963 (let* ((start (file-position stream
))
964 (integer (read-big-int stream
))
965 (end (file-position stream
)))
967 (= integer
#x30313233
)