3 (defpackage sb-simple-streams-test
4 (:use #:common-lisp #:sb-simple-streams #:sb-rt))
7 (in-package #:sb-simple-streams-test)
9 (defparameter *dumb-string*
10 "This file was created by simple-stream-tests.lisp. Nothing to see here, move along.")
12 (defparameter *test-path*
13 (merge-pathnames (make-pathname :name nil :type nil :version nil)
15 "Directory for temporary test files.")
17 (eval-when (:load-toplevel) (ensure-directories-exist *test-path*))
19 (defmacro with-test-file ((stream file &rest open-arguments
20 &key (delete-afterwards t)
24 (remf open-arguments :delete-afterwards)
25 (remf open-arguments :initial-content)
27 (let ((create-file-stream (gensym)))
29 (with-open-file (,create-file-stream ,file :direction :output
31 :if-does-not-exist :create)
32 (write-sequence ,initial-content ,create-file-stream))
34 (with-open-file (,stream ,file ,@open-arguments)
36 ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
38 (with-open-file (,stream ,file ,@open-arguments)
40 ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
43 (deftest create-file-1
44 ;; Create a file-simple-stream, write data.
45 (let* ((file (merge-pathnames #p"test-data.txt" *test-path*)))
47 (with-open-stream (s (make-instance 'file-simple-stream
51 :if-does-not-exist :create))
52 (string= (write-string *dumb-string* s) *dumb-string*))
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*)))
64 (deftest create-read-file-1
65 ;; Via file-simple-stream objects, write and then re-read data.
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)
75 (with-test-file (s file :class 'file-simple-stream
76 :direction :input :if-does-not-exist :error)
78 (multiple-value-bind (string missing-newline-p)
80 (setf result (and result (string= string *dumb-string*)
81 (not missing-newline-p))))
83 (multiple-value-bind (string missing-newline-p)
85 (setf result (and result (string= string *dumb-string*)
90 (deftest create-read-mapped-file-1
91 ;; Read data via a mapped-file-simple-stream object.
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*))))
101 (deftest write-read-inet
103 (with-open-stream (s (make-instance 'socket-simple-stream
104 :remote-host #(127 0 0 1)
106 (string= (prog1 (write-line "Got it!" s) (finish-output s))
108 (sb-bsd-sockets::connection-refused-error () t))
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))))
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)
132 (let* ((stream (make-instance 'socket-simple-stream
133 :remote-host #(127 0 0 1)
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))
140 (sb-bsd-sockets::connection-refused-error () t))
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*)
152 ;;; file-position-2 fails ONLY when called with
153 ;;; (asdf:oos 'asdf:test-op :sb-simple-streams)
154 ;;; TODO: Find out why
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*)
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)
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))))
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)
190 (file-position s :start)
194 (deftest write-read-unflushed-sc-2
195 ;; Write something into a single-channel stream, try to read back too much
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)
201 (file-position s :start)
208 (deftest write-read-unflushed-sc-3
209 (let ((file (merge-pathnames #p"test-data.txt" *test-path*))
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)))
218 (file-position s pos)
219 (setq result (and result (char= (read-char s) #\x)))))
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.
233 (file-position s :end) ; Extend file.
235 (with-test-file (s file :class 'file-simple-stream :direction :input
236 :if-does-not-exist :error)
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.
250 (file-position s :end) ; Extend file.
252 (with-test-file (s file :class 'file-simple-stream :direction :input
253 :if-does-not-exist :error)