contrib/sb-simple-streams/simple-stream-tests.lisp

   1 ;;;; -*- lisp -*-
   2
   3 (defpackage sb-simple-streams-test
   4   (:use #:common-lisp #:sb-simple-streams #:sb-rt))
   5
   6
   7 (in-package #:sb-simple-streams-test)
   8
   9 (defparameter *dumb-string*
  10   "This file was created by simple-stream-tests.lisp. Nothing to see here, move along.")
  11
  12 (defparameter *test-path*
  13   (merge-pathnames (make-pathname :name :unspecific :type :unspecific
  14                                   :version :unspecific)
  15                    *load-truename*)
  16   "Directory for temporary test files.")
  17
  18 (defparameter *test-file*
  19   (merge-pathnames #p"test-data.tmp" *test-path*))
  20
  21 (eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t))
  22
  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))))
  30
  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)))
  36
  37 (defun remove-test-file (&key (filename *test-file*))
  38   (delete-file filename))
  39
  40 (defmacro with-test-file ((stream file &rest open-arguments
  41                                   &key (delete-afterwards t)
  42                                   initial-content
  43                                   &allow-other-keys)
  44                           &body body)
  45   (setq open-arguments (remove-key :delete-afterwards open-arguments))
  46   (setq open-arguments (remove-key :initial-content open-arguments))
  47   (if initial-content
  48       (let ((create-file-stream (gensym)))
  49         `(progn
  50            (with-open-file (,create-file-stream ,file :direction :output
  51                                                 :if-exists :supersede
  52                                                 :if-does-not-exist :create)
  53              (write-sequence ,initial-content ,create-file-stream))
  54            (unwind-protect
  55                 (with-open-file (,stream ,file ,@open-arguments)
  56                   (progn ,@body))
  57              ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
  58       `(unwind-protect
  59             (with-open-file (,stream ,file ,@open-arguments)
  60               (progn ,@body))
  61          ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
  62
  63 (deftest create-file-1
  64     ;; Create a file-simple-stream, write data.
  65     (prog1
  66         (with-open-stream (s (make-instance 'file-simple-stream
  67                                             :filename *test-file*
  68                                             :direction :output
  69                                             :if-exists :overwrite
  70                                             :if-does-not-exist :create))
  71           (string= (write-string *dumb-string* s) *dumb-string*))
  72       (delete-file *test-file*))
  73   t)
  74
  75 (deftest create-file-2
  76     ;; Create a file-simple-stream via :class argument to open, write data.
  77     (with-test-file (s *test-file* :class 'file-simple-stream
  78                        :direction :output :if-exists :overwrite
  79                        :if-does-not-exist :create)
  80       (string= (write-string *dumb-string* s) *dumb-string*))
  81   t)
  82
  83 (deftest create-read-file-1
  84   ;; Via file-simple-stream objects, write and then re-read data.
  85   (let ((result t))
  86     (with-test-file (s *test-file* :class 'file-simple-stream
  87                        :direction :output :if-exists :overwrite
  88                        :if-does-not-exist :create :delete-afterwards nil)
  89       (write-line *dumb-string* s)
  90       (setf result (and result (string= (write-string *dumb-string* s)
  91                                         *dumb-string*))))
  92
  93     (with-test-file (s *test-file* :class 'file-simple-stream
  94                        :direction :input :if-does-not-exist :error)
  95       ;; Check first line
  96       (multiple-value-bind (string missing-newline-p)
  97           (read-line s)
  98         (setf result (and result (string= string *dumb-string*)
  99                           (not missing-newline-p))))
 100       ;; Check second line
 101       (multiple-value-bind (string missing-newline-p)
 102           (read-line s)
 103         (setf result (and result (string= string *dumb-string*)
 104                           missing-newline-p))))
 105     result)
 106   t)
 107
 108 (deftest create-read-mapped-file-1
 109   ;; Read data via a mapped-file-simple-stream object.
 110   (let ((result t))
 111     (with-test-file (s *test-file* :class 'mapped-file-simple-stream
 112                        :direction :input :if-does-not-exist :error
 113                        :initial-content *dumb-string*)
 114       (setf result (and result (string= (read-line s) *dumb-string*))))
 115     result)
 116   t)
 117
 118 (deftest write-read-inet
 119   (handler-case
 120       (with-open-stream (s (make-instance 'socket-simple-stream
 121                                           :remote-host #(127 0 0 1)
 122                                           :remote-port 7
 123                                           :direction :io))
 124         (string= (prog1 (write-line "Got it!" s) (finish-output s))
 125                  (read-line s)))
 126     ;; Fail gracefully if echo isn't activated on the system
 127     (sb-bsd-sockets::connection-refused-error () t))
 128   t)
 129
 130 (deftest write-read-large-sc-1
 131   ;; Do write and read with more data than the buffer will hold
 132   ;; (single-channel simple-stream)
 133   (let* ((stream (make-instance 'file-simple-stream
 134                                 :filename *test-file* :direction :output
 135                                 :if-exists :overwrite
 136                                 :if-does-not-exist :create))
 137          (content (make-string (1+ (device-buffer-length stream))
 138                                :initial-element #\x)))
 139     (with-open-stream (s stream)
 140       (write-string content s))
 141     (with-test-file (s *test-file* :class 'file-simple-stream
 142                        :direction :input :if-does-not-exist :error)
 143       (string= content (read-line s))))
 144   t)
 145
 146 (deftest write-read-large-sc-2
 147   (let* ((stream (make-instance 'file-simple-stream
 148                                 :filename *test-file* :direction :output
 149                                 :if-exists :overwrite
 150                                 :if-does-not-exist :create))
 151          (length (1+ (* 3 (device-buffer-length stream))))
 152          (content (make-string length)))
 153     (dotimes (i (length content))
 154       (setf (aref content i) (code-char (random 256))))
 155     (with-open-stream (s stream)
 156       (write-string content s))
 157     (with-test-file (s *test-file* :class 'file-simple-stream
 158                        :direction :input :if-does-not-exist :error)
 159       (let ((seq (make-string length)))
 160         #+nil (read-sequence seq s)
 161         #-nil (dotimes (i length)
 162                 (setf (char seq i) (read-char s)))
 163         (string= content seq))))
 164   t)
 165
 166 (deftest write-read-large-sc-3
 167   (let* ((stream (make-instance 'file-simple-stream
 168                                 :filename *test-file* :direction :output
 169                                 :if-exists :overwrite
 170                                 :if-does-not-exist :create))
 171          (length (1+ (* 3 (device-buffer-length stream))))
 172          (content (make-array length :element-type '(unsigned-byte 8))))
 173     (dotimes (i (length content))
 174       (setf (aref content i) (random 256)))
 175     (with-open-stream (s stream)
 176       (write-sequence content s))
 177     (with-test-file (s *test-file* :class 'file-simple-stream
 178                        :direction :input :if-does-not-exist :error)
 179       (let ((seq (make-array length :element-type '(unsigned-byte 8))))
 180         #+nil (read-sequence seq s)
 181         #-nil (dotimes (i length)
 182                 (setf (aref seq i) (read-byte s)))
 183         (equalp content seq))))
 184   t)
 185
 186 (deftest write-read-large-dc-1
 187   ;; Do write and read with more data than the buffer will hold
 188   ;; (dual-channel simple-stream; we only have socket streams atm)
 189   (handler-case
 190    (let* ((stream (make-instance 'socket-simple-stream
 191                                  :remote-host #(127 0 0 1)
 192                                  :remote-port 7
 193                                  :direction :io))
 194           (content (make-string (1+ (device-buffer-length stream))
 195                                 :initial-element #\x)))
 196      (with-open-stream (s stream)
 197        (string= (prog1 (write-line content s) (finish-output s))
 198                 (read-line s))))
 199     ;; Fail gracefully if echo isn't activated on the system
 200    (sb-bsd-sockets::connection-refused-error () t))
 201   t)
 202
 203
 204 (deftest file-position-1
 205     ;; Test reading of file-position
 206     (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
 207                        :initial-content *dumb-string*)
 208       (file-position s))
 209   0)
 210
 211 (deftest file-position-2
 212     ;; Test reading of file-position
 213     (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
 214                        :initial-content *dumb-string*)
 215       (read-byte s)
 216       (file-position s))
 217   1)
 218
 219 (deftest file-position-3
 220     ;; Test reading of file-position in the presence of unsaved data
 221     (with-test-file (s *test-file* :class 'file-simple-stream
 222                        :direction :output :if-exists :supersede
 223                        :if-does-not-exist :create)
 224       (write-byte 50 s)
 225       (file-position s))
 226   1)
 227
 228 (deftest file-position-4
 229     ;; Test reading of file-position in the presence of unsaved data and
 230     ;; filled buffer
 231     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 232                        :if-exists :overwrite :if-does-not-exist :create
 233                        :initial-content *dumb-string*)
 234       (read-byte s)                     ; fill buffer
 235       (write-byte 50 s)                 ; advance file-position
 236       (file-position s))
 237   2)
 238
 239 (deftest file-position-5
 240     ;; Test file position when opening with :if-exists :append
 241     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 242                        :if-exists :append :if-does-not-exist :create
 243                        :initial-content *dumb-string*)
 244       (= (file-length s) (file-position s)))
 245   T)
 246
 247 (deftest write-read-unflushed-sc-1
 248     ;; Write something into a single-channel stream and read it back
 249     ;; without explicitly flushing the buffer in-between
 250     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 251                        :if-does-not-exist :create :if-exists :supersede)
 252       (write-char #\x s)
 253       (file-position s :start)
 254       (read-char s))
 255   #\x)
 256
 257 (deftest write-read-unflushed-sc-2
 258     ;; Write something into a single-channel stream, try to read back too much
 259     (handler-case
 260         (with-test-file (s *test-file* :class 'file-simple-stream
 261                            :direction :io :if-does-not-exist :create
 262                            :if-exists :supersede)
 263             (write-char #\x s)
 264             (file-position s :start)
 265             (read-char s)
 266             (read-char s)
 267             nil)
 268       (end-of-file () t))
 269   t)
 270
 271 (deftest write-read-unflushed-sc-3
 272     ;; Test writing in a buffer filled with previous file contents
 273     (let ((result t))
 274       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 275                          :if-exists :overwrite :if-does-not-exist :create
 276                          :initial-content *dumb-string*)
 277         (setq result (and result (char= (read-char s) (schar *dumb-string* 0))))
 278         (setq result (and result (= (file-position s) 1)))
 279         (let ((pos (file-position s)))
 280           (write-char #\x s)
 281           (file-position s pos)
 282           (setq result (and result (char= (read-char s) #\x)))))
 283       result)
 284   t)
 285
 286 (deftest write-read-unflushed-sc-4
 287     ;; Test flushing of buffers
 288     (progn
 289       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 290                          :if-exists :overwrite :if-does-not-exist :create
 291                          :initial-content "Foo"
 292                          :delete-afterwards nil)
 293         (read-char s)                   ; Fill the buffer.
 294         (file-position s :start)        ; Change existing data.
 295         (write-char #\X s)
 296         (file-position s :end)          ; Extend file.
 297         (write-char #\X s))
 298       (with-test-file (s *test-file* :class 'file-simple-stream
 299                          :direction :input :if-does-not-exist :error)
 300         (read-line s)))
 301   "XooX"
 302   T)
 303
 304 (deftest write-read-append-sc-1
 305     ;; Test writing in the middle of a stream opened in append mode
 306     (progn
 307       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 308                          :if-exists :append :if-does-not-exist :create
 309                          :initial-content "Foo"
 310                          :delete-afterwards nil)
 311         (file-position s :start)        ; Jump to beginning.
 312         (write-char #\X s)
 313         (file-position s :end)          ; Extend file.
 314         (write-char #\X s))
 315       (with-test-file (s *test-file* :class 'file-simple-stream
 316                          :direction :input :if-does-not-exist :error)
 317         (read-line s)))
 318   "XooX"
 319   T)
 320
 321 (deftest write-read-mixed-sc-1
 322     ;; Test read/write-sequence of types string and (unsigned-byte 8)
 323     (let ((uvector (make-array '(10) :element-type '(unsigned-byte 8)
 324                                :initial-element 64))
 325           (svector (make-array '(10) :element-type '(signed-byte 8)
 326                                :initial-element -1))
 327           (result-uvector (make-array '(10) :element-type '(unsigned-byte 8)
 328                               :initial-element 0))
 329           (result-svector (make-array '(10) :element-type '(signed-byte 8)
 330                               :initial-element 0))
 331           (result-string (make-string (length *dumb-string*)
 332                                       :initial-element #\Space)))
 333       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 334                          :if-exists :overwrite :if-does-not-exist :create
 335                          :delete-afterwards nil)
 336         (write-sequence svector s)
 337         (write-sequence uvector s)
 338         (write-sequence *dumb-string* s))
 339       (with-test-file (s *test-file* :class 'file-simple-stream
 340                          :direction :input :if-does-not-exist :error
 341                          :delete-afterwards nil)
 342         (read-sequence result-svector s)
 343         (read-sequence result-uvector s)
 344         (read-sequence result-string s))
 345       (and (string= *dumb-string* result-string)
 346            (equalp uvector result-uvector)
 347            (equalp svector result-svector)))
 348   T)
 349
 350 (defparameter *multi-line-string*
 351   "This file was created by simple-stream-tests.lisp.
 352 Nothing to see here, move along.")
 353
 354 (defmacro with-dc-test-stream ((s &key initial-content) &body body)
 355   `(with-test-file
 356        (.ansi-stream.
 357         *test-file*
 358         :direction :io
 359         :if-exists :overwrite
 360         :initial-content ,(or initial-content '*multi-line-string*))
 361      (let ((,s (make-instance 'terminal-simple-stream
 362                  :input-handle (sb-kernel::fd-stream-fd .ansi-stream.)
 363                  :output-handle (sb-kernel::fd-stream-fd .ansi-stream.))))
 364        ,@body)))
 365
 366 (defmacro with-sc-test-stream ((s &key initial-content) &body body)
 367   `(with-test-file
 368        (,s
 369         *test-file*
 370         :class 'file-simple-stream
 371         :direction :io
 372         :if-exists :overwrite
 373         :initial-content ,(or initial-content '*multi-line-string*))
 374      ,@body))
 375
 376 ;;; 0.8.3.93 tried to fix LISTEN on dual channel streams, but failed to do so:
 377
 378 (deftest listen-dc-1
 379     ;; LISTEN with filled buffer
 380     (with-dc-test-stream (s) (read-char s) (listen s))
 381   T)
 382
 383 (deftest listen-dc-2
 384     ;; LISTEN with empty buffer
 385     (with-dc-test-stream (s) (listen s))
 386   T)
 387
 388 (deftest listen-dc-3
 389     ;; LISTEN at EOF
 390     (with-dc-test-stream (s)
 391       (read-line s)
 392       (read-line s)
 393       (listen s))
 394   NIL)
 395
 396 ;;; the following tests are for problems fixed in SBCL 0.8.6.2:
 397
 398 (deftest charpos-1
 399     ;; check for bug involving the -1 vs. 0 oddity in std-dc-newline-in-handler
 400     ;;
 401     ;; Note: It not not clear to me that input should affect the CHARPOS at
 402     ;; all.  (Except for a terminal stream perhaps, which our test stream
 403     ;; happens to be.  Hmm.)
 404     ;;
 405     ;; But CHARPOS must not be -1, so much is sure, hence this test is right
 406     ;; in any case.
 407     (with-dc-test-stream (s)
 408       (read-line s)
 409       (sb-simple-streams:charpos s))
 410   0)
 411
 412 (deftest charpos-2
 413     ;; FIXME: It not not clear to me that input should affect the CHARPOS at
 414     ;; all, and indeed it does not.  That is, except for newlines?! (see above)
 415     ;;
 416     ;; What this test does is (a) check that the CHARPOS works at all without
 417     ;; erroring and (b) force anyone changing the CHARPOS behaviour to read
 418     ;; this comment and start thinking things through better than I can.
 419     (with-dc-test-stream (s)
 420       (read-char s)
 421       (and (eql (sb-kernel:charpos s) 0)
 422            (eql (sb-simple-streams:charpos s) 0)))
 423   T)
 424
 425 (deftest reader-1
 426     ;; does the reader support simple streams?  Note that, say, "123" instead
 427     ;; of "(1 2)" does not trigger the bugs present in SBCL 0.8.6.
 428     (with-dc-test-stream (s :initial-content "(1 2)")
 429       (equal (read s) '(1 2)))
 430   T)
 431
 432 (deftest line-length-dc-1
 433     ;; does LINE-LENGTH support simple streams?
 434     (with-dc-test-stream (s)
 435       (eql (sb-simple-streams:line-length s)
 436            (sb-kernel:line-length s)))
 437   T)
 438
 439 (defvar *synonym*)
 440
 441 ;; the biggest change in 0.8.6.2:
 442 ;; support composite streams writing to simple streams
 443
 444 ;; first, SYNONYM-STREAM:
 445
 446 (deftest synonym-stream-1
 447     ;; READ-CHAR
 448     (with-dc-test-stream (*synonym*)
 449       (read-char (make-synonym-stream '*synonym*)))
 450   #\T)
 451
 452 (deftest synonym-stream-2
 453     ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
 454     (with-dc-test-stream (*synonym*)
 455       (let ((s (make-synonym-stream '*synonym*)))
 456         (unread-char (read-char s) s)
 457         (read-char s)))
 458   #\T)
 459
 460 (deftest synonym-stream-3
 461     ;; READ-BYTE
 462     (with-dc-test-stream (*synonym*)
 463       (read-byte (make-synonym-stream '*synonym*)))
 464   #.(char-code #\T))
 465
 466 (deftest synonym-stream-4
 467     ;; WRITE-CHAR
 468     (with-sc-test-stream (*synonym*)
 469       (let ((s (make-synonym-stream '*synonym*)))
 470         (write-char #\A s)
 471         (file-position s 0)
 472         (read-char s)))
 473   #\A)
 474
 475 (deftest synonym-stream-5
 476     ;; WRITE-BYTE
 477     (with-sc-test-stream (*synonym*)
 478       (let ((s (make-synonym-stream '*synonym*)))
 479         (write-byte 65 s)
 480         (file-position s 0)
 481         (read-char s)))
 482   #\A)
 483
 484 (deftest synonym-stream-6
 485     ;; WRITE-STRING
 486     (with-sc-test-stream (*synonym*)
 487       (let ((s (make-synonym-stream '*synonym*)))
 488         (write-string "ab" s)
 489         (file-position s 0)
 490         (and (char= (read-char s) #\a)
 491              (char= (read-char s) #\b))))
 492   T)
 493
 494 (deftest synonym-stream-7
 495     ;; LISTEN (via STREAM-MISC-DISPATCH)
 496     (with-sc-test-stream (*synonym*)
 497       (let ((s (make-synonym-stream '*synonym*)))
 498         (and (listen s) t)))
 499   T)
 500
 501 (deftest synonym-stream-8
 502     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
 503     (with-sc-test-stream (*synonym*)
 504       (let ((s (make-synonym-stream '*synonym*)))
 505         (clear-input s)
 506         (listen s)))
 507   NIL)
 508
 509 (deftest synonym-stream-9
 510     ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
 511     (with-sc-test-stream (*synonym*)
 512       ;; could test more here
 513       (force-output (make-synonym-stream '*synonym*)))
 514   NIL)
 515
 516 (deftest synonym-stream-10
 517     ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
 518     (with-sc-test-stream (*synonym*)
 519       ;; could test more here
 520       (finish-output (make-synonym-stream '*synonym*)))
 521   NIL)
 522
 523 (deftest synonym-stream-11
 524     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 525     (with-sc-test-stream (*synonym*)
 526       (eql (stream-element-type (make-synonym-stream '*synonym*))
 527            (stream-element-type *synonym*)))
 528   T)
 529
 530 (deftest synonym-stream-12
 531     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 532     (with-sc-test-stream (*synonym*)
 533       (eql (interactive-stream-p (make-synonym-stream '*synonym*))
 534            (interactive-stream-p *synonym*)))
 535   T)
 536
 537 (deftest synonym-stream-13
 538     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 539     (with-sc-test-stream (*synonym*)
 540       (eql (sb-kernel:line-length (make-synonym-stream '*synonym*))
 541            (sb-kernel:line-length *synonym*)))
 542   T)
 543
 544 (deftest synonym-stream-14
 545     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 546     (with-sc-test-stream (*synonym*)
 547       (eql (sb-kernel:charpos (make-synonym-stream '*synonym*))
 548            (sb-kernel:charpos *synonym*)))
 549   T)
 550
 551 (deftest synonym-stream-15
 552     ;; FILE-LENGTH (via STREAM-MISC-DISPATCH)
 553     (with-sc-test-stream (*synonym*)
 554       (eql (file-length (make-synonym-stream '*synonym*))
 555            (file-length *synonym*)))
 556   T)
 557
 558 (deftest synonym-stream-16
 559     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 560     (with-sc-test-stream (*synonym*)
 561       (eql (file-position (make-synonym-stream '*synonym*))
 562            (file-position *synonym*)))
 563   T)
 564
 565 ;; SYNONYM-STREAM tests repeated for BROADCAST-STREAM, where applicable
 566
 567 (deftest broadcast-stream-4
 568     ;; WRITE-CHAR
 569     (with-sc-test-stream (synonym)
 570       (let ((s (make-broadcast-stream synonym)))
 571         (write-char #\A s)
 572         (force-output s))
 573       (file-position synonym 0)
 574       (read-char synonym))
 575   #\A)
 576
 577 (deftest broadcast-stream-5
 578     ;; WRITE-BYTE
 579     (with-sc-test-stream (synonym)
 580       (let ((s (make-broadcast-stream synonym)))
 581         (write-byte 65 s)
 582         (force-output s))
 583       (file-position synonym 0)
 584       (read-char synonym))
 585   #\A)
 586
 587 (deftest broadcast-stream-6
 588     ;; WRITE-STRING
 589     (with-sc-test-stream (synonym)
 590       (let ((s (make-broadcast-stream synonym)))
 591         (write-string "ab" s)
 592         (force-output s))
 593       (file-position synonym 0)
 594       (and (char= (read-char synonym) #\a)
 595            (char= (read-char synonym) #\b)))
 596   T)
 597
 598 (deftest broadcast-stream-9
 599     ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
 600     (with-sc-test-stream (synonym)
 601       ;; could test more here
 602       (force-output (make-broadcast-stream synonym)))
 603   NIL)
 604
 605 (deftest broadcast-stream-10
 606     ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
 607     (with-sc-test-stream (synonym)
 608       ;; could test more here
 609       (finish-output (make-broadcast-stream synonym)))
 610   NIL)
 611
 612 (deftest broadcast-stream-11
 613     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 614     (with-sc-test-stream (synonym)
 615       (eql (stream-element-type (make-broadcast-stream synonym))
 616            (stream-element-type synonym)))
 617   T)
 618
 619 (deftest broadcast-stream-12
 620     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 621     (with-sc-test-stream (synonym)
 622       (eql (interactive-stream-p (make-broadcast-stream synonym))
 623            (interactive-stream-p synonym)))
 624   T)
 625
 626 (deftest broadcast-stream-13
 627     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 628     (with-sc-test-stream (synonym)
 629       (eql (sb-kernel:line-length (make-broadcast-stream synonym))
 630            (sb-kernel:line-length synonym)))
 631   T)
 632
 633 (deftest broadcast-stream-14
 634     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 635     (with-sc-test-stream (synonym)
 636       (eql (sb-kernel:charpos (make-broadcast-stream synonym))
 637            (sb-kernel:charpos synonym)))
 638   T)
 639
 640 (deftest broadcast-stream-16
 641     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 642     (with-sc-test-stream (synonym)
 643       (eql (file-position (make-broadcast-stream synonym))
 644            (file-position synonym)))
 645   T)
 646
 647 ;; SYNONYM-STREAM tests repeated for TWO-WAY-STREAM, where applicable
 648
 649 (deftest two-way-stream-1
 650     ;; READ-CHAR
 651     (with-dc-test-stream (synonym)
 652       (read-char (make-two-way-stream synonym synonym)))
 653   #\T)
 654
 655 (deftest two-way-stream-2
 656     ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
 657     (with-dc-test-stream (synonym)
 658       (let ((s (make-two-way-stream synonym synonym)))
 659         (unread-char (read-char s) s)
 660         (read-char s)))
 661   #\T)
 662
 663 (deftest two-way-stream-3
 664     ;; READ-BYTE
 665     (with-dc-test-stream (synonym)
 666       (read-byte (make-two-way-stream synonym synonym)))
 667   #.(char-code #\T))
 668
 669 (deftest two-way-stream-4
 670     ;; WRITE-CHAR
 671     (with-sc-test-stream (synonym)
 672       (let ((s (make-two-way-stream synonym synonym)))
 673         (write-char #\A s)
 674         (force-output s))
 675       (file-position synonym 0)
 676       (read-char synonym))
 677   #\A)
 678
 679 (deftest two-way-stream-5
 680     ;; WRITE-BYTE
 681     (with-sc-test-stream (synonym)
 682       (let ((s (make-two-way-stream synonym synonym)))
 683         (write-byte 65 s)
 684         (force-output s))
 685       (file-position synonym 0)
 686       (read-char synonym))
 687   #\A)
 688
 689 (deftest two-way-stream-6
 690     ;; WRITE-STRING
 691     (with-sc-test-stream (synonym)
 692       (let ((s (make-two-way-stream synonym synonym)))
 693         (write-string "ab" s)
 694         (force-output s))
 695       (file-position synonym 0)
 696       (and (char= (read-char synonym) #\a)
 697            (char= (read-char synonym) #\b)))
 698   T)
 699
 700 (deftest two-way-stream-7
 701     ;; LISTEN (via STREAM-MISC-DISPATCH)
 702     (with-sc-test-stream (synonym)
 703       (let ((s (make-two-way-stream synonym synonym)))
 704         (and (listen s) t)))
 705   T)
 706
 707 (deftest two-way-stream-8
 708     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
 709     (with-sc-test-stream (synonym)
 710       (let ((s (make-two-way-stream synonym synonym)))
 711         (clear-input s)
 712         (listen s)))
 713   NIL)
 714
 715 (deftest two-way-stream-9
 716     ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
 717     (with-sc-test-stream (synonym)
 718       ;; could test more here
 719       (force-output (make-two-way-stream synonym synonym)))
 720   NIL)
 721
 722 (deftest two-way-stream-10
 723     ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
 724     (with-sc-test-stream (synonym)
 725       ;; could test more here
 726       (finish-output (make-two-way-stream synonym synonym)))
 727   NIL)
 728
 729 (deftest two-way-stream-11
 730     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 731     (with-sc-test-stream (synonym)
 732       (eql (stream-element-type (make-two-way-stream synonym synonym))
 733            (stream-element-type synonym)))
 734   T)
 735
 736 (deftest two-way-stream-12
 737     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 738     (with-sc-test-stream (synonym)
 739       (eql (interactive-stream-p (make-two-way-stream synonym synonym))
 740            (interactive-stream-p synonym)))
 741   T)
 742
 743 (deftest two-way-stream-13
 744     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 745     (with-sc-test-stream (synonym)
 746       (eql (sb-kernel:line-length (make-two-way-stream synonym synonym))
 747            (sb-kernel:line-length synonym)))
 748   T)
 749
 750 (deftest two-way-stream-14
 751     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 752     (with-sc-test-stream (synonym)
 753       (eql (sb-kernel:charpos (make-two-way-stream synonym synonym))
 754            (sb-kernel:charpos synonym)))
 755   T)
 756
 757 (deftest two-way-stream-16
 758     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 759     (with-sc-test-stream (synonym)
 760       (eql (file-position (make-two-way-stream synonym synonym))
 761            (file-position synonym)))
 762   T)
 763
 764 ;; SYNONYM-STREAM tests repeated for ECHO-STREAM, where applicable
 765
 766 (deftest echo-stream-1
 767     ;; READ-CHAR
 768     (with-dc-test-stream (*synonym*)
 769       (read-char (make-echo-stream *synonym* *synonym*)))
 770   #\T)
 771
 772 (deftest echo-stream-2
 773     ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
 774     (with-dc-test-stream (*synonym*)
 775       (let ((s (make-echo-stream *synonym* *synonym*)))
 776         (unread-char (read-char s) s)
 777         (read-char s)))
 778   #\T)
 779
 780 (deftest echo-stream-3
 781     ;; READ-BYTE
 782     (with-dc-test-stream (*synonym*)
 783       (read-byte (make-echo-stream *synonym* *synonym*)))
 784   #.(char-code #\T))
 785
 786 (deftest echo-stream-7
 787     ;; LISTEN (via STREAM-MISC-DISPATCH)
 788     (with-sc-test-stream (*synonym*)
 789       (let ((s (make-echo-stream *synonym* *synonym*)))
 790         (and (listen s) t)))
 791   T)
 792
 793 (deftest echo-stream-8
 794     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
 795     (with-sc-test-stream (*synonym*)
 796       (let ((s (make-echo-stream *synonym* *synonym*)))
 797         (clear-input s)
 798         (listen s)))
 799   NIL)
 800
 801 (deftest echo-stream-11
 802     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 803     (with-sc-test-stream (*synonym*)
 804       (eql (stream-element-type (make-echo-stream *synonym* *synonym*))
 805            (stream-element-type *synonym*)))
 806   T)
 807
 808 (deftest echo-stream-12
 809     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 810     (with-sc-test-stream (*synonym*)
 811       (eql (interactive-stream-p (make-echo-stream *synonym* *synonym*))
 812            (interactive-stream-p *synonym*)))
 813   T)
 814
 815 (deftest echo-stream-13
 816     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 817     (with-sc-test-stream (*synonym*)
 818       (eql (sb-kernel:line-length (make-echo-stream *synonym* *synonym*))
 819            (sb-kernel:line-length *synonym*)))
 820   T)
 821
 822 (deftest echo-stream-14
 823     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 824     (with-sc-test-stream (*synonym*)
 825       (eql (sb-kernel:charpos (make-echo-stream *synonym* *synonym*))
 826            (sb-kernel:charpos *synonym*)))
 827   T)
 828
 829 (deftest echo-stream-16
 830     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 831     (with-sc-test-stream (*synonym*)
 832       (eql (file-position (make-echo-stream *synonym* *synonym*))
 833            (file-position *synonym*)))
 834   T)
 835
 836 ;; SYNONYM-STREAM tests repeated for CONCATENATED-STREAM, where applicable
 837
 838 (deftest concatenated-stream-1
 839     ;; READ-CHAR
 840     (with-dc-test-stream (*synonym*)
 841       (read-char (make-concatenated-stream *synonym*)))
 842   #\T)
 843
 844 (deftest concatenated-stream-2
 845     ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
 846     (with-dc-test-stream (*synonym*)
 847       (let ((s (make-concatenated-stream *synonym*)))
 848         (unread-char (read-char s) s)
 849         (read-char s)))
 850   #\T)
 851
 852 (deftest concatenated-stream-3
 853     ;; READ-BYTE
 854     (with-dc-test-stream (*synonym*)
 855       (read-byte (make-concatenated-stream *synonym*)))
 856   #.(char-code #\T))
 857
 858 (deftest concatenated-stream-7
 859     ;; LISTEN (via STREAM-MISC-DISPATCH)
 860     (with-sc-test-stream (*synonym*)
 861       (let ((s (make-concatenated-stream *synonym*)))
 862         (and (listen s) t)))
 863   T)
 864
 865 (deftest concatenated-stream-8
 866     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
 867     (with-sc-test-stream (*synonym*)
 868       (let ((s (make-concatenated-stream *synonym*)))
 869         (clear-input s)
 870         (listen s)))
 871   NIL)
 872
 873 (deftest concatenated-stream-11
 874     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 875     (with-sc-test-stream (*synonym*)
 876       (eql (stream-element-type (make-concatenated-stream *synonym*))
 877            (stream-element-type *synonym*)))
 878   T)
 879
 880 (deftest concatenated-stream-12
 881     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 882     (with-sc-test-stream (*synonym*)
 883       (eql (interactive-stream-p (make-concatenated-stream *synonym*))
 884            (interactive-stream-p *synonym*)))
 885   T)
 886
 887 (deftest concatenated-stream-13
 888     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 889     (with-sc-test-stream (*synonym*)
 890       (eql (sb-kernel:line-length (make-concatenated-stream *synonym*))
 891            (sb-kernel:line-length *synonym*)))
 892   T)
 893
 894 (deftest concatenated-stream-14
 895     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 896     (with-sc-test-stream (*synonym*)
 897       (eql (sb-kernel:charpos (make-concatenated-stream *synonym*))
 898            (sb-kernel:charpos *synonym*)))
 899   T)
 900
 901 (deftest concatenated-stream-16
 902     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 903     (with-sc-test-stream (*synonym*)
 904       (eql (file-position (make-concatenated-stream *synonym*))
 905            (file-position *synonym*)))
 906   T)
 907
 908 ;; uncovered by synonym-stream-15
 909
 910 (deftest file-simple-stream-1
 911     (values (subtypep 'file-simple-stream 'file-stream))
 912   T)
 913
 914 (deftest string-simple-stream-1
 915     (values (subtypep 'string-simple-stream 'string-stream))
 916   T)