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.txt" *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 (defmacro with-test-file ((stream file &rest open-arguments
  32                                   &key (delete-afterwards t)
  33                                   initial-content
  34                                   &allow-other-keys)
  35                           &body body)
  36   (setq open-arguments (remove-key :delete-afterwards open-arguments))
  37   (setq open-arguments (remove-key :initial-content open-arguments))
  38   (if initial-content
  39       (let ((create-file-stream (gensym)))
  40         `(progn
  41            (with-open-file (,create-file-stream ,file :direction :output
  42                                                 :if-exists :supersede
  43                                                 :if-does-not-exist :create)
  44              (write-sequence ,initial-content ,create-file-stream))
  45            (unwind-protect
  46                 (with-open-file (,stream ,file ,@open-arguments)
  47                   (progn ,@body))
  48              ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
  49       `(unwind-protect
  50             (with-open-file (,stream ,file ,@open-arguments)
  51               (progn ,@body))
  52          ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
  53
  54
  55 (deftest create-file-1
  56     ;; Create a file-simple-stream, write data.
  57     (prog1
  58         (with-open-stream (s (make-instance 'file-simple-stream
  59                                             :filename *test-file*
  60                                             :direction :output
  61                                             :if-exists :overwrite
  62                                             :if-does-not-exist :create))
  63           (string= (write-string *dumb-string* s) *dumb-string*))
  64       (delete-file *test-file*))
  65   t)
  66
  67 (deftest create-file-2
  68     ;; Create a file-simple-stream via :class argument to open, write data.
  69     (with-test-file (s *test-file* :class 'file-simple-stream
  70                        :direction :output :if-exists :overwrite
  71                        :if-does-not-exist :create)
  72       (string= (write-string *dumb-string* s) *dumb-string*))
  73   t)
  74
  75 (deftest create-read-file-1
  76   ;; Via file-simple-stream objects, write and then re-read data.
  77   (let ((result t))
  78     (with-test-file (s *test-file* :class 'file-simple-stream
  79                        :direction :output :if-exists :overwrite
  80                        :if-does-not-exist :create :delete-afterwards nil)
  81       (write-line *dumb-string* s)
  82       (setf result (and result (string= (write-string *dumb-string* s)
  83                                         *dumb-string*))))
  84
  85     (with-test-file (s *test-file* :class 'file-simple-stream
  86                        :direction :input :if-does-not-exist :error)
  87       ;; Check first line
  88       (multiple-value-bind (string missing-newline-p)
  89           (read-line s)
  90         (setf result (and result (string= string *dumb-string*)
  91                           (not missing-newline-p))))
  92       ;; Check second line
  93       (multiple-value-bind (string missing-newline-p)
  94           (read-line s)
  95         (setf result (and result (string= string *dumb-string*)
  96                           missing-newline-p))))
  97     result)
  98   t)
  99
 100 (deftest create-read-mapped-file-1
 101   ;; Read data via a mapped-file-simple-stream object.
 102   (let ((result t))
 103     (with-test-file (s *test-file* :class 'mapped-file-simple-stream
 104                        :direction :input :if-does-not-exist :error
 105                        :initial-content *dumb-string*)
 106       (setf result (and result (string= (read-line s) *dumb-string*))))
 107     result)
 108   t)
 109
 110 (deftest write-read-inet
 111   (handler-case
 112       (with-open-stream (s (make-instance 'socket-simple-stream
 113                                           :remote-host #(127 0 0 1)
 114                                           :remote-port 7
 115                                           :direction :io))
 116         (string= (prog1 (write-line "Got it!" s) (finish-output s))
 117                  (read-line s)))
 118     (sb-bsd-sockets::connection-refused-error () t))
 119   t)
 120
 121 (deftest write-read-large-sc-1
 122   ;; Do write and read with more data than the buffer will hold
 123   ;; (single-channel simple-stream)
 124   (let* ((stream (make-instance 'file-simple-stream
 125                                 :filename *test-file* :direction :output
 126                                 :if-exists :overwrite
 127                                 :if-does-not-exist :create))
 128          (content (make-string (1+ (device-buffer-length stream))
 129                                :initial-element #\x)))
 130     (with-open-stream (s stream)
 131       (write-string content s))
 132     (with-test-file (s *test-file* :class 'file-simple-stream
 133                        :direction :input :if-does-not-exist :error)
 134       (string= content (read-line s))))
 135   t)
 136
 137 (deftest write-read-large-sc-2
 138   (let* ((stream (make-instance 'file-simple-stream
 139                                 :filename *test-file* :direction :output
 140                                 :if-exists :overwrite
 141                                 :if-does-not-exist :create))
 142          (length (1+ (* 3 (device-buffer-length stream))))
 143          (content (make-string length)))
 144     (dotimes (i (length content))
 145       (setf (aref content i) (code-char (random 256))))
 146     (with-open-stream (s stream)
 147       (write-string content s))
 148     (with-test-file (s *test-file* :class 'file-simple-stream
 149                        :direction :input :if-does-not-exist :error)
 150       (let ((seq (make-string length)))
 151         #+nil (read-sequence seq s)
 152         #-nil (dotimes (i length)
 153                 (setf (char seq i) (read-char s)))
 154         (string= content seq))))
 155   t)
 156
 157 (deftest write-read-large-sc-3
 158   (let* ((stream (make-instance 'file-simple-stream
 159                                 :filename *test-file* :direction :output
 160                                 :if-exists :overwrite
 161                                 :if-does-not-exist :create))
 162          (length (1+ (* 3 (device-buffer-length stream))))
 163          (content (make-array length :element-type '(unsigned-byte 8))))
 164     (dotimes (i (length content))
 165       (setf (aref content i) (random 256)))
 166     (with-open-stream (s stream)
 167       (write-sequence content s))
 168     (with-test-file (s *test-file* :class 'file-simple-stream
 169                        :direction :input :if-does-not-exist :error)
 170       (let ((seq (make-array length :element-type '(unsigned-byte 8))))
 171         #+nil (read-sequence seq s)
 172         #-nil (dotimes (i length)
 173                 (setf (aref seq i) (read-byte s)))
 174         (equalp content seq))))
 175   t)
 176
 177 (deftest write-read-large-dc-1
 178   ;; Do write and read with more data than the buffer will hold
 179   ;; (dual-channel simple-stream; we only have socket streams atm)
 180   (handler-case
 181    (let* ((stream (make-instance 'socket-simple-stream
 182                                  :remote-host #(127 0 0 1)
 183                                  :remote-port 7
 184                                  :direction :io))
 185           (content (make-string (1+ (device-buffer-length stream))
 186                                 :initial-element #\x)))
 187      (with-open-stream (s stream)
 188        (string= (prog1 (write-line content s) (finish-output s))
 189                 (read-line s))))
 190    (sb-bsd-sockets::connection-refused-error () t))
 191   t)
 192
 193
 194 (deftest file-position-1
 195     ;; Test reading of file-position
 196     (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
 197                        :initial-content *dumb-string*)
 198       (file-position s))
 199   0)
 200
 201 (deftest file-position-2
 202     ;; Test reading of file-position
 203     (with-test-file (s *test-file* :class 'file-simple-stream :direction :input
 204                        :initial-content *dumb-string*)
 205       (read-byte s)
 206       (file-position s))
 207   1)
 208
 209 (deftest file-position-3
 210     ;; Test reading of file-position in the presence of unsaved data
 211     (with-test-file (s *test-file* :class 'file-simple-stream
 212                        :direction :output :if-exists :supersede
 213                        :if-does-not-exist :create)
 214       (write-byte 50 s)
 215       (file-position s))
 216   1)
 217
 218 (deftest file-position-4
 219     ;; Test reading of file-position in the presence of unsaved data and
 220     ;; filled buffer
 221     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 222                        :if-exists :overwrite :if-does-not-exist :create
 223                        :initial-content *dumb-string*)
 224       (read-byte s)                     ; fill buffer
 225       (write-byte 50 s)                 ; advance file-position
 226       (file-position s))
 227   2)
 228
 229 (deftest file-position-5
 230     ;; Test file position when opening with :if-exists :append
 231     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 232                        :if-exists :append :if-does-not-exist :create
 233                        :initial-content *dumb-string*)
 234       (= (file-length s) (file-position s)))
 235   T)
 236
 237 (deftest write-read-unflushed-sc-1
 238     ;; Write something into a single-channel stream and read it back
 239     ;; without explicitly flushing the buffer in-between
 240     (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 241                        :if-does-not-exist :create :if-exists :supersede)
 242       (write-char #\x s)
 243       (file-position s :start)
 244       (read-char s))
 245   #\x)
 246
 247 (deftest write-read-unflushed-sc-2
 248     ;; Write something into a single-channel stream, try to read back too much
 249     (handler-case
 250         (with-test-file (s *test-file* :class 'file-simple-stream
 251                            :direction :io :if-does-not-exist :create
 252                            :if-exists :supersede)
 253             (write-char #\x s)
 254             (file-position s :start)
 255             (read-char s)
 256             (read-char s)
 257             nil)
 258       (end-of-file () t))
 259   t)
 260
 261 (deftest write-read-unflushed-sc-3
 262     ;; Test writing in a buffer filled with previous file contents
 263     (let ((result t))
 264       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 265                          :if-exists :overwrite :if-does-not-exist :create
 266                          :initial-content *dumb-string*)
 267         (setq result (and result (char= (read-char s) (schar *dumb-string* 0))))
 268         (setq result (and result (= (file-position s) 1)))
 269         (let ((pos (file-position s)))
 270           (write-char #\x s)
 271           (file-position s pos)
 272           (setq result (and result (char= (read-char s) #\x)))))
 273       result)
 274   t)
 275
 276 (deftest write-read-unflushed-sc-4
 277     ;; Test flushing of buffers
 278     (progn
 279       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 280                          :if-exists :overwrite :if-does-not-exist :create
 281                          :initial-content "Foo"
 282                          :delete-afterwards nil)
 283         (read-char s)                   ; Fill the buffer.
 284         (file-position s :start)        ; Change existing data.
 285         (write-char #\X s)
 286         (file-position s :end)          ; Extend file.
 287         (write-char #\X s))
 288       (with-test-file (s *test-file* :class 'file-simple-stream
 289                          :direction :input :if-does-not-exist :error)
 290         (read-line s)))
 291   "XooX"
 292   T)
 293
 294 (deftest write-read-append-sc-1
 295     ;; Test writing in the middle of a stream opened in append mode
 296     (progn
 297       (with-test-file (s *test-file* :class 'file-simple-stream :direction :io
 298                          :if-exists :append :if-does-not-exist :create
 299                          :initial-content "Foo"
 300                          :delete-afterwards nil)
 301         (file-position s :start)        ; Jump to beginning.
 302         (write-char #\X s)
 303         (file-position s :end)          ; Extend file.
 304         (write-char #\X s))
 305       (with-test-file (s *test-file* :class 'file-simple-stream
 306                          :direction :input :if-does-not-exist :error)
 307         (read-line s)))
 308   "XooX"
 309   T)
 310