tests/stream.pure.lisp

   1 ;;;; tests related to Lisp streams
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; While most of SBCL is derived from the CMU CL system, the test
   7 ;;;; files (like this one) were written from scratch after the fork
   8 ;;;; from CMU CL.
   9 ;;;;
  10 ;;;; This software is in the public domain and is provided with
  11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  12 ;;;; more information.
  13
  14 ;;; Until sbcl-0.6.11.31, we didn't have an N-BIN method for
  15 ;;; CONCATENATED-STREAM, so stuff like this would fail.
  16 (with-test (:name (concatenated-stream read-sequence 1))
  17   (let ((stream (make-concatenated-stream (make-string-input-stream "Demo")))
  18         (buffer (make-string 4)))
  19     (read-sequence buffer stream)))
  20
  21 ;;; test for the new N-BIN method doing what it's supposed to
  22 (with-test (:name (concatenated-stream read-sequence 2))
  23   (let* ((substrings (list "This " "is " "a " ""
  24                            "test of concatenated streams behaving "
  25                            "as ordinary streams do under READ-SEQUENCE. "
  26                            (make-string 140041 :initial-element #\%)
  27                            "For any size of read.."
  28                            (make-string 4123 :initial-element #\.)
  29                            "they should give the same results."
  30                            (make-string (expt 2 14) :initial-element #\*)
  31                            "There should be no differences."))
  32          (substreams (mapcar #'make-string-input-stream substrings))
  33          (concatenated-stream (apply #'make-concatenated-stream substreams))
  34          (concatenated-string (apply #'concatenate 'string substrings))
  35          (stream (make-string-input-stream concatenated-string))
  36          (max-n-to-read 24)
  37          (buffer-1 (make-string max-n-to-read))
  38          (buffer-2 (make-string max-n-to-read)))
  39     (loop
  40       (let* ((n-to-read (random max-n-to-read))
  41              (n-actually-read-1 (read-sequence buffer-1
  42                                                concatenated-stream
  43                                                :end n-to-read))
  44              (n-actually-read-2 (read-sequence buffer-2
  45                                                stream
  46                                                :end n-to-read)))
  47         ;;     (format t "buffer-1=~S~%buffer-2=~S~%" buffer-1 buffer-2)
  48         (assert (= n-actually-read-1 n-actually-read-2))
  49         (assert (string= buffer-1 buffer-2
  50                          :end1 n-actually-read-1
  51                          :end2 n-actually-read-2))
  52         (unless (= n-actually-read-1 n-to-read)
  53           (assert (< n-actually-read-1 n-to-read))
  54           (return))))))
  55
  56 ;;; Entomotomy PEEK-CHAR-WRONGLY-ECHOS-TO-ECHO-STREAM bug, fixed by
  57 ;;; MRD patch sbcl-devel 2002-11-02 merged ca. sbcl-0.7.9.32...
  58 (with-test (:name (peek-char :wrongly-echos-to echo-stream))
  59   (assert (string=
  60            (with-output-to-string (out)
  61              (peek-char #\]
  62                         (make-echo-stream
  63                          (make-string-input-stream "ab cd e df s]") out)))
  64            ;; (Before the fix, the result had a trailing #\] in it.)
  65            "ab cd e df s")))
  66
  67 ;;; ...and a missing wrinkle in the original patch, dealing with
  68 ;;; PEEK-CHAR/UNREAD-CHAR on ECHO-STREAMs, fixed by MRD patch
  69 ;;; sbcl-devel 2002-11-18, merged ca. sbcl-0.7.9.66
  70 (with-test (:name (unread-char peek-char echo-stream))
  71   (assert (string=
  72            (let* ((in-stream (make-string-input-stream "abc"))
  73                   (out-stream (make-string-output-stream))
  74                   (echo-stream (make-echo-stream in-stream out-stream)))
  75              (unread-char (read-char echo-stream) echo-stream)
  76              (peek-char #\a echo-stream)
  77              (get-output-stream-string out-stream))
  78            ;; (Before the fix, the LET* expression just signalled an error.)
  79            "a")))
  80
  81 ;;; ... and yet, a little over 6 years on, echo-streams were still
  82 ;;; broken when a read-char followed the unread/peek sequence.  Do
  83 ;;; people not actually use echo-streams?  RMK, 2009-04-02.
  84 (with-test (:name (unread-char peek-char read-char echo-stream))
  85   (assert (string=
  86            (let* ((in-stream (make-string-input-stream "abc"))
  87                   (out-stream (make-string-output-stream))
  88                   (echo-stream (make-echo-stream in-stream out-stream)))
  89              (unread-char (read-char echo-stream) echo-stream)
  90              (peek-char nil echo-stream)
  91              (read-char echo-stream)
  92              (get-output-stream-string out-stream))
  93            ;; before ca. 1.0.27.18, the LET* returned "aa"
  94            "a")))
  95
  96 ;;; Reported by Fredrik Sandstrom to sbcl-devel 2005-05-17 ("Bug in
  97 ;;; peek-char"):
  98 ;;; Description: In (peek-char nil s nil foo), if foo happens to be
  99 ;;; the same character that peek-char returns, the character is
 100 ;;; removed from the input stream, as if read by read-char.
 101 (with-test (:name (peek-char :eof-value))
 102   (assert (equal (with-input-from-string (s "123")
 103                    (list (peek-char nil s nil #\1) (read-char s) (read-char s)))
 104                  '(#\1 #\1 #\2))))
 105
 106 ;;; ... and verify that the fix does not break echo streams
 107 (with-test (:name (peek-char :eof-value echo-stream))
 108   (assert (string= (let ((out (make-string-output-stream)))
 109                      (with-open-stream (s (make-echo-stream
 110                                            (make-string-input-stream "123")
 111                                            out))
 112                        (format s "=>~{~A~}"
 113                                (list (peek-char nil s nil #\1)
 114                                      (read-char s)
 115                                      (read-char s)))
 116                        (get-output-stream-string out)))
 117                    "12=>112")))
 118
 119 ;;; 0.7.12 doesn't advance current stream in concatenated streams
 120 ;;; correctly when searching a stream for a char to read.
 121 (with-test (:name (concatenated-stream peek-char))
 122   (with-input-from-string (p "")
 123     (with-input-from-string (q "foo")
 124       (let* ((r (make-concatenated-stream p q)))
 125         (peek-char nil r)))))
 126
 127 ;;; 0.7.14 and previous SBCLs don't have a working INTERACTIVE-STREAM-P
 128 ;;; because it called UNIX-ISATTY, which wasn't defined.
 129 (with-test (:name (interactive-stream-p))
 130   (with-input-from-string (s "a non-interactive stream")
 131     (assert (not (interactive-stream-p s)))))
 132
 133 ;;; KLUDGE: Unfortunately it's hard to find a reliably interactive
 134 ;;; stream to test, since it's reasonable for these tests to be run
 135 ;;; from a script, conceivably even as something like a cron job.
 136 ;;; Ideas?
 137 #+nil (assert (eq (interactive-stream-p *terminal-io*) t))
 138
 139 ;;; FILE-POSITION should not accept NIL
 140 (with-test (:name :file-position-smoke-test)
 141   (let ((s (make-broadcast-stream)))
 142     (assert-error (file-position s (opaque-identity nil)) type-error)))
 143
 144 ;;; MAKE-STRING-INPUT-STREAM
 145 ;;;
 146 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
 147 ;;;   FILE-POSITION beyond the end of string, signalling END-OF-FILE only
 148 ;;;   on read.
 149 (with-test (:name (make-string-input-stream file-position))
 150   (let* ((string (copy-seq "abc"))
 151          (stream (make-string-input-stream string)))
 152     (assert (char= (read-char stream) #\a))
 153     (assert (= 1 (file-position stream)))
 154     (assert (file-position stream :start))
 155     (assert (= 0 (file-position stream)))
 156     (assert (file-position stream :end))
 157     (assert (= (length string) (file-position stream)))
 158     (assert (file-position stream (1- (file-position stream))))
 159     (assert (char= (read-char stream) #\c))
 160     (assert (file-position stream (1- (file-position stream))))
 161     (assert (char= (read-char stream) #\c))
 162     (assert (file-position stream :end))
 163     (let ((eof (cons nil nil)))
 164       (assert (eq (read-char stream nil eof) eof)))
 165     (assert (file-position stream 10))
 166     ;; Avoid type mismatch warning when compiling of this file.
 167     (let ((fun (checked-compile `(lambda (stream)
 168                                    (file-position stream -1))
 169                                 :allow-warnings t)))
 170       (assert-error (funcall fun stream) type-error))
 171     (assert-error (read-char stream) end-of-file)))
 172
 173 ;;; MAKE-STRING-OUTPUT-STREAM
 174 ;;;
 175 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
 176 ;;;   FILE-POSITION to an arbitrary index.
 177 ;;;
 178 ;;; * END will always refer to the farthest position of stream so-far
 179 ;;;   seen, and setting FILE-POSITION beyond the current END will extend
 180 ;;;   the string/stream with uninitialized elements.
 181 ;;;
 182 ;;; * Rewinding the stream works with overwriting semantics.
 183 ;;;
 184 (with-test (:name (make-string-output-stream file-position))
 185   (let ((stream (make-string-output-stream)))
 186     (princ "abcd" stream)
 187     (assert (= 4 (file-position stream)))
 188     (assert (file-position stream :start))
 189     (assert (= 0 (file-position stream)))
 190     (princ "0" stream)
 191     (assert (= 1 (file-position stream)))
 192     (file-position stream 2)
 193     (assert (= 2 (file-position stream)))
 194     (princ "2" stream)
 195     (assert (file-position stream :end))
 196     (assert (= 4 (file-position stream)))
 197     (assert (file-position stream 6))
 198     (assert (file-position stream 4))
 199     (assert (file-position stream :end))
 200     (assert (= 6 (file-position stream)))
 201     (assert (file-position stream 4))
 202     ;; Avoid type mismatch warning when compiling of this file.
 203     (let ((fun (checked-compile `(lambda (stream)
 204                                    (file-position stream -1))
 205                                 :allow-warnings t)))
 206       (assert-error (funcall fun stream) type-error))
 207     (princ "!!" stream)
 208     (assert (equal "0b2d!!" (get-output-stream-string stream)))))
 209
 210 (with-test (:name (make-string-output-stream file-position :lp-1839040))
 211   (let ((stream (make-string-output-stream)))
 212     (dotimes (i 64) (write-char #\a stream))
 213     (file-position stream 40)
 214     (write-char #\x stream)
 215     (file-position stream 39)
 216     (write-char #\y stream)
 217     (file-position stream 41)
 218     (write-char #\z stream)
 219     (let ((string (get-output-stream-string stream)))
 220       (assert (equal "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaayxzaaaaaaaaaaaaaaaaaaaaaa" string))))
 221   (let ((stream (make-string-output-stream)))
 222     (dotimes (i 64) (write-char #\a stream))
 223     (dotimes (i 64) (write-char #\b stream))
 224     (file-position stream 3)
 225     (file-position stream 4)
 226     (write-char #\x stream)
 227     (let ((string (get-output-stream-string stream))
 228           (expected (concatenate
 229                      'string
 230                      (loop for i from 0 below 64 collect (if (= i 4) #\x #\a))
 231                      (loop for i from 0 below 64 collect #\b))))
 232       (assert (equal expected string)))))
 233
 234 ;;; WITH-OUTPUT-TO-STRING (when provided with a string argument)
 235 ;;;
 236 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
 237 ;;; FILE-POSITION to an arbitrary index. If the new position is beyond
 238 ;;; the end of string and the string is adjustable the string will be
 239 ;;; implicitly extended, otherwise an error will be signalled. The
 240 ;;; latter case is provided for in the code, but not currently
 241 ;;; excercised since SBCL fill-pointer arrays are always (currently)
 242 ;;; adjustable.
 243 ;;;
 244 ;;; * END will refer to the ARRAY-TOTAL-SIZE of string, not
 245 ;;; FILL-POINTER, since by definition the FILE-POSITION will always be
 246 ;;; a FILL-POINTER, so that would be of limited use.
 247 ;;;
 248 ;;; * Rewinding the stream works with overwriting semantics.
 249 ;;;
 250 #+nil (let ((str (make-array 0
 251                        :element-type 'character
 252                        :adjustable nil
 253                        :fill-pointer t)))
 254   (with-output-to-string (stream str)
 255     (princ "abcd" stream)
 256     (assert (= 4 (file-position stream)))
 257     (assert (file-position stream :start))
 258     (assert (= 0 (file-position stream)))
 259     (princ "0" stream)
 260     (assert (= 1 (file-position stream)))
 261     (file-position stream 2)
 262     (assert (= 2 (file-position stream)))
 263     (princ "2" stream)
 264     (assert (file-position stream :end))
 265     (assert (= 4 (file-position stream)))
 266     (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
 267       (assert (null val))
 268       (assert (typep cond 'error)))
 269     (multiple-value-bind (val cond) (ignore-errors (file-position stream 6))
 270       (assert (null val))
 271       (assert (typep cond 'error)))
 272     (assert (equal "0b2d" str))))
 273
 274 (with-test (:name (with-output-to-string file-position))
 275   (let ((str (make-array 0
 276                          :element-type 'character
 277                          :adjustable nil
 278                          :fill-pointer t)))
 279     (with-output-to-string (stream str)
 280       (princ "abcd" stream)
 281       (assert (= 4 (file-position stream)))
 282       (assert (file-position stream :start))
 283       (assert (= 0 (file-position stream)))
 284       (princ "0" stream)
 285       (assert (= 1 (file-position stream)))
 286       (file-position stream 2)
 287       (assert (= 2 (file-position stream)))
 288       (princ "2" stream)
 289       (assert (file-position stream :end))
 290       (assert (= 4 (file-position stream)))
 291       (assert (file-position stream 6))
 292       (assert (file-position stream 4))
 293       (assert (file-position stream :end))
 294       (assert (= 6 (file-position stream)))
 295       (assert (file-position stream 4))
 296       ;; Avoid type mismatch warning when compiling of this file.
 297       (let ((fun (checked-compile `(lambda (stream)
 298                                      (file-position stream -1))
 299                                   :allow-warnings t)))
 300         (assert-error (funcall fun stream) type-error))
 301       (princ "!!" stream)
 302       (assert (equal "0b2d!!" str)))))
 303
 304 ;;; MAKE-STRING-OUTPUT-STREAM and WITH-OUTPUT-TO-STRING take an
 305 ;;; :ELEMENT-TYPE keyword argument
 306 (with-test (:name (make-string-output-stream with-output-to-string :element-type))
 307   (macrolet ((frob (element-type-form expect &optional (expect2 expect))
 308                `(progn
 309                   (let ((s (with-output-to-string
 310                                (s nil ,@(when element-type-form
 311                                           `(:element-type ,element-type-form))))))
 312                     (assert (typep s '(simple-array ,expect (0)))))
 313                   (let ((s (get-output-stream-string
 314                             (make-string-output-stream
 315                              ,@(when element-type-form
 316                                  `(:element-type ,element-type-form))))))
 317                     (assert (typep s '(simple-array ,expect2 (0))))))))
 318     ;; If you pass NIL as element-type, note that there seems to be no requirement
 319     ;; to produce a stream that can *accept* only characters of that type.
 320     ;; We produce a CHARACTER-STRING-OUTPUT-STREAM if you do something so pointless.
 321     (frob nil character)
 322     (frob 'character character)
 323     (frob 'base-char base-char)
 324     ;; I literally do not care why these results differ.
 325     (frob 'nil base-char character)))
 326
 327 (with-test (:name (make-string-output-stream :element-type :bogosity))
 328   (assert-error (make-string-output-stream :element-type 'real)))
 329
 330 (with-test (:name (read-byte :element-type :eof-value))
 331   (with-open-file (s #-win32 "/dev/null" #+win32 "nul" :element-type '(signed-byte 48))
 332     (assert (eq :eof (read-byte s nil :eof)))))
 333
 334 (with-test (:name (echo-stream read-sequence 1))
 335  (let* ((is (make-string-input-stream "foo"))
 336         (os (make-string-output-stream))
 337         (s (make-echo-stream is os))
 338         (sequence (copy-seq "abcdef")))
 339    (assert (= (read-sequence sequence s) 3))
 340    (assert (string= sequence "foodef"))
 341    (assert (string= (get-output-stream-string os) "foo"))))
 342
 343 (with-test (:name (echo-stream read-sequence 2))
 344  (let* ((is (make-string-input-stream "foo"))
 345         (os (make-string-output-stream))
 346         (s (make-echo-stream is os))
 347         (sequence (copy-seq "abcdef")))
 348    (assert (char= #\f (read-char s)))
 349    (assert (= (read-sequence sequence s) 2))
 350    (assert (string= sequence "oocdef"))
 351    (assert (string= (get-output-stream-string os) "foo"))))
 352
 353 (with-test (:name (echo-stream read-sequence 3))
 354  (let* ((is (make-string-input-stream "foo"))
 355         (os (make-string-output-stream))
 356         (s (make-echo-stream is os))
 357         (sequence (copy-seq "abcdef")))
 358    (assert (char= #\f (read-char s)))
 359    (unread-char #\f s)
 360    (assert (= (read-sequence sequence s) 3))
 361    (assert (string= sequence "foodef"))
 362    (assert (string= (get-output-stream-string os) "foo"))))
 363
 364 (with-test (:name (with-standard-io-syntax open))
 365   (with-standard-io-syntax
 366     (open #-win32 "/dev/null" #+win32 "nul" )))
 367
 368 ;;; PEEK-CHAR T uses whitespace[2]
 369 (with-test (:name (peek-char :whitespace[2]))
 370   (let ((*readtable* (copy-readtable)))
 371     (assert (char= (peek-char t (make-string-input-stream " a")) #\a))
 372     (set-syntax-from-char #\Space #\a)
 373     (assert (char= (peek-char t (make-string-input-stream " a")) #\Space))))
 374
 375 (with-test (:name :whitespace[2]p-is-type-safe)
 376   (let ((fun (checked-compile `(lambda () (sb-impl::whitespace[2]p :potato *readtable*))
 377                               :allow-warnings t)))
 378     (assert-error (funcall fun) type-error)))
 379
 380 ;;; It is actually easier to run into the problem exercised by this
 381 ;;; test with sockets, due to their delays between availabilities of
 382 ;;; data.  However edgy the case may be for normal files, however,
 383 ;;; there is still a case to be found in which CL:LISTEN answers
 384 ;;; improperly.
 385 ;;;
 386 ;;; This test assumes that buffering is still done until a buffer of
 387 ;;; SB-IMPL::+BYTES-PER-BUFFER+ bytes is filled up, that the buffer may
 388 ;;; immediately be completely filled for normal files, and that the
 389 ;;; buffer-fill routine is responsible for figuring out when we've
 390 ;;; reached EOF.
 391 (with-test (:name (stream :listen-vs-select))
 392   (let ((listen-testfile-name (scratch-file-name))
 393         ;; If non-NIL, size (in bytes) of the file that will exercise
 394         ;; the LISTEN problem.
 395         (bytes-per-buffer-sometime
 396          (and (boundp 'sb-impl::+bytes-per-buffer+)
 397               (symbol-value 'sb-impl::+bytes-per-buffer+))))
 398     (when bytes-per-buffer-sometime
 399       (unwind-protect
 400            (progn
 401              (with-open-file (stream listen-testfile-name
 402                                      :direction :output :if-exists :error
 403                                      :element-type '(unsigned-byte 8))
 404                (dotimes (n bytes-per-buffer-sometime)
 405                  (write-byte 113 stream)))
 406              (with-open-file (stream listen-testfile-name
 407                                      :direction :input :element-type '(unsigned-byte 8))
 408                (dotimes (n bytes-per-buffer-sometime)
 409                  (read-byte stream))
 410                (assert (not (listen stream)))))
 411         (ignore-errors (delete-file listen-testfile-name))))))
 412
 413 (with-test (:name :bug-395)
 414   (let ((v (make-array 5 :fill-pointer 0 :element-type 'standard-char)))
 415     (format v "foo")
 416     (assert (equal (coerce "foo" 'base-string) v))))
 417
 418 ;;; Circa 1.0.27.18, echo-streams were changed somewhat, so that
 419 ;;; unread-char on an echo-stream propagated the character down to the
 420 ;;; echo-stream's input stream.  (All other implementations but CMUCL
 421 ;;; seemed to do this).  The most useful argument for this behavior
 422 ;;; involves cases where an input operation on an echo-stream finishes
 423 ;;; up by unreading a delimiter, and the user wants to proceed to use the
 424 ;;; underlying stream, e.g.,
 425 (with-test (:name (echo-stream unread-char))
 426   (assert (equal
 427            (with-input-from-string (in "foo\"bar\"")
 428              (with-open-stream (out (make-broadcast-stream))
 429                (with-open-stream (echo (make-echo-stream in out))
 430                  (read echo)))
 431              (read in))
 432            ;; Before ca 1.0.27.18, the implicit UNREAD-CHAR at the end of
 433            ;; the first READ wouldn't get back to IN, so the second READ
 434            ;; returned BAR, not "BAR" (and then subsequent reads would
 435            ;; lose).
 436            "bar")))
 437
 438 ;; WITH-INPUT-FROM-STRING would multiply evaluate the :END argument,
 439 ;; and so previously this returned the symbol A, not ABC.
 440 (with-test (:name (with-input-from-string :end :once-only))
 441   (assert (eq (let ((s "ABCDEFG")
 442                     (i 5))
 443                 (symbol-macrolet ((ptr (decf i 2)))
 444                   (with-input-from-string (stream s :end ptr)
 445                     (read stream))))
 446               'abc)))
 447
 448 (flet ((test (form)
 449          ;; CHECKED-COMPILE avoids the compile-time warning when
 450          ;; loading this file.
 451          (let ((fun (checked-compile `(lambda () ,form) :allow-warnings t)))
 452            (assert-error (funcall fun) type-error))))
 453
 454   (with-test (:name (read-sequence sequence type-error))
 455     (test `(read-sequence 1 (make-string-input-stream "foo"))))
 456
 457   (with-test (:name (write-sequence sequence type-error))
 458     (test `(write-sequence 1 (make-string-output-stream)))))
 459
 460 (with-test (:name :fill-pointer-stream-charpos)
 461   (let ((string (make-array 3  :initial-contents (format nil "~%ab")
 462                                :element-type 'character :fill-pointer 1)))
 463     (with-output-to-string (stream string)
 464       (fresh-line stream))
 465     (assert (equal string (string #\Newline)))))
 466
 467 (with-test (:name (:fill-pointer-stream-charpos :displaced))
 468   (let* ((displaced (format nil "~%abc"))
 469          (string (make-array 3 :displaced-to displaced
 470                                :displaced-index-offset 1
 471                                :element-type (array-element-type displaced)
 472                                :fill-pointer 0)))
 473     (with-output-to-string (stream string)
 474       (fresh-line stream))
 475     (assert (equal string ""))))
 476
 477 #+sb-unicode
 478 (with-test (:name (:write-char-base-char-stream-reject-non-base-char))
 479   (assert-error
 480    (write-char (code-char 1000)
 481                (make-string-output-stream :element-type 'base-char))))
 482
 483 #+sb-unicode
 484 (with-test (:name (:write-string-base-char-stream-reject-non-base-char))
 485   (assert-error
 486    (write-string (make-string 1 :initial-element (code-char 1000))
 487                  (make-string-output-stream :element-type 'base-char))))
 488
 489 #+sb-unicode
 490 (with-test (:name (:default-char-stream-resets))
 491   (sb-impl::%with-output-to-string (s)
 492     (dotimes (i 2)
 493       (write-char (code-char 1000) s)
 494       (assert (equal (type-of (get-output-stream-string s))
 495                      '(simple-array character (1))))
 496       (write-char #\a s)
 497       ;; result type reverts back to simple-base-string after get-output-stream-string
 498       (assert (equal (type-of (get-output-stream-string s))
 499                      '(simple-base-string 1))))))
 500
 501 (with-test (:name :with-input-from-string-nowarn)
 502   (checked-compile '(lambda ()
 503                      (with-input-from-string (s "muffin")))))
 504
 505 (with-test (:name :with-input-from-string-declarations)
 506   (checked-compile-and-assert
 507       ()
 508       `(lambda (string)
 509          (with-input-from-string (x string)
 510            (declare (optimize safety))
 511            (read-char x)))
 512     (("a") #\a)))
 513
 514 (defun input-from-dynamic-extent-stream ()
 515   (handler-case (with-input-from-string (stream "#w") (read stream nil nil))
 516     (error (condition)
 517       (format nil "~A" condition))))
 518 (compile 'input-from-dynamic-extent-stream)
 519 (with-test (:name :with-input-from-string-signal-stream-error)
 520   (assert (search "unavailable" (input-from-dynamic-extent-stream))))
 521
 522 (with-test (:name :closeable-broadcast-stream)
 523   (let ((b (make-broadcast-stream)))
 524    (close b)
 525    (assert (not (open-stream-p b)))
 526    (assert-error (write-string "test" b))))
 527
 528 (defvar *some-stream*)
 529 (with-test (:name :closeable-synonym-stream)
 530   (let ((*some-stream* (make-string-input-stream "hola")))
 531     (let ((syn (make-synonym-stream '*some-stream*)))
 532       (assert (eql (read-char syn) #\h))
 533       (close syn)
 534       (assert (not (open-stream-p syn)))
 535       (assert-error (read-char syn))
 536       (close syn) ; no error
 537       (assert (eql (read-char *some-stream*) #\o)))))