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