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