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
  77 ;;; 0.7.12 doesn't advance current stream in concatenated streams
  78 ;;; correctly when searching a stream for a char to read.
  79 (with-input-from-string (p "")
  80   (with-input-from-string (q "foo")
  81     (let* ((r (make-concatenated-stream p q)))
  82       (peek-char nil r))))
  83
  84 ;;; 0.7.14 and previous SBCLs don't have a working INTERACTIVE-STREAM-P
  85 ;;; because it called UNIX-ISATTY, which wasn't defined.
  86 (with-input-from-string (s "a non-interactive stream")
  87   (assert (not (interactive-stream-p s))))
  88 ;;; KLUDGE: Unfortunately it's hard to find a reliably interactive
  89 ;;; stream to test, since it's reasonable for these tests to be run
  90 ;;; from a script, conceivably even as something like a cron job.
  91 ;;; Ideas?
  92 #+nil (assert (eq (interactive-stream-p *terminal-io*) t))
  93
  94 ;;; MAKE-STRING-INPUT-STREAM
  95 ;;;
  96 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
  97 ;;;   FILE-POSITION beyond the end of string, signalling END-OF-FILE only
  98 ;;;   on read.
  99 (let* ((string (copy-seq "abc"))
 100        (stream (make-string-input-stream string)))
 101   (assert (char= (read-char stream) #\a))
 102   (assert (= 1 (file-position stream)))
 103   (assert (file-position stream :start))
 104   (assert (= 0 (file-position stream)))
 105   (assert (file-position stream :end))
 106   (assert (= (length string) (file-position stream)))
 107   (assert (file-position stream (1- (file-position stream))))
 108   (assert (char= (read-char stream) #\c))
 109   (assert (file-position stream (1- (file-position stream))))
 110   (assert (char= (read-char stream) #\c))
 111   (assert (file-position stream :end))
 112   (let ((eof (cons nil nil)))
 113     (assert (eq (read-char stream nil eof) eof)))
 114   (assert (file-position stream 10))
 115   (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
 116     (assert (null val))
 117     (assert (typep cond 'error)))
 118   (multiple-value-bind (val cond) (ignore-errors (read-char stream))
 119     (assert (null val))
 120     (assert (typep cond 'end-of-file))))
 121
 122 ;;; MAKE-STRING-OUTPUT-STREAM
 123 ;;;
 124 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
 125 ;;;   FILE-POSITION to an arbitrary index.
 126 ;;;
 127 ;;; * END will always refer to the farthest position of stream so-far
 128 ;;;   seen, and setting FILE-POSITION beyond the current END will extend
 129 ;;;   the string/stream with uninitialized elements.
 130 ;;;
 131 ;;; * Rewinding the stream works with overwriting semantics.
 132 ;;;
 133 (let ((stream (make-string-output-stream)))
 134   (princ "abcd" stream)
 135   (assert (= 4 (file-position stream)))
 136   (assert (file-position stream :start))
 137   (assert (= 0 (file-position stream)))
 138   (princ "0" stream)
 139   (assert (= 1 (file-position stream)))
 140   (file-position stream 2)
 141   (assert (= 2 (file-position stream)))
 142   (princ "2" stream)
 143   (assert (file-position stream :end))
 144   (assert (= 4 (file-position stream)))
 145   (assert (file-position stream 6))
 146   (assert (file-position stream 4))
 147   (assert (file-position stream :end))
 148   (assert (= 6 (file-position stream)))
 149   (assert (file-position stream 4))
 150   (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
 151     (assert (null val))
 152     (assert (typep cond 'error)))
 153   (princ "!!" stream)
 154   (assert (equal "0b2d!!" (get-output-stream-string stream))))
 155
 156 ;;; WITH-OUTPUT-TO-STRING (when provided with a string argument)
 157 ;;;
 158 ;;; * Observe FILE-POSITION :START and :END, and allow setting of
 159 ;;; FILE-POSITION to an arbitrary index. If the new position is beyond
 160 ;;; the end of string and the string is adjustable the string will be
 161 ;;; implicitly extended, otherwise an error will be signalled. The
 162 ;;; latter case is provided for in the code, but not currently
 163 ;;; excercised since SBCL fill-pointer arrays are always (currently) adjustable.
 164 ;;;
 165 ;;; * END will refer to the ARRAY-TOTAL-SIZE of string, not
 166 ;;; FILL-POINTER, since by definition the FILE-POSITION will always be
 167 ;;; a FILL-POINTER, so that would be of limited use.
 168 ;;;
 169 ;;; * Rewinding the stream works with owerwriting semantics.
 170 ;;;
 171 #+nil (let ((str (make-array 0
 172                        :element-type 'character
 173                        :adjustable nil
 174                        :fill-pointer t)))
 175   (with-output-to-string (stream str)
 176     (princ "abcd" stream)
 177     (assert (= 4 (file-position stream)))
 178     (assert (file-position stream :start))
 179     (assert (= 0 (file-position stream)))
 180     (princ "0" stream)
 181     (assert (= 1 (file-position stream)))
 182     (file-position stream 2)
 183     (assert (= 2 (file-position stream)))
 184     (princ "2" stream)
 185     (assert (file-position stream :end))
 186     (assert (= 4 (file-position stream)))
 187     (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
 188       (assert (null val))
 189       (assert (typep cond 'error)))
 190     (multiple-value-bind (val cond) (ignore-errors (file-position stream 6))
 191       (assert (null val))
 192       (assert (typep cond 'error)))
 193     (assert (equal "0b2d" str))))
 194
 195 (let ((str (make-array 0
 196                        :element-type 'character
 197                        :adjustable nil
 198                        :fill-pointer t)))
 199   (with-output-to-string (stream str)
 200     (princ "abcd" stream)
 201     (assert (= 4 (file-position stream)))
 202     (assert (file-position stream :start))
 203     (assert (= 0 (file-position stream)))
 204     (princ "0" stream)
 205     (assert (= 1 (file-position stream)))
 206     (file-position stream 2)
 207     (assert (= 2 (file-position stream)))
 208     (princ "2" stream)
 209     (assert (file-position stream :end))
 210     (assert (= 4 (file-position stream)))
 211     (assert (file-position stream 6))
 212     (assert (file-position stream 4))
 213     (assert (file-position stream :end))
 214     (assert (= 6 (file-position stream)))
 215     (assert (file-position stream 4))
 216     (multiple-value-bind (val cond) (ignore-errors (file-position stream -1))
 217       (assert (null val))
 218       (assert (typep cond 'error)))
 219     (princ "!!" stream)
 220     (assert (equal "0b2d!!" str))))
 221
 222 ;;; MAKE-STRING-OUTPUT-STREAM and WITH-OUTPUT-TO-STRING take an
 223 ;;; :ELEMENT-TYPE keyword argument
 224 (macrolet ((frob (element-type-form)
 225              `(progn
 226                 (let ((s (with-output-to-string
 227                            (s nil ,@(when element-type-form
 228                                       `(:element-type ,element-type-form))))))
 229                   (assert (typep s '(simple-array ,(if element-type-form
 230                                                        (eval element-type-form)
 231                                                        'character)
 232                                                   (0)))))
 233                 (get-output-stream-string
 234                  (make-string-output-stream
 235                   ,@(when element-type-form
 236                       `(:element-type ,element-type-form)))))))
 237   (frob nil)
 238   (frob 'character)
 239   (frob 'base-char)
 240   (frob 'nil))