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