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)