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 :unspecific :type :unspecific
16 "Directory for temporary test files.")
18 (defparameter *test-file*
19 (merge-pathnames #p"test-data.txt" *test-path*))
21 (eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t))
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))))
31 (defmacro with-test-file ((stream file &rest open-arguments
32 &key (delete-afterwards t)
36 (setq open-arguments (remove-key :delete-afterwards open-arguments))
37 (setq open-arguments (remove-key :initial-content open-arguments))
39 (let ((create-file-stream (gensym)))
41 (with-open-file (,create-file-stream ,file :direction :output
43 :if-does-not-exist :create)
44 (write-sequence ,initial-content ,create-file-stream))
46 (with-open-file (,stream ,file ,@open-arguments)
48 ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
50 (with-open-file (,stream ,file ,@open-arguments)
52 ,(when delete-afterwards `(ignore-errors (delete-file ,file))))))
55 (deftest create-file-1
56 ;; Create a file-simple-stream, write data.
58 (with-open-stream (s (make-instance 'file-simple-stream
62 :if-does-not-exist :create))
63 (string= (write-string *dumb-string* s) *dumb-string*))
64 (delete-file *test-file*))
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*))
75 (deftest create-read-file-1
76 ;; Via file-simple-stream objects, write and then re-read data.
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)
85 (with-test-file (s *test-file* :class 'file-simple-stream
86 :direction :input :if-does-not-exist :error)
88 (multiple-value-bind (string missing-newline-p)
90 (setf result (and result (string= string *dumb-string*)
91 (not missing-newline-p))))
93 (multiple-value-bind (string missing-newline-p)
95 (setf result (and result (string= string *dumb-string*)
100 (deftest create-read-mapped-file-1
101 ;; Read data via a mapped-file-simple-stream object.
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*))))
110 (deftest write-read-inet
112 (with-open-stream (s (make-instance 'socket-simple-stream
113 :remote-host #(127 0 0 1)
116 (string= (prog1 (write-line "Got it!" s) (finish-output s))
118 (sb-bsd-sockets::connection-refused-error () t))
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))))
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))))
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))))
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)
181 (let* ((stream (make-instance 'socket-simple-stream
182 :remote-host #(127 0 0 1)
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))
190 (sb-bsd-sockets::connection-refused-error () t))
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*)
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*)
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)
218 (deftest file-position-4
219 ;; Test reading of file-position in the presence of unsaved data and
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
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)))
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)
243 (file-position s :start)
247 (deftest write-read-unflushed-sc-2
248 ;; Write something into a single-channel stream, try to read back too much
250 (with-test-file (s *test-file* :class 'file-simple-stream
251 :direction :io :if-does-not-exist :create
252 :if-exists :supersede)
254 (file-position s :start)
261 (deftest write-read-unflushed-sc-3
262 ;; Test writing in a buffer filled with previous file contents
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)))
271 (file-position s pos)
272 (setq result (and result (char= (read-char s) #\x)))))
276 (deftest write-read-unflushed-sc-4
277 ;; Test flushing of buffers
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.
286 (file-position s :end) ; Extend file.
288 (with-test-file (s *test-file* :class 'file-simple-stream
289 :direction :input :if-does-not-exist :error)
294 (deftest write-read-append-sc-1
295 ;; Test writing in the middle of a stream opened in append mode
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.
303 (file-position s :end) ; Extend file.
305 (with-test-file (s *test-file* :class 'file-simple-stream
306 :direction :input :if-does-not-exist :error)