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