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