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     ;; Timeout may occur on the restricted systems (e.g. FreeBSD
 129     ;; with jail(8) or blackhole(4) is used).
 130     (sb-bsd-sockets::operation-timeout-error () t))
 131   t)
 132
 133 (deftest write-read-large-sc-1
 134   ;; Do write and read with more data than the buffer will hold
 135   ;; (single-channel simple-stream)
 136   (let* ((stream (make-instance 'file-simple-stream
 137                                 :filename *test-file* :direction :output
 138                                 :if-exists :overwrite
 139                                 :if-does-not-exist :create))
 140          (content (make-string (1+ (device-buffer-length stream))
 141                                :initial-element #\x)))
 142     (with-open-stream (s stream)
 143       (write-string content s))
 144     (with-test-file (s *test-file* :class 'file-simple-stream
 145                        :direction :input :if-does-not-exist :error)
 146       (string= content (read-line s))))
 147   t)
 148
 149 (deftest write-read-large-sc-2
 150   (let* ((stream (make-instance 'file-simple-stream
 151                                 :filename *test-file* :direction :output
 152                                 :if-exists :overwrite
 153                                 :if-does-not-exist :create))
 154          (length (1+ (* 3 (device-buffer-length stream))))
 155          (content (make-string length)))
 156     (dotimes (i (length content))
 157       (setf (aref content i) (code-char (random 256))))
 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       (let ((seq (make-string length)))
 163         #+nil (read-sequence seq s)
 164         #-nil (dotimes (i length)
 165                 (setf (char seq i) (read-char s)))
 166         (string= content seq))))
 167   t)
 168
 169 (deftest write-read-large-sc-3
 170   (let* ((stream (make-instance 'file-simple-stream
 171                                 :filename *test-file* :direction :output
 172                                 :if-exists :overwrite
 173                                 :if-does-not-exist :create))
 174          (length (1+ (* 3 (device-buffer-length stream))))
 175          (content (make-array length :element-type '(unsigned-byte 8))))
 176     (dotimes (i (length content))
 177       (setf (aref content i) (random 256)))
 178     (with-open-stream (s stream)
 179       (write-sequence content s))
 180     (with-test-file (s *test-file* :class 'file-simple-stream
 181                        :direction :input :if-does-not-exist :error)
 182       (let ((seq (make-array length :element-type '(unsigned-byte 8))))
 183         #+nil (read-sequence seq s)
 184         #-nil (dotimes (i length)
 185                 (setf (aref seq i) (read-byte s)))
 186         (equalp content seq))))
 187   t)
 188
 189 (deftest write-read-large-dc-1
 190   ;; Do write and read with more data than the buffer will hold
 191   ;; (dual-channel simple-stream; we only have socket streams atm)
 192   (handler-case
 193    (let* ((stream (make-instance 'socket-simple-stream
 194                                  :remote-host #(127 0 0 1)
 195                                  :remote-port 7
 196                                  :direction :io))
 197           (content (make-string (1+ (device-buffer-length stream))
 198                                 :initial-element #\x)))
 199      (with-open-stream (s stream)
 200        (string= (prog1 (write-line content s) (finish-output s))
 201                 (read-line s))))
 202     ;; Fail gracefully if echo isn't activated on the system
 203    (sb-bsd-sockets::connection-refused-error () t)
 204    ;; Timeout may occur on the restricted systems (e.g. FreeBSD
 205    ;; with jail(8) or blackhole(4) is used).
 206    (sb-bsd-sockets::operation-timeout-error () t))
 207   t)
 208
 209
 210 (deftest file-position-1
 211     ;; Test reading of file-position
 212     (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
 213                        :initial-content *dumb-string*)
 214       (file-position s))
 215   0)
 216
 217 (deftest file-position-2
 218     ;; Test reading of file-position
 219     (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
 220                        :initial-content *dumb-string*)
 221       (read-byte s)
 222       (file-position s))
 223   1)
 224
 225 (deftest file-position-3
 226     ;; Test reading of file-position in the presence of unsaved data
 227     (with-test-file (s *test-file* :class 'file-simple-stream
 228                        :direction :output :if-exists :supersede
 229                        :if-does-not-exist :create)
 230       (write-byte 50 s)
 231       (file-position s))
 232   1)
 233
 234 (deftest file-position-4
 235     ;; Test reading of file-position in the presence of unsaved data and
 236     ;; filled buffer
 237     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 238                        :if-exists :overwrite :if-does-not-exist :create
 239                        :initial-content *dumb-string*)
 240       (read-byte s)                     ; fill buffer
 241       (write-byte 50 s)                 ; advance file-position
 242       (file-position s))
 243   2)
 244
 245 (deftest file-position-5
 246     ;; Test file position when opening with :if-exists :append
 247     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 248                        :if-exists :append :if-does-not-exist :create
 249                        :initial-content *dumb-string*)
 250       (= (file-length s) (file-position s)))
 251   T)
 252
 253 (deftest write-read-unflushed-sc-1
 254     ;; Write something into a single-channel stream and read it back
 255     ;; without explicitly flushing the buffer in-between
 256     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 257                        :if-does-not-exist :create :if-exists :supersede)
 258       (write-char #\x s)
 259       (file-position s :start)
 260       (read-char s))
 261   #\x)
 262
 263 (deftest write-read-unflushed-sc-2
 264     ;; Write something into a single-channel stream, try to read back too much
 265     (handler-case
 266         (with-test-file (s *test-file* :class 'file-simple-stream
 267                            :direction :io :if-does-not-exist :create
 268                            :if-exists :supersede)
 269             (write-char #\x s)
 270             (file-position s :start)
 271             (read-char s)
 272             (read-char s)
 273             nil)
 274       (end-of-file () t))
 275   t)
 276
 277 (deftest write-read-unflushed-sc-3
 278     ;; Test writing in a buffer filled with previous file contents
 279     (let ((result t))
 280       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 281                          :if-exists :overwrite :if-does-not-exist :create
 282                          :initial-content *dumb-string*)
 283         (setq result (and result (char= (read-char s) (schar *dumb-string* 0))))
 284         (setq result (and result (= (file-position s) 1)))
 285         (let ((pos (file-position s)))
 286           (write-char #\x s)
 287           (file-position s pos)
 288           (setq result (and result (char= (read-char s) #\x)))))
 289       result)
 290   t)
 291
 292 (deftest write-read-unflushed-sc-4
 293     ;; Test flushing of buffers
 294     (progn
 295       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 296                          :if-exists :overwrite :if-does-not-exist :create
 297                          :initial-content "Foo"
 298                          :delete-afterwards nil)
 299         (read-char s)                   ; Fill the buffer.
 300         (file-position s :start)        ; Change existing data.
 301         (write-char #\X s)
 302         (file-position s :end)          ; Extend file.
 303         (write-char #\X s))
 304       (with-test-file (s *test-file* :class 'file-simple-stream
 305                          :direction :input :if-does-not-exist :error)
 306         (read-line s)))
 307   "XooX"
 308   T)
 309
 310 (deftest write-read-append-sc-1
 311     ;; Test writing in the middle of a stream opened in append mode
 312     (progn
 313       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 314                          :if-exists :append :if-does-not-exist :create
 315                          :initial-content "Foo"
 316                          :delete-afterwards nil)
 317         (file-position s :start)        ; Jump to beginning.
 318         (write-char #\X s)
 319         (file-position s :end)          ; Extend file.
 320         (write-char #\X s))
 321       (with-test-file (s *test-file* :class 'file-simple-stream
 322                          :direction :input :if-does-not-exist :error)
 323         (read-line s)))
 324   "XooX"
 325   T)
 326
 327 (deftest write-read-mixed-sc-1
 328     ;; Test read/write-sequence of types string and (unsigned-byte 8)
 329     (let ((uvector (make-array '(10) :element-type '(unsigned-byte 8)
 330                                :initial-element 64))
 331           (svector (make-array '(10) :element-type '(signed-byte 8)
 332                                :initial-element -1))
 333           (result-uvector (make-array '(10) :element-type '(unsigned-byte 8)
 334                               :initial-element 0))
 335           (result-svector (make-array '(10) :element-type '(signed-byte 8)
 336                               :initial-element 0))
 337           (result-string (make-string (length *dumb-string*)
 338                                       :initial-element #\Space)))
 339       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 340                          :if-exists :overwrite :if-does-not-exist :create
 341                          :delete-afterwards nil)
 342         (write-sequence svector s)
 343         (write-sequence uvector s)
 344         (write-sequence *dumb-string* s))
 345       (with-test-file (s *test-file* :class 'file-simple-stream
 346                          :direction :input :if-does-not-exist :error
 347                          :delete-afterwards nil)
 348         (read-sequence result-svector s)
 349         (read-sequence result-uvector s)
 350         (read-sequence result-string s))
 351       (and (string= *dumb-string* result-string)
 352            (equalp uvector result-uvector)
 353            (equalp svector result-svector)))
 354   T)
 355
 356 (defparameter *multi-line-string*
 357   "This file was created by simple-stream-tests.lisp.
 358 Nothing to see here, move along.")
 359
 360 (defmacro with-dc-test-stream ((s &key initial-content) &body body)
 361   `(with-test-file
 362        (.ansi-stream.
 363         *test-file*
 364         :direction :io
 365         :if-exists :overwrite
 366         :initial-content ,(or initial-content '*multi-line-string*))
 367      (let ((,s (make-instance 'terminal-simple-stream
 368                  :input-handle (sb-kernel::fd-stream-fd .ansi-stream.)
 369                  :output-handle (sb-kernel::fd-stream-fd .ansi-stream.))))
 370        ,@body)))
 371
 372 (defmacro with-sc-test-stream ((s &key initial-content) &body body)
 373   `(with-test-file
 374        (,s
 375         *test-file*
 376         :class 'file-simple-stream
 377         :direction :io
 378         :if-exists :overwrite
 379         :initial-content ,(or initial-content '*multi-line-string*))
 380      ,@body))
 381
 382 (deftest listen-dc-1
 383     ;; LISTEN with filled buffer
 384     (with-dc-test-stream (s) (read-char s) (listen s))
 385   T)
 386
 387 (deftest listen-dc-2
 388     ;; LISTEN with empty buffer
 389     (with-dc-test-stream (s) (listen s))
 390   T)
 391
 392 (deftest listen-dc-3
 393     ;; LISTEN at EOF
 394     (with-dc-test-stream (s)
 395       (read-line s)
 396       (read-line s)
 397       (listen s))
 398   NIL)
 399
 400 ;;; the following tests are for problems fixed in SBCL 0.8.6.2:
 401
 402 (deftest charpos-1
 403     ;; check for bug involving the -1 vs. 0 oddity in std-dc-newline-in-handler
 404     ;;
 405     ;; Note: It not not clear to me that input should affect the CHARPOS at
 406     ;; all.  (Except for a terminal stream perhaps, which our test stream
 407     ;; happens to be.  Hmm.)
 408     ;;
 409     ;; But CHARPOS must not be -1, so much is sure, hence this test is right
 410     ;; in any case.
 411     (with-dc-test-stream (s)
 412       (read-line s)
 413       (sb-simple-streams:charpos s))
 414   0)
 415
 416 (deftest charpos-2
 417     ;; FIXME: It not not clear to me that input should affect the CHARPOS at
 418     ;; all, and indeed it does not.  That is, except for newlines?! (see above)
 419     ;;
 420     ;; What this test does is (a) check that the CHARPOS works at all without
 421     ;; erroring and (b) force anyone changing the CHARPOS behaviour to read
 422     ;; this comment and start thinking things through better than I can.
 423     (with-dc-test-stream (s)
 424       (read-char s)
 425       (and (eql (sb-kernel:charpos s) 0)
 426            (eql (sb-simple-streams:charpos s) 0)))
 427   T)
 428
 429 (deftest reader-1
 430     ;; does the reader support simple streams?  Note that, say, "123" instead
 431     ;; of "(1 2)" does not trigger the bugs present in SBCL 0.8.6.
 432     (with-dc-test-stream (s :initial-content "(1 2)")
 433       (equal (read s) '(1 2)))
 434   T)
 435
 436 (deftest line-length-dc-1
 437     ;; does LINE-LENGTH support simple streams?
 438     (with-dc-test-stream (s)
 439       (eql (sb-simple-streams:line-length s)
 440            (sb-kernel:line-length s)))
 441   T)
 442
 443 (defvar *synonym*)
 444
 445 ;; the biggest change in 0.8.6.2:
 446 ;; support composite streams writing to simple streams
 447
 448 ;; first, SYNONYM-STREAM:
 449
 450 (deftest synonym-stream-1
 451     ;; READ-CHAR
 452     (with-dc-test-stream (*synonym*)
 453       (read-char (make-synonym-stream '*synonym*)))
 454   #\T)
 455
 456 (deftest synonym-stream-2
 457     ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
 458     (with-dc-test-stream (*synonym*)
 459       (let ((s (make-synonym-stream '*synonym*)))
 460         (unread-char (read-char s) s)
 461         (read-char s)))
 462   #\T)
 463
 464 (deftest synonym-stream-3
 465     ;; READ-BYTE
 466     (with-dc-test-stream (*synonym*)
 467       (read-byte (make-synonym-stream '*synonym*)))
 468   #.(char-code #\T))
 469
 470 (deftest synonym-stream-4
 471     ;; WRITE-CHAR
 472     (with-sc-test-stream (*synonym*)
 473       (let ((s (make-synonym-stream '*synonym*)))
 474         (write-char #\A s)
 475         (file-position s 0)
 476         (read-char s)))
 477   #\A)
 478
 479 (deftest synonym-stream-5
 480     ;; WRITE-BYTE
 481     (with-sc-test-stream (*synonym*)
 482       (let ((s (make-synonym-stream '*synonym*)))
 483         (write-byte 65 s)
 484         (file-position s 0)
 485         (read-char s)))
 486   #\A)
 487
 488 (deftest synonym-stream-6
 489     ;; WRITE-STRING
 490     (with-sc-test-stream (*synonym*)
 491       (let ((s (make-synonym-stream '*synonym*)))
 492         (write-string "ab" s)
 493         (file-position s 0)
 494         (and (char= (read-char s) #\a)
 495              (char= (read-char s) #\b))))
 496   T)
 497
 498 (deftest synonym-stream-7
 499     ;; LISTEN (via STREAM-MISC-DISPATCH)
 500     (with-sc-test-stream (*synonym*)
 501       (let ((s (make-synonym-stream '*synonym*)))
 502         (and (listen s) t)))
 503   T)
 504
 505 (deftest synonym-stream-8
 506     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
 507     (with-sc-test-stream (*synonym*)
 508       (let ((s (make-synonym-stream '*synonym*)))
 509         (clear-input s)))
 510   NIL)
 511
 512 (deftest synonym-stream-9
 513     ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
 514     (with-sc-test-stream (*synonym*)
 515       ;; could test more here
 516       (force-output (make-synonym-stream '*synonym*)))
 517   NIL)
 518
 519 (deftest synonym-stream-10
 520     ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
 521     (with-sc-test-stream (*synonym*)
 522       ;; could test more here
 523       (finish-output (make-synonym-stream '*synonym*)))
 524   NIL)
 525
 526 (deftest synonym-stream-11
 527     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 528     (with-sc-test-stream (*synonym*)
 529       (eql (stream-element-type (make-synonym-stream '*synonym*))
 530            (stream-element-type *synonym*)))
 531   T)
 532
 533 (deftest synonym-stream-12
 534     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 535     (with-sc-test-stream (*synonym*)
 536       (eql (interactive-stream-p (make-synonym-stream '*synonym*))
 537            (interactive-stream-p *synonym*)))
 538   T)
 539
 540 (deftest synonym-stream-13
 541     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 542     (with-sc-test-stream (*synonym*)
 543       (eql (sb-kernel:line-length (make-synonym-stream '*synonym*))
 544            (sb-kernel:line-length *synonym*)))
 545   T)
 546
 547 (deftest synonym-stream-14
 548     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 549     (with-sc-test-stream (*synonym*)
 550       (eql (sb-kernel:charpos (make-synonym-stream '*synonym*))
 551            (sb-kernel:charpos *synonym*)))
 552   T)
 553
 554 (deftest synonym-stream-15
 555     ;; FILE-LENGTH (via STREAM-MISC-DISPATCH)
 556     (with-sc-test-stream (*synonym*)
 557       (eql (file-length (make-synonym-stream '*synonym*))
 558            (file-length *synonym*)))
 559   T)
 560
 561 (deftest synonym-stream-16
 562     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 563     (with-sc-test-stream (*synonym*)
 564       (eql (file-position (make-synonym-stream '*synonym*))
 565            (file-position *synonym*)))
 566   T)
 567
 568 ;; SYNONYM-STREAM tests repeated for BROADCAST-STREAM, where applicable
 569
 570 (deftest broadcast-stream-4
 571     ;; WRITE-CHAR
 572     (with-sc-test-stream (synonym)
 573       (let ((s (make-broadcast-stream synonym)))
 574         (write-char #\A s)
 575         (force-output s))
 576       (file-position synonym 0)
 577       (read-char synonym))
 578   #\A)
 579
 580 (deftest broadcast-stream-5
 581     ;; WRITE-BYTE
 582     (with-sc-test-stream (synonym)
 583       (let ((s (make-broadcast-stream synonym)))
 584         (write-byte 65 s)
 585         (force-output s))
 586       (file-position synonym 0)
 587       (read-char synonym))
 588   #\A)
 589
 590 (deftest broadcast-stream-6
 591     ;; WRITE-STRING
 592     (with-sc-test-stream (synonym)
 593       (let ((s (make-broadcast-stream synonym)))
 594         (write-string "ab" s)
 595         (force-output s))
 596       (file-position synonym 0)
 597       (and (char= (read-char synonym) #\a)
 598            (char= (read-char synonym) #\b)))
 599   T)
 600
 601 (deftest broadcast-stream-9
 602     ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
 603     (with-sc-test-stream (synonym)
 604       ;; could test more here
 605       (force-output (make-broadcast-stream synonym)))
 606   NIL)
 607
 608 (deftest broadcast-stream-10
 609     ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
 610     (with-sc-test-stream (synonym)
 611       ;; could test more here
 612       (finish-output (make-broadcast-stream synonym)))
 613   NIL)
 614
 615 (deftest broadcast-stream-11
 616     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 617     (with-sc-test-stream (synonym)
 618       (eql (stream-element-type (make-broadcast-stream synonym))
 619            (stream-element-type synonym)))
 620   T)
 621
 622 (deftest broadcast-stream-12
 623     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 624     (with-sc-test-stream (synonym)
 625       (eql (interactive-stream-p (make-broadcast-stream synonym))
 626            (interactive-stream-p synonym)))
 627   T)
 628
 629 (deftest broadcast-stream-13
 630     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 631     (with-sc-test-stream (synonym)
 632       (eql (sb-kernel:line-length (make-broadcast-stream synonym))
 633            (sb-kernel:line-length synonym)))
 634   T)
 635
 636 (deftest broadcast-stream-14
 637     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 638     (with-sc-test-stream (synonym)
 639       (eql (sb-kernel:charpos (make-broadcast-stream synonym))
 640            (sb-kernel:charpos synonym)))
 641   T)
 642
 643 (deftest broadcast-stream-16
 644     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 645     (with-sc-test-stream (synonym)
 646       (eql (file-position (make-broadcast-stream synonym))
 647            (file-position synonym)))
 648   T)
 649
 650 ;; SYNONYM-STREAM tests repeated for TWO-WAY-STREAM, where applicable
 651
 652 (deftest two-way-stream-1
 653     ;; READ-CHAR
 654     (with-dc-test-stream (synonym)
 655       (read-char (make-two-way-stream synonym synonym)))
 656   #\T)
 657
 658 (deftest two-way-stream-2
 659     ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
 660     (with-dc-test-stream (synonym)
 661       (let ((s (make-two-way-stream synonym synonym)))
 662         (unread-char (read-char s) s)
 663         (read-char s)))
 664   #\T)
 665
 666 (deftest two-way-stream-3
 667     ;; READ-BYTE
 668     (with-dc-test-stream (synonym)
 669       (read-byte (make-two-way-stream synonym synonym)))
 670   #.(char-code #\T))
 671
 672 (deftest two-way-stream-4
 673     ;; WRITE-CHAR
 674     (with-sc-test-stream (synonym)
 675       (let ((s (make-two-way-stream synonym synonym)))
 676         (write-char #\A s)
 677         (force-output s))
 678       (file-position synonym 0)
 679       (read-char synonym))
 680   #\A)
 681
 682 (deftest two-way-stream-5
 683     ;; WRITE-BYTE
 684     (with-sc-test-stream (synonym)
 685       (let ((s (make-two-way-stream synonym synonym)))
 686         (write-byte 65 s)
 687         (force-output s))
 688       (file-position synonym 0)
 689       (read-char synonym))
 690   #\A)
 691
 692 (deftest two-way-stream-6
 693     ;; WRITE-STRING
 694     (with-sc-test-stream (synonym)
 695       (let ((s (make-two-way-stream synonym synonym)))
 696         (write-string "ab" s)
 697         (force-output s))
 698       (file-position synonym 0)
 699       (and (char= (read-char synonym) #\a)
 700            (char= (read-char synonym) #\b)))
 701   T)
 702
 703 (deftest two-way-stream-7
 704     ;; LISTEN (via STREAM-MISC-DISPATCH)
 705     (with-sc-test-stream (synonym)
 706       (let ((s (make-two-way-stream synonym synonym)))
 707         (and (listen s) t)))
 708   T)
 709
 710 (deftest two-way-stream-8
 711     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
 712     (with-sc-test-stream (synonym)
 713       (let ((s (make-two-way-stream synonym synonym)))
 714         (clear-input s)))
 715   NIL)
 716
 717 (deftest two-way-stream-9
 718     ;; FORCE-OUTPUT (via STREAM-MISC-DISPATCH)
 719     (with-sc-test-stream (synonym)
 720       ;; could test more here
 721       (force-output (make-two-way-stream synonym synonym)))
 722   NIL)
 723
 724 (deftest two-way-stream-10
 725     ;; FINISH-OUTPUT (via STREAM-MISC-DISPATCH)
 726     (with-sc-test-stream (synonym)
 727       ;; could test more here
 728       (finish-output (make-two-way-stream synonym synonym)))
 729   NIL)
 730
 731 (deftest two-way-stream-11
 732     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 733     (with-sc-test-stream (synonym)
 734       (eql (stream-element-type (make-two-way-stream synonym synonym))
 735            (stream-element-type synonym)))
 736   T)
 737
 738 (deftest two-way-stream-12
 739     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 740     (with-sc-test-stream (synonym)
 741       (eql (interactive-stream-p (make-two-way-stream synonym synonym))
 742            (interactive-stream-p synonym)))
 743   T)
 744
 745 (deftest two-way-stream-13
 746     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 747     (with-sc-test-stream (synonym)
 748       (eql (sb-kernel:line-length (make-two-way-stream synonym synonym))
 749            (sb-kernel:line-length synonym)))
 750   T)
 751
 752 (deftest two-way-stream-14
 753     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 754     (with-sc-test-stream (synonym)
 755       (eql (sb-kernel:charpos (make-two-way-stream synonym synonym))
 756            (sb-kernel:charpos synonym)))
 757   T)
 758
 759 (deftest two-way-stream-16
 760     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 761     (with-sc-test-stream (synonym)
 762       (eql (file-position (make-two-way-stream synonym synonym))
 763            (file-position synonym)))
 764   T)
 765
 766 ;; SYNONYM-STREAM tests repeated for ECHO-STREAM, where applicable
 767
 768 (deftest echo-stream-1
 769     ;; READ-CHAR
 770     (with-dc-test-stream (*synonym*)
 771       (read-char (make-echo-stream *synonym* *synonym*)))
 772   #\T)
 773
 774 (deftest echo-stream-2
 775     ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
 776     (with-dc-test-stream (*synonym*)
 777       (let ((s (make-echo-stream *synonym* *synonym*)))
 778         (unread-char (read-char s) s)
 779         (read-char s)))
 780   #\T)
 781
 782 (deftest echo-stream-3
 783     ;; READ-BYTE
 784     (with-dc-test-stream (*synonym*)
 785       (read-byte (make-echo-stream *synonym* *synonym*)))
 786   #.(char-code #\T))
 787
 788 (deftest echo-stream-7
 789     ;; LISTEN (via STREAM-MISC-DISPATCH)
 790     (with-sc-test-stream (*synonym*)
 791       (let ((s (make-echo-stream *synonym* *synonym*)))
 792         (and (listen s) t)))
 793   T)
 794
 795 (deftest echo-stream-8
 796     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
 797     (with-sc-test-stream (*synonym*)
 798       (let ((s (make-echo-stream *synonym* *synonym*)))
 799         (clear-input s)))
 800   NIL)
 801
 802 (deftest echo-stream-11
 803     ;; STREAM-ELEMENT-TYPE (via STREAM-MISC-DISPATCH)
 804     (with-sc-test-stream (*synonym*)
 805       (eql (stream-element-type (make-echo-stream *synonym* *synonym*))
 806            (stream-element-type *synonym*)))
 807   T)
 808
 809 (deftest echo-stream-12
 810     ;; INTERACTIVE-STREAM-P (via STREAM-MISC-DISPATCH)
 811     (with-sc-test-stream (*synonym*)
 812       (eql (interactive-stream-p (make-echo-stream *synonym* *synonym*))
 813            (interactive-stream-p *synonym*)))
 814   T)
 815
 816 (deftest echo-stream-13
 817     ;; LINE-LENGTH (via STREAM-MISC-DISPATCH)
 818     (with-sc-test-stream (*synonym*)
 819       (eql (sb-kernel:line-length (make-echo-stream *synonym* *synonym*))
 820            (sb-kernel:line-length *synonym*)))
 821   T)
 822
 823 (deftest echo-stream-14
 824     ;; CHARPOS (via STREAM-MISC-DISPATCH)
 825     (with-sc-test-stream (*synonym*)
 826       (eql (sb-kernel:charpos (make-echo-stream *synonym* *synonym*))
 827            (sb-kernel:charpos *synonym*)))
 828   T)
 829
 830 (deftest echo-stream-16
 831     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
 832     (with-sc-test-stream (*synonym*)
 833       (eql (file-position (make-echo-stream *synonym* *synonym*))
 834            (file-position *synonym*)))
 835   T)
 836
 837 ;; SYNONYM-STREAM tests repeated for CONCATENATED-STREAM, where applicable
 838
 839 (deftest concatenated-stream-1
 840     ;; READ-CHAR
 841     (with-dc-test-stream (*synonym*)
 842       (read-char (make-concatenated-stream *synonym*)))
 843   #\T)
 844
 845 (deftest concatenated-stream-2
 846     ;; UNREAD-CHAR (via STREAM-MISC-DISPATCH)
 847     (with-dc-test-stream (*synonym*)
 848       (let ((s (make-concatenated-stream *synonym*)))
 849         (unread-char (read-char s) s)
 850         (read-char s)))
 851   #\T)
 852
 853 (deftest concatenated-stream-3
 854     ;; READ-BYTE
 855     (with-dc-test-stream (*synonym*)
 856       (read-byte (make-concatenated-stream *synonym*)))
 857   #.(char-code #\T))
 858
 859 (deftest concatenated-stream-7
 860     ;; LISTEN (via STREAM-MISC-DISPATCH)
 861     (with-sc-test-stream (*synonym*)
 862       (let ((s (make-concatenated-stream *synonym*)))
 863         (and (listen s) t)))
 864   T)
 865
 866 (deftest concatenated-stream-8
 867     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
 868     (with-sc-test-stream (*synonym*)
 869       (let ((s (make-concatenated-stream *synonym*)))
 870         (clear-input 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)
 917
 918 ;; don't break fd-stream external-format support:
 919
 920 (deftest external-format-1
 921     (progn
 922       (with-open-file (s *test-file*
 923                        :direction :output
 924                        :if-exists :supersede
 925                        :element-type '(unsigned-byte 8))
 926         (write-byte 195 s)
 927         (write-byte 132 s))
 928       (with-open-file (s *test-file*
 929                        :direction :input
 930                        :external-format :utf-8)
 931         (char-code (read-char s))))
 932   196)
 933
 934 ;; launchpad bug #491087
 935
 936 (deftest lp491087
 937     (labels ((read-big-int (stream)
 938                (let ((b (make-array 1 :element-type '(signed-byte 32)
 939                                     :initial-element 0)))
 940                  (declare (dynamic-extent b))
 941                  (sb-simple-streams::read-vector b stream
 942                                                  :endian-swap :network-order)
 943                  (aref b 0))))
 944       (with-open-file (stream "lp491087.txt" :class 'file-simple-stream)
 945         (let* ((start (file-position stream))
 946                (integer (read-big-int stream))
 947                (end (file-position stream)))
 948           (and (= start 0)
 949                (= integer #x30313233)
 950                (= end 4)))))
 951   T)