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 non-existent-class
  64   (handler-case
  65       (with-test-file (s *test-file* :class 'non-existent-stream)
  66         nil)
  67     ;; find-class will raise a simple-error
  68     (simple-error (c) (search "There is no class" (simple-condition-format-control c))))
  69   0)
  70
  71 (deftest non-stream-class
  72   (handler-case
  73       (with-test-file (s *test-file* :class 'standard-class)
  74         nil)
  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))))
  77   0)
  78
  79 (deftest create-file-1
  80     ;; Create a file-simple-stream, write data.
  81     (prog1
  82         (with-open-stream (s (make-instance 'file-simple-stream
  83                                             :filename *test-file*
  84                                             :direction :output
  85                                             :if-exists :overwrite
  86                                             :if-does-not-exist :create))
  87           (string= (write-string *dumb-string* s) *dumb-string*))
  88       (delete-file *test-file*))
  89   t)
  90
  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*))
  97   t)
  98
  99 (deftest create-read-file-1
 100   ;; Via file-simple-stream objects, write and then re-read data.
 101   (let ((result t))
 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)
 107                                         *dumb-string*))))
 108
 109     (with-test-file (s *test-file* :class 'file-simple-stream
 110                        :direction :input :if-does-not-exist :error)
 111       ;; Check first line
 112       (multiple-value-bind (string missing-newline-p)
 113           (read-line s)
 114         (setf result (and result (string= string *dumb-string*)
 115                           (not missing-newline-p))))
 116       ;; Check second line
 117       (multiple-value-bind (string missing-newline-p)
 118           (read-line s)
 119         (setf result (and result (string= string *dumb-string*)
 120                           missing-newline-p))))
 121     result)
 122   t)
 123
 124 (deftest create-read-mapped-file-1
 125   ;; Read data via a mapped-file-simple-stream object.
 126   (let ((result t))
 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*))))
 131     result)
 132   t)
 133
 134 (deftest write-read-inet
 135   (handler-case
 136       (with-open-stream (s (make-instance 'socket-simple-stream
 137                                           :remote-host #(127 0 0 1)
 138                                           :remote-port 7
 139                                           :direction :io))
 140         (string= (prog1 (write-line "Got it!" s) (finish-output s))
 141                  (read-line 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))
 147   t)
 148
 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))))
 163   t)
 164
 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))))
 183   t)
 184
 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))))
 203   t)
 204
 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)
 208   (handler-case
 209    (let* ((stream (make-instance 'socket-simple-stream
 210                                  :remote-host #(127 0 0 1)
 211                                  :remote-port 7
 212                                  :direction :io))
 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))
 217                 (read-line 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))
 223   t)
 224
 225
 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*)
 230       (file-position s))
 231   0)
 232
 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*)
 237       (read-byte s)
 238       (file-position s))
 239   1)
 240
 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)
 246       (write-byte 50 s)
 247       (file-position s))
 248   1)
 249
 250 (deftest file-position-4
 251     ;; Test reading of file-position in the presence of unsaved data and
 252     ;; filled buffer
 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
 258       (file-position s))
 259   2)
 260
 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)))
 267   T)
 268
 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)
 274       (write-char #\x s)
 275       (file-position s :start)
 276       (read-char s))
 277   #\x)
 278
 279 (deftest write-read-unflushed-sc-2
 280     ;; Write something into a single-channel stream, try to read back too much
 281     (handler-case
 282         (with-test-file (s *test-file* :class 'file-simple-stream
 283                            :direction :io :if-does-not-exist :create
 284                            :if-exists :supersede)
 285             (write-char #\x s)
 286             (file-position s :start)
 287             (read-char s)
 288             (read-char s)
 289             nil)
 290       (end-of-file () t))
 291   t)
 292
 293 (deftest write-read-unflushed-sc-3
 294     ;; Test writing in a buffer filled with previous file contents
 295     (let ((result t))
 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)))
 302           (write-char #\x s)
 303           (file-position s pos)
 304           (setq result (and result (char= (read-char s) #\x)))))
 305       result)
 306   t)
 307
 308 (deftest write-read-unflushed-sc-4
 309     ;; Test flushing of buffers
 310     (progn
 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.
 317         (write-char #\X s)
 318         (file-position s :end)          ; Extend file.
 319         (write-char #\X s))
 320       (with-test-file (s *test-file* :class 'file-simple-stream
 321                          :direction :input :if-does-not-exist :error)
 322         (read-line s)))
 323   "XooX"
 324   T)
 325
 326 (deftest write-read-append-sc-1
 327     ;; Test writing in the middle of a stream opened in append mode
 328     (progn
 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.
 334         (write-char #\X s)
 335         (file-position s :end)          ; Extend file.
 336         (write-char #\X s))
 337       (with-test-file (s *test-file* :class 'file-simple-stream
 338                          :direction :input :if-does-not-exist :error)
 339         (read-line s)))
 340   "XooX"
 341   T)
 342
 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)
 350                               :initial-element 0))
 351           (result-svector (make-array '(10) :element-type '(signed-byte 8)
 352                               :initial-element 0))
 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)))
 370   T)
 371
 372 (defparameter *multi-line-string*
 373   "This file was created by simple-stream-tests.lisp.
 374 Nothing to see here, move along.")
 375
 376 (defmacro with-dc-test-stream ((s &key initial-content) &body body)
 377   `(with-test-file
 378        (.ansi-stream.
 379         *test-file*
 380         :direction :io
 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.))))
 386        ,@body)))
 387
 388 (defmacro with-sc-test-stream ((s &key initial-content) &body body)
 389   `(with-test-file
 390        (,s
 391         *test-file*
 392         :class 'file-simple-stream
 393         :direction :io
 394         :if-exists :overwrite
 395         :initial-content ,(or initial-content '*multi-line-string*))
 396      ,@body))
 397
 398 (deftest listen-dc-1
 399     ;; LISTEN with filled buffer
 400     (with-dc-test-stream (s) (read-char s) (listen s))
 401   T)
 402
 403 (deftest listen-dc-2
 404     ;; LISTEN with empty buffer
 405     (with-dc-test-stream (s) (listen s))
 406   T)
 407
 408 (deftest listen-dc-3
 409     ;; LISTEN at EOF
 410     (with-dc-test-stream (s)
 411       (read-line s)
 412       (read-line s)
 413       (listen s))
 414   NIL)
 415
 416 ;;; the following tests are for problems fixed in SBCL 0.8.6.2:
 417
 418 (deftest charpos-1
 419     ;; check for bug involving the -1 vs. 0 oddity in std-dc-newline-in-handler
 420     ;;
 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.)
 424     ;;
 425     ;; But CHARPOS must not be -1, so much is sure, hence this test is right
 426     ;; in any case.
 427     (with-dc-test-stream (s)
 428       (read-line s)
 429       (sb-simple-streams:charpos s))
 430   0)
 431
 432 (deftest charpos-2
 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)
 435     ;;
 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)
 440       (read-char s)
 441       (and (eql (sb-kernel:charpos s) 0)
 442            (eql (sb-simple-streams:charpos s) 0)))
 443   T)
 444
 445 (deftest reader-1
 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)))
 450   T)
 451
 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)))
 457   T)
 458
 459 (defvar *synonym*)
 460
 461 ;; the biggest change in 0.8.6.2:
 462 ;; support composite streams writing to simple streams
 463
 464 ;; first, SYNONYM-STREAM:
 465
 466 (deftest synonym-stream-1
 467     ;; READ-CHAR
 468     (with-dc-test-stream (*synonym*)
 469       (read-char (make-synonym-stream '*synonym*)))
 470   #\T)
 471
 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)
 477         (read-char s)))
 478   #\T)
 479
 480 (deftest synonym-stream-3
 481     ;; READ-BYTE
 482     (with-dc-test-stream (*synonym*)
 483       (read-byte (make-synonym-stream '*synonym*)))
 484   #.(char-code #\T))
 485
 486 (deftest synonym-stream-4
 487     ;; WRITE-CHAR
 488     (with-sc-test-stream (*synonym*)
 489       (let ((s (make-synonym-stream '*synonym*)))
 490         (write-char #\A s)
 491         (file-position s 0)
 492         (read-char s)))
 493   #\A)
 494
 495 (deftest synonym-stream-5
 496     ;; WRITE-BYTE
 497     (with-sc-test-stream (*synonym*)
 498       (let ((s (make-synonym-stream '*synonym*)))
 499         (write-byte 65 s)
 500         (file-position s 0)
 501         (read-char s)))
 502   #\A)
 503
 504 (deftest synonym-stream-6
 505     ;; WRITE-STRING
 506     (with-sc-test-stream (*synonym*)
 507       (let ((s (make-synonym-stream '*synonym*)))
 508         (write-string "ab" s)
 509         (file-position s 0)
 510         (and (char= (read-char s) #\a)
 511              (char= (read-char s) #\b))))
 512   T)
 513
 514 (deftest synonym-stream-7
 515     ;; LISTEN (via STREAM-MISC-DISPATCH)
 516     (with-sc-test-stream (*synonym*)
 517       (let ((s (make-synonym-stream '*synonym*)))
 518         (and (listen s) t)))
 519   T)
 520
 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*)))
 525         (clear-input s)))
 526   NIL)
 527
 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*)))
 533   NIL)
 534
 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*)))
 540   NIL)
 541
 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*)))
 547   T)
 548
 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*)))
 554   T)
 555
 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*)))
 561   T)
 562
 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*)))
 568   T)
 569
 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*)))
 575   T)
 576
 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*)))
 582   T)
 583
 584 ;; SYNONYM-STREAM tests repeated for BROADCAST-STREAM, where applicable
 585
 586 (deftest broadcast-stream-4
 587     ;; WRITE-CHAR
 588     (with-sc-test-stream (synonym)
 589       (let ((s (make-broadcast-stream synonym)))
 590         (write-char #\A s)
 591         (force-output s))
 592       (file-position synonym 0)
 593       (read-char synonym))
 594   #\A)
 595
 596 (deftest broadcast-stream-5
 597     ;; WRITE-BYTE
 598     (with-sc-test-stream (synonym)
 599       (let ((s (make-broadcast-stream synonym)))
 600         (write-byte 65 s)
 601         (force-output s))
 602       (file-position synonym 0)
 603       (read-char synonym))
 604   #\A)
 605
 606 (deftest broadcast-stream-6
 607     ;; WRITE-STRING
 608     (with-sc-test-stream (synonym)
 609       (let ((s (make-broadcast-stream synonym)))
 610         (write-string "ab" s)
 611         (force-output s))
 612       (file-position synonym 0)
 613       (and (char= (read-char synonym) #\a)
 614            (char= (read-char synonym) #\b)))
 615   T)
 616
 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)))
 622   NIL)
 623
 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)))
 629   NIL)
 630
 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)))
 636   T)
 637
 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)))
 643   T)
 644
 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)))
 650   T)
 651
 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)))
 657   T)
 658
 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)))
 664   T)
 665
 666 ;; SYNONYM-STREAM tests repeated for TWO-WAY-STREAM, where applicable
 667
 668 (deftest two-way-stream-1
 669     ;; READ-CHAR
 670     (with-dc-test-stream (synonym)
 671       (read-char (make-two-way-stream synonym synonym)))
 672   #\T)
 673
 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)
 679         (read-char s)))
 680   #\T)
 681
 682 (deftest two-way-stream-3
 683     ;; READ-BYTE
 684     (with-dc-test-stream (synonym)
 685       (read-byte (make-two-way-stream synonym synonym)))
 686   #.(char-code #\T))
 687
 688 (deftest two-way-stream-4
 689     ;; WRITE-CHAR
 690     (with-sc-test-stream (synonym)
 691       (let ((s (make-two-way-stream synonym synonym)))
 692         (write-char #\A s)
 693         (force-output s))
 694       (file-position synonym 0)
 695       (read-char synonym))
 696   #\A)
 697
 698 (deftest two-way-stream-5
 699     ;; WRITE-BYTE
 700     (with-sc-test-stream (synonym)
 701       (let ((s (make-two-way-stream synonym synonym)))
 702         (write-byte 65 s)
 703         (force-output s))
 704       (file-position synonym 0)
 705       (read-char synonym))
 706   #\A)
 707
 708 (deftest two-way-stream-6
 709     ;; WRITE-STRING
 710     (with-sc-test-stream (synonym)
 711       (let ((s (make-two-way-stream synonym synonym)))
 712         (write-string "ab" s)
 713         (force-output s))
 714       (file-position synonym 0)
 715       (and (char= (read-char synonym) #\a)
 716            (char= (read-char synonym) #\b)))
 717   T)
 718
 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)))
 723         (and (listen s) t)))
 724   T)
 725
 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)))
 730         (clear-input s)))
 731   NIL)
 732
 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)))
 738   NIL)
 739
 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)))
 745   NIL)
 746
 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)))
 752   T)
 753
 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)))
 759   T)
 760
 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)))
 766   T)
 767
 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)))
 773   T)
 774
 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)))
 780   T)
 781
 782 ;; SYNONYM-STREAM tests repeated for ECHO-STREAM, where applicable
 783
 784 (deftest echo-stream-1
 785     ;; READ-CHAR
 786     (with-dc-test-stream (*synonym*)
 787       (read-char (make-echo-stream *synonym* *synonym*)))
 788   #\T)
 789
 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)
 795         (read-char s)))
 796   #\T)
 797
 798 (deftest echo-stream-3
 799     ;; READ-BYTE
 800     (with-dc-test-stream (*synonym*)
 801       (read-byte (make-echo-stream *synonym* *synonym*)))
 802   #.(char-code #\T))
 803
 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*)))
 808         (and (listen s) t)))
 809   T)
 810
 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*)))
 815         (clear-input s)))
 816   NIL)
 817
 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*)))
 823   T)
 824
 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*)))
 830   T)
 831
 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*)))
 837   T)
 838
 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*)))
 844   T)
 845
 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*)))
 851   T)
 852
 853 ;; SYNONYM-STREAM tests repeated for CONCATENATED-STREAM, where applicable
 854
 855 (deftest concatenated-stream-1
 856     ;; READ-CHAR
 857     (with-dc-test-stream (*synonym*)
 858       (read-char (make-concatenated-stream *synonym*)))
 859   #\T)
 860
 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)
 866         (read-char s)))
 867   #\T)
 868
 869 (deftest concatenated-stream-3
 870     ;; READ-BYTE
 871     (with-dc-test-stream (*synonym*)
 872       (read-byte (make-concatenated-stream *synonym*)))
 873   #.(char-code #\T))
 874
 875 (deftest concatenated-stream-7
 876     ;; LISTEN (via STREAM-MISC-DISPATCH)
 877     (with-sc-test-stream (*synonym*)
 878       (let ((s (make-concatenated-stream *synonym*)))
 879         (and (listen s) t)))
 880   T)
 881
 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*)))
 886         (clear-input s)))
 887   NIL)
 888
 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*)))
 894   T)
 895
 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*)))
 901   T)
 902
 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*)))
 908   T)
 909
 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*)))
 915   T)
 916
 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*)))
 922   T)
 923
 924 ;; uncovered by synonym-stream-15
 925
 926 (deftest file-simple-stream-1
 927     (values (subtypep 'file-simple-stream 'file-stream))
 928   T)
 929
 930 (deftest string-simple-stream-1
 931     (values (subtypep 'string-simple-stream 'string-stream))
 932   T)
 933
 934 ;; don't break fd-stream external-format support:
 935
 936 (deftest external-format-1
 937     (progn
 938       (with-open-file (s *test-file*
 939                        :direction :output
 940                        :if-exists :supersede
 941                        :element-type '(unsigned-byte 8))
 942         (write-byte 195 s)
 943         (write-byte 132 s))
 944       (with-open-file (s *test-file*
 945                        :direction :input
 946                        :external-format :utf-8)
 947         (char-code (read-char s))))
 948   196)
 949
 950 ;; launchpad bug #491087
 951
 952 (deftest lp491087
 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)
 959                  (aref b 0))))
 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)))
 966           (and (= start 0)
 967                (= integer #x30313233)
 968                (= end 4)))))
 969   T)