source: trunk/tests/ansi-tests/open.lsp @ 9672

Last change on this file since 9672 was 9672, checked in by gz, 12 years ago

Uncomment test open.65 (bug #281) which was fixed in r9061

File size: 35.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Jan 23 05:36:55 2004
4;;;; Contains: Tests of OPEN
5
6(in-package :cl-test)
7
8;;; Input streams
9
10(defun generator-for-element-type (type)
11  (etypecase type
12   ((member character base-char)
13    #'(lambda (i) (aref "abcdefghijklmnopqrstuvwxyz" (mod i 26))))
14   ((member signed-byte unsigned-byte bit)
15    #'(lambda (i) (logand i 1)))
16   (cons
17    (let ((op (car type))
18          (arg1 (cadr type))
19          (arg2 (caddr type)))
20      (ecase op
21        (unsigned-byte
22         (let ((mask (1- (ash 1 arg1))))
23           #'(lambda (i) (logand i mask))))
24        (signed-byte
25         (let ((mask (1- (ash 1 (1- arg1)))))
26           #'(lambda (i) (logand i mask))))
27        (integer
28         (let* ((lo arg1)
29                (hi arg2)
30               (lower-bound
31                (etypecase lo
32                  (integer lo)
33                  (cons (1+ (car lo)))))
34               (upper-bound
35                (etypecase hi
36                  (integer hi)
37                  (cons (1- (car hi)))))
38               (range (1+ (- upper-bound lower-bound))))
39           #'(lambda (i) (+ lower-bound (mod i range))))))))))
40
41(compile 'generator-for-element-type)
42
43(defmacro def-open-test (name args form expected
44                              &key
45                              (notes nil notes-p)
46                              (build-form nil build-form-p)
47                              (element-type 'character element-type-p)
48                              (pathname #p"tmp.dat"))
49         
50  (when element-type-p
51    (setf args (append args (list :element-type `',element-type))))
52
53  (unless build-form-p
54    (let ((write-element-form
55           (cond
56            ((subtypep element-type 'integer)
57             `(write-byte
58               (funcall (the function
59                          (generator-for-element-type ',element-type)) i)
60               os))
61            ((subtypep element-type 'character)
62             `(write-char
63               (funcall (the function
64                          (generator-for-element-type ',element-type)) i)
65               os)))))
66      (setq build-form
67            `(with-open-file
68              (os pn :direction :output
69                  ,@(if element-type-p
70                        `(:element-type ',element-type))
71                  :if-exists :supersede)
72              (assert (open-stream-p os))
73              (dotimes (i 10) ,write-element-form)
74              (finish-output os)
75            ))))
76                             
77  `(deftest ,name
78     ,@(when notes-p `(:notes ,notes))
79     (let ((pn ,pathname))
80       (delete-all-versions pn)
81       ,build-form
82       (let ((s (open pn ,@args)))
83         (unwind-protect
84             (progn
85               (assert (open-stream-p s))
86               (assert (typep s 'file-stream))
87               ,@
88               (unless (member element-type '(signed-byte unsigned-byte))
89                 #-allegro
90                 `((assert (subtypep ',element-type
91                                     (stream-element-type s))))
92                 #+allegro nil
93                 )
94               ,form)
95           (close s))))
96     ,@expected))
97
98;; (compile 'def-open-test)
99
100(def-open-test open.1 () (values (read-line s nil)) ("abcdefghij"))
101(def-open-test open.2 (:direction :input)
102  (values (read-line s nil)) ("abcdefghij") :element-type character)
103(def-open-test open.3 (:direction :input)
104  (values (read-line s nil)) ("abcdefghij"))
105(def-open-test open.4 (:direction :input)
106  (values (read-line s nil)) ("abcdefghij") :element-type base-char)
107(def-open-test open.5 (:if-exists :error)
108  (values (read-line s nil)) ("abcdefghij"))
109(def-open-test open.6 (:if-exists :error :direction :input)
110  (values (read-line s nil)) ("abcdefghij"))
111(def-open-test open.7 (:if-exists :new-version)
112  (values (read-line s nil)) ("abcdefghij"))
113(def-open-test open.8 (:if-exists :new-version :direction :input)
114  (values (read-line s nil)) ("abcdefghij"))
115(def-open-test open.9 (:if-exists :rename)
116  (values (read-line s nil)) ("abcdefghij"))
117(def-open-test open.10 (:if-exists :rename :direction :input)
118  (values (read-line s nil)) ("abcdefghij"))
119(def-open-test open.11 (:if-exists :rename-and-delete)
120  (values (read-line s nil)) ("abcdefghij"))
121(def-open-test open.12 (:if-exists :rename-and-delete :direction :input)
122  (values (read-line s nil)) ("abcdefghij"))
123(def-open-test open.13 (:if-exists :overwrite)
124  (values (read-line s nil)) ("abcdefghij"))
125(def-open-test open.14 (:if-exists :overwrite :direction :input)
126  (values (read-line s nil)) ("abcdefghij"))
127(def-open-test open.15 (:if-exists :append)
128  (values (read-line s nil)) ("abcdefghij"))
129(def-open-test open.16 (:if-exists :append :direction :input)
130  (values (read-line s nil)) ("abcdefghij"))
131(def-open-test open.17 (:if-exists :supersede)
132  (values (read-line s nil)) ("abcdefghij"))
133(def-open-test open.18 (:if-exists :supersede :direction :input)
134  (values (read-line s nil)) ("abcdefghij"))
135(def-open-test open.19 (:if-exists nil)
136  (values (read-line s nil)) ("abcdefghij"))
137(def-open-test open.20 (:if-exists nil :direction :input)
138  (values (read-line s nil)) ("abcdefghij"))
139
140(def-open-test open.21 (:if-does-not-exist nil)
141  (values (read-line s nil)) ("abcdefghij"))
142(def-open-test open.22 (:if-does-not-exist nil :direction :input)
143  (values (read-line s nil)) ("abcdefghij"))
144(def-open-test open.23 (:if-does-not-exist :error)
145  (values (read-line s nil)) ("abcdefghij"))
146(def-open-test open.24 (:if-does-not-exist :error :direction :input)
147  (values (read-line s nil)) ("abcdefghij"))
148(def-open-test open.25 (:if-does-not-exist :create)
149  (values (read-line s nil)) ("abcdefghij"))
150(def-open-test open.26 (:if-does-not-exist :create :direction :input)
151  (values (read-line s nil)) ("abcdefghij"))
152
153(def-open-test open.27 (:external-format :default)
154  (values (read-line s nil)) ("abcdefghij"))
155(def-open-test open.28 (:external-format :default :direction :input)
156  (values (read-line s nil)) ("abcdefghij"))
157
158(def-open-test open.29 ()
159  (let ((seq (make-array 10))) (read-sequence seq s) seq)
160  (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1))
161(def-open-test open.30 (:direction :input)
162  (let ((seq (make-array 10))) (read-sequence seq s) seq)
163  (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1))
164
165(def-open-test open.31 ()
166  (let ((seq (make-array 10))) (read-sequence seq s) seq)
167  (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2))
168(def-open-test open.32 (:direction :input)
169  (let ((seq (make-array 10))) (read-sequence seq s) seq)
170  (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2))
171
172(def-open-test open.33 ()
173  (let ((seq (make-array 10))) (read-sequence seq s) seq)
174  (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3))
175(def-open-test open.34 (:direction :input)
176  (let ((seq (make-array 10))) (read-sequence seq s) seq)
177  (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3))
178
179(def-open-test open.35 ()
180  (let ((seq (make-array 10))) (read-sequence seq s) seq)
181  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4))
182(def-open-test open.36 (:direction :input)
183  (let ((seq (make-array 10))) (read-sequence seq s) seq)
184  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4))
185
186(def-open-test open.37 ()
187  (let ((seq (make-array 10))) (read-sequence seq s) seq)
188  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5))
189(def-open-test open.38 (:direction :input)
190  (let ((seq (make-array 10))) (read-sequence seq s) seq)
191  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5))
192
193(def-open-test open.39 ()
194  (let ((seq (make-array 10))) (read-sequence seq s) seq)
195  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6))
196(def-open-test open.40 (:direction :input)
197  (let ((seq (make-array 10))) (read-sequence seq s) seq)
198  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6))
199
200(def-open-test open.41 ()
201  (let ((seq (make-array 10))) (read-sequence seq s) seq)
202  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7))
203(def-open-test open.42 (:direction :input)
204  (let ((seq (make-array 10))) (read-sequence seq s) seq)
205  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7))
206
207(def-open-test open.43 ()
208  (let ((seq (make-array 10))) (read-sequence seq s) seq)
209  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8))
210(def-open-test open.44 (:direction :input)
211  (let ((seq (make-array 10))) (read-sequence seq s) seq)
212  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8))
213
214(def-open-test open.45 ()
215  (let ((seq (make-array 10))) (read-sequence seq s) seq)
216  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9))
217(def-open-test open.46 (:direction :input)
218  (let ((seq (make-array 10))) (read-sequence seq s) seq)
219  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9))
220
221(def-open-test open.47 ()
222  (let ((seq (make-array 10))) (read-sequence seq s) seq)
223  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10))
224(def-open-test open.48 (:direction :input)
225  (let ((seq (make-array 10))) (read-sequence seq s) seq)
226  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10))
227
228(def-open-test open.49 ()
229  (let ((seq (make-array 10))) (read-sequence seq s) seq)
230  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20))
231(def-open-test open.50 (:direction :input)
232  (let ((seq (make-array 10))) (read-sequence seq s) seq)
233  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20))
234
235(def-open-test open.51 ()
236  (let ((seq (make-array 10))) (read-sequence seq s) seq)
237  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25))
238(def-open-test open.52 (:direction :input)
239  (let ((seq (make-array 10))) (read-sequence seq s) seq)
240  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25))
241
242(def-open-test open.53 ()
243  (let ((seq (make-array 10))) (read-sequence seq s) seq)
244  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30))
245(def-open-test open.54 (:direction :input)
246  (let ((seq (make-array 10))) (read-sequence seq s) seq)
247  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30))
248
249(def-open-test open.55 ()
250  (let ((seq (make-array 10))) (read-sequence seq s) seq)
251  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32))
252(def-open-test open.56 (:direction :input)
253  (let ((seq (make-array 10))) (read-sequence seq s) seq)
254  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32))
255
256(def-open-test open.57 ()
257  (let ((seq (make-array 10))) (read-sequence seq s) seq)
258  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33))
259(def-open-test open.58 (:direction :input)
260  (let ((seq (make-array 10))) (read-sequence seq s) seq)
261  (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33))
262
263(def-open-test open.59 ()
264  (let ((seq (make-array 10))) (read-sequence seq s) seq)
265  (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte)
266(def-open-test open.60 (:direction :input)
267  (let ((seq (make-array 10))) (read-sequence seq s) seq)
268  (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte)
269
270(def-open-test open.61 ()
271  (let ((seq (make-array 10))) (read-sequence seq s) seq)
272  (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte)
273(def-open-test open.62 (:direction :input)
274  (let ((seq (make-array 10))) (read-sequence seq s) seq)
275  (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte)
276
277
278(def-open-test open.63 ()
279  (values (read-line s nil)) ("abcdefghij")
280  :pathname "tmp.dat")
281
282(def-open-test open.64 ()
283  (values (read-line s nil)) ("abcdefghij")
284  :pathname (logical-pathname "CLTEST:TMP.DAT"))
285
286;;; It works on recognizable subtypes.
287(deftest open.65
288  (let ((type '(or (integer 0 1) (integer 100 200)))
289        (pn #p"tmp.dat")
290        (vals '(0 1 100 120 130 190 200 1 0 150)))
291    (or
292     (not (subtypep type 'integer))
293     (progn
294       (with-open-file
295        (os pn :direction :output
296            :element-type type
297            :if-exists :supersede)
298        (dolist (e vals) (write-byte e os)))
299       (let ((s (open pn :direction :input
300                      :element-type type))
301             (seq (make-array 10)))
302         (unwind-protect
303             (progn (read-sequence seq s) seq)
304           (close s))
305         (notnot (every #'eql seq vals))))))
306  t)
307
308;;; FIXME: Add -- tests for when the filespec is a stream
309
310(deftest open.66
311  (let ((pn #p"tmp.dat"))
312    (delete-all-versions pn)
313    (with-open-file
314     (s pn :direction :io :if-exists :rename-and-delete
315        :if-does-not-exist :create)
316     (format s "some stuff~%")
317     (finish-output s)
318     (let ((is (open s :direction :input)))
319       (unwind-protect
320           (values
321            (read-char is)
322            (notnot (file-position s :start))
323            (read-line is)
324            (read-line s))
325         (close is)))))
326  #\s
327  t
328  "ome stuff"
329  "some stuff")
330
331(deftest open.67
332  (let ((pn #p"tmp.dat"))
333    (delete-all-versions pn)
334    (let ((s (open pn :direction :output)))
335      (unwind-protect
336          (progn
337            (format s "some stuff~%")
338            (finish-output s)
339            (close s)
340            (let ((is (open s :direction :input)))
341              (unwind-protect
342                  (values (read-line is))
343                (close is))))
344        (when (open-stream-p s) (close s)))))
345  "some stuff")
346
347;;; FIXME: Add -- tests for when element-type is :default
348
349;;; Tests of file creation
350
351(defmacro def-open-output-test
352  (name args form expected
353        &rest keyargs
354        &key
355        (element-type 'character)
356        (build-form
357         `(dotimes (i 10)
358            ,(cond
359              ((subtypep element-type 'integer)
360               `(write-byte
361                 (funcall (the function
362                            (generator-for-element-type ',element-type)) i)
363                 s))
364              ((subtypep element-type 'character)
365               `(write-char
366                 (funcall (the function
367                            (generator-for-element-type ',element-type)) i)
368                 s)))))
369        &allow-other-keys)
370  `(def-open-test ,name (:direction :output ,@args)
371     (progn
372       ,build-form
373       (assert (output-stream-p s))
374       ,form)
375     ,expected
376     :build-form nil
377     ,@keyargs))
378
379;; (compile 'def-open-output-test)
380
381(def-open-output-test open.output.1 ()
382  (progn (close s)
383         (with-open-file (is #p"tmp.dat") (values (read-line is nil))))
384  ("abcdefghij"))
385
386(def-open-output-test open.output.2 ()
387  (progn (close s)
388         (with-open-file (is "tmp.dat") (values (read-line is nil))))
389  ("abcdefghij")
390  :pathname "tmp.dat")
391
392(def-open-output-test open.output.3
393  ()
394  (progn (close s)
395         (with-open-file (is (logical-pathname "CLTEST:TMP.DAT"))
396                         (values (read-line is nil))))
397  ("abcdefghij")
398  :pathname (logical-pathname "CLTEST:TMP.DAT"))
399
400(def-open-output-test open.output.4 ()
401  (progn (close s)
402         (with-open-file (is #p"tmp.dat" :element-type 'character)
403                         (values (read-line is nil))))
404  ("abcdefghij")
405  :element-type character)
406
407(def-open-output-test open.output.5 ()
408  (progn (close s) (with-open-file (is #p"tmp.dat"
409                                       :element-type 'base-char)
410                                   (values (read-line is nil))))
411  ("abcdefghij")
412  :element-type base-char)
413
414(def-open-output-test open.output.6 ()
415  (progn (close s) (with-open-file (is #p"tmp.dat"
416                                       :element-type '(integer 0 1))
417                                   (let ((seq (make-array 10)))
418                                     (read-sequence seq is)
419                                     seq)))
420  (#(0 1 0 1 0 1 0 1 0 1))
421  :element-type (integer 0 1))
422
423(def-open-output-test open.output.7 ()
424  (progn (close s) (with-open-file (is #p"tmp.dat"
425                                       :element-type 'bit)
426                                   (let ((seq (make-array 10)))
427                                     (read-sequence seq is)
428                                     seq)))
429  (#(0 1 0 1 0 1 0 1 0 1))
430  :element-type bit)
431
432(def-open-output-test open.output.8 ()
433  (progn (close s) (with-open-file (is #p"tmp.dat"
434                                       :element-type '(unsigned-byte 1))
435                                   (let ((seq (make-array 10)))
436                                     (read-sequence seq is)
437                                     seq)))
438  (#(0 1 0 1 0 1 0 1 0 1))
439  :element-type (unsigned-byte 1))
440
441(def-open-output-test open.output.9 ()
442  (progn (close s) (with-open-file (is #p"tmp.dat"
443                                       :element-type '(unsigned-byte 2))
444                                   (let ((seq (make-array 10)))
445                                     (read-sequence seq is)
446                                     seq)))
447  (#(0 1 2 3 0 1 2 3 0 1))
448  :element-type (unsigned-byte 2))
449
450(def-open-output-test open.output.10 ()
451  (progn (close s) (with-open-file (is #p"tmp.dat"
452                                       :element-type '(unsigned-byte 3))
453                                   (let ((seq (make-array 10)))
454                                     (read-sequence seq is)
455                                     seq)))
456  (#(0 1 2 3 4 5 6 7 0 1))
457  :element-type (unsigned-byte 3))
458
459(def-open-output-test open.output.11 ()
460  (progn (close s) (with-open-file (is #p"tmp.dat"
461                                       :element-type '(unsigned-byte 4))
462                                   (let ((seq (make-array 10)))
463                                     (read-sequence seq is)
464                                     seq)))
465  (#(0 1 2 3 4 5 6 7 8 9))
466  :element-type (unsigned-byte 4))
467
468
469(def-open-output-test open.output.12 ()
470  (progn (close s) (with-open-file (is #p"tmp.dat"
471                                       :element-type '(unsigned-byte 6))
472                                   (let ((seq (make-array 10)))
473                                     (read-sequence seq is)
474                                     seq)))
475  (#(0 1 2 3 4 5 6 7 8 9))
476  :element-type (unsigned-byte 6))
477
478(def-open-output-test open.output.13 ()
479  (progn (close s) (with-open-file (is #p"tmp.dat"
480                                       :element-type '(unsigned-byte 8))
481                                   (let ((seq (make-array 10)))
482                                     (read-sequence seq is)
483                                     seq)))
484  (#(0 1 2 3 4 5 6 7 8 9))
485  :element-type (unsigned-byte 8))
486
487(def-open-output-test open.output.14 ()
488  (progn (close s) (with-open-file (is #p"tmp.dat"
489                                       :element-type '(unsigned-byte 12))
490                                   (let ((seq (make-array 10)))
491                                     (read-sequence seq is)
492                                     seq)))
493  (#(0 1 2 3 4 5 6 7 8 9))
494  :element-type (unsigned-byte 12))
495
496(def-open-output-test open.output.15 ()
497  (progn (close s) (with-open-file (is #p"tmp.dat"
498                                       :element-type '(unsigned-byte 16))
499                                   (let ((seq (make-array 10)))
500                                     (read-sequence seq is)
501                                     seq)))
502  (#(0 1 2 3 4 5 6 7 8 9))
503  :element-type (unsigned-byte 16))
504
505(def-open-output-test open.output.16 ()
506  (progn (close s) (with-open-file (is #p"tmp.dat"
507                                       :element-type '(unsigned-byte 24))
508                                   (let ((seq (make-array 10)))
509                                     (read-sequence seq is)
510                                     seq)))
511  (#(0 1 2 3 4 5 6 7 8 9))
512  :element-type (unsigned-byte 24))
513
514(def-open-output-test open.output.17 ()
515  (progn (close s) (with-open-file (is #p"tmp.dat"
516                                       :element-type '(unsigned-byte 32))
517                                   (let ((seq (make-array 10)))
518                                     (read-sequence seq is)
519                                     seq)))
520  (#(0 1 2 3 4 5 6 7 8 9))
521  :element-type (unsigned-byte 32))
522
523(def-open-output-test open.output.18 ()
524  (progn (close s) (with-open-file (is #p"tmp.dat"
525                                       :element-type '(unsigned-byte 64))
526                                   (let ((seq (make-array 10)))
527                                     (read-sequence seq is)
528                                     seq)))
529  (#(0 1 2 3 4 5 6 7 8 9))
530  :element-type (unsigned-byte 64))
531
532#+known-bug-280
533(def-open-output-test open.output.19 ()
534  (progn (close s) (with-open-file (is #p"tmp.dat"
535                                       :element-type '(unsigned-byte 100))
536                                   (let ((seq (make-array 10)))
537                                     (read-sequence seq is)
538                                     seq)))
539  (#(0 1 2 3 4 5 6 7 8 9))
540  :element-type (unsigned-byte 100))
541
542(deftest open.output.20
543  (let ((pn #p"tmp.dat"))
544    (with-open-file (s pn :direction :output :if-exists :supersede))
545    (open pn :direction :output :if-exists nil))
546  nil)
547
548(def-open-test open.output.21 (:if-exists :new-version :direction :output)
549  (progn (write-sequence "wxyz" s)
550         (close s)
551         (with-open-file
552          (s pn :direction :input)
553          (values (read-line s nil))))
554  ("wxyz")
555  :notes (:open-if-exists-new-version-no-error)
556  )
557
558(def-open-test open.output.22 (:if-exists :rename :direction :output)
559  (progn (write-sequence "wxyz" s)
560         (close s)
561         (with-open-file
562          (s pn :direction :input)
563          (values (read-line s nil))))
564  ("wxyz"))
565
566(def-open-test open.output.23 (:if-exists :rename-and-delete
567                                          :direction :output)
568  (progn (write-sequence "wxyz" s)
569         (close s)
570         (with-open-file
571          (s pn :direction :input)
572          (values (read-line s nil))))
573  ("wxyz"))
574
575(def-open-test open.output.24 (:if-exists :overwrite
576                                          :direction :output)
577  (progn (write-sequence "wxyz" s)
578         (close s)
579         (with-open-file
580          (s pn :direction :input)
581          (values (read-line s nil))))
582  ("wxyzefghij"))
583
584(def-open-test open.output.25 (:if-exists :append
585                                          :direction :output)
586  (progn (write-sequence "wxyz" s)
587         (close s)
588         (with-open-file
589          (s pn :direction :input)
590          (values (read-line s nil))))
591  ("abcdefghijwxyz"))
592
593(def-open-test open.output.26 (:if-exists :supersede
594                                          :direction :output)
595  (progn (write-sequence "wxyz" s)
596         (close s)
597         (with-open-file
598          (s pn :direction :input)
599          (values (read-line s nil))))
600  ("wxyz"))
601
602(def-open-output-test open.output.27 (:if-does-not-exist :create
603                                                         :direction :output)
604  (progn (close s)
605         (with-open-file
606          (is pn :direction :input)
607          (values (read-line is nil))))
608  ("abcdefghij"))
609
610(deftest open.output.28
611  (let ((pn #p"tmp.dat"))
612    (delete-all-versions pn)
613    (open pn :direction :output :if-does-not-exist nil))
614  nil)
615
616(def-open-output-test open.output.28a (:external-format :default)
617  (progn (close s)
618         (with-open-file (is #p"tmp.dat") (values (read-line is nil))))
619  ("abcdefghij"))
620
621(def-open-output-test open.output.29
622  (:external-format (prog1
623                      (with-open-file (s "foo.dat" :direction :output
624                                         :if-exists :supersede)
625                                      (stream-external-format s))
626                      (delete-all-versions "foo.dat")
627                      ))
628  (progn (close s)
629         (with-open-file (is #p"tmp.dat") (values (read-line is nil))))
630  ("abcdefghij"))
631
632;;; Default behavior of open :if-exists is :create when the version
633;;; of the filespec is :newest
634
635(deftest open.output.30
636  :notes (:open-if-exists-new-version-no-error)
637  (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest)))
638    (or (not (eql (pathname-version pn) :newest))
639        (progn
640          ;; Create file
641          (let ((s1 (open pn :direction :output :if-exists :overwrite
642                          :if-does-not-exist :create)))
643            (unwind-protect
644                ;; Now try again
645                (let ((s2 (open pn :direction :output)))
646                  (unwind-protect
647                      (write-line "abcdef" s2)
648                    (close s2))
649                  (unwind-protect
650                      (progn
651                        (setq s2 (open s1 :direction :input))
652                        (equalt (read-line s2 nil) "abcdef"))
653                    (close s2)))
654              (close s1)
655              (delete-all-versions pn)
656              )))))
657  t)
658
659(def-open-output-test open.output.31 (:if-exists :rename
660                                      :direction :output)
661  (progn (close s)
662         (with-open-file
663          (is pn :direction :input)
664          (values (read-line is nil))))
665  ("abcdefghij"))
666
667(def-open-output-test open.output.32 (:if-exists :rename-and-delete
668                                      :direction :output)
669  (progn (close s)
670         (with-open-file
671          (is pn :direction :input)
672          (values (read-line is nil))))
673  ("abcdefghij"))
674
675(def-open-output-test open.output.33 (:if-exists :new-version
676                                      :direction :output)
677  (progn (close s)
678         (with-open-file
679          (is pn :direction :input)
680          (values (read-line is nil))))
681  ("abcdefghij"))
682
683(def-open-output-test open.output.34 (:if-exists :supersede
684                                      :direction :output)
685  (progn (close s)
686         (with-open-file
687          (is pn :direction :input)
688          (values (read-line is nil))))
689  ("abcdefghij"))
690
691(def-open-output-test open.output.35 (:if-exists nil
692                                      :direction :output)
693  (progn (close s)
694         (with-open-file
695          (is pn :direction :input)
696          (values (read-line is nil))))
697  ("abcdefghij"))           
698
699;;; Add -- tests for when the filespec is a stream
700
701
702;;; Tests of bidirectional IO
703
704(defmacro def-open-io-test
705  (name args form expected
706        &rest keyargs
707        &key
708        (element-type 'character)
709        (build-form
710         `(dotimes (i 10)
711            ,(cond
712              ((subtypep element-type 'integer)
713               `(write-byte
714                 (funcall (the function
715                            (generator-for-element-type ',element-type)) i)
716                 s))
717              ((subtypep element-type 'character)
718               `(write-char
719                 (funcall (the function
720                            (generator-for-element-type ',element-type)) i)
721                 s)))))
722        &allow-other-keys)
723  `(def-open-test ,name (:direction :io ,@args)
724     (progn
725       ,build-form
726       (assert (input-stream-p s))
727       (assert (output-stream-p s))
728       ,form)
729     ,expected
730     :build-form nil
731     ,@keyargs))
732
733;; (compile 'def-open-io-test)
734
735(def-open-io-test open.io.1 ()
736  (progn (file-position s :start)
737         (values (read-line s nil)))
738  ("abcdefghij"))
739
740(def-open-io-test open.io.2 ()
741  (progn (file-position s :start)
742         (values (read-line s nil)))
743  ("abcdefghij")
744  :pathname "tmp.dat")
745
746(def-open-io-test open.io.3
747  ()
748  (progn (file-position s :start)
749         (values (read-line s nil)))
750  ("abcdefghij")
751  :pathname (logical-pathname "CLTEST:TMP.DAT"))
752
753(def-open-io-test open.io.4 ()
754  (progn (file-position s :start)
755         (values (read-line s nil)))
756  ("abcdefghij")
757  :element-type character)
758
759(def-open-io-test open.io.5 ()
760  (progn (file-position s :start)
761         (values (read-line s nil)))
762  ("abcdefghij")
763  :element-type base-char)
764
765(def-open-io-test open.io.6 ()
766  (progn (file-position s :start)
767         (let ((seq (make-array 10)))
768           (read-sequence seq s)
769           seq))
770  (#(0 1 0 1 0 1 0 1 0 1))
771  :element-type (integer 0 1))
772
773(def-open-io-test open.io.7 ()
774  (progn (file-position s :start)
775         (let ((seq (make-array 10)))
776           (read-sequence seq s)
777           seq))
778  (#(0 1 0 1 0 1 0 1 0 1))
779  :element-type bit)
780
781(def-open-io-test open.io.8 ()
782  (progn (file-position s :start)
783         (let ((seq (make-array 10)))
784           (read-sequence seq s)
785           seq))
786  (#(0 1 0 1 0 1 0 1 0 1))
787  :element-type (unsigned-byte 1))
788
789(def-open-io-test open.io.9 ()
790  (progn (file-position s :start)
791         (let ((seq (make-array 10)))
792           (read-sequence seq s)
793           seq))
794  (#(0 1 2 3 0 1 2 3 0 1))
795  :element-type (unsigned-byte 2))
796
797(def-open-io-test open.io.10 ()
798  (progn (file-position s :start)
799         (let ((seq (make-array 10)))
800           (read-sequence seq s)
801           seq))
802  (#(0 1 2 3 4 5 6 7 0 1))
803  :element-type (unsigned-byte 3))
804
805(def-open-io-test open.io.11 ()
806  (progn (file-position s :start)
807         (let ((seq (make-array 10)))
808           (read-sequence seq s)
809           seq))
810  (#(0 1 2 3 4 5 6 7 8 9))
811  :element-type (unsigned-byte 4))
812
813
814(def-open-io-test open.io.12 ()
815  (progn (file-position s :start)
816         (let ((seq (make-array 10)))
817           (read-sequence seq s)
818           seq))
819  (#(0 1 2 3 4 5 6 7 8 9))
820  :element-type (unsigned-byte 6))
821
822(def-open-io-test open.io.13 ()
823  (progn (file-position s :start)
824         (let ((seq (make-array 10)))
825           (read-sequence seq s)
826           seq))
827  (#(0 1 2 3 4 5 6 7 8 9))
828  :element-type (unsigned-byte 8))
829
830(def-open-io-test open.io.14 ()
831  (progn (file-position s :start)
832         (let ((seq (make-array 10)))
833           (read-sequence seq s)
834           seq))
835  (#(0 1 2 3 4 5 6 7 8 9))
836  :element-type (unsigned-byte 12))
837
838(def-open-io-test open.io.15 ()
839  (progn (file-position s :start)
840         (let ((seq (make-array 10)))
841           (read-sequence seq s)
842           seq))
843  (#(0 1 2 3 4 5 6 7 8 9))
844  :element-type (unsigned-byte 16))
845
846(def-open-io-test open.io.16 ()
847  (progn (file-position s :start)
848         (let ((seq (make-array 10)))
849           (read-sequence seq s)
850           seq))
851  (#(0 1 2 3 4 5 6 7 8 9))
852  :element-type (unsigned-byte 24))
853
854(def-open-io-test open.io.17 ()
855  (progn (file-position s :start)
856         (let ((seq (make-array 10)))
857           (read-sequence seq s)
858           seq))
859  (#(0 1 2 3 4 5 6 7 8 9))
860  :element-type (unsigned-byte 32))
861
862(def-open-io-test open.io.18 ()
863  (progn (file-position s :start)
864         (let ((seq (make-array 10)))
865           (read-sequence seq s)
866           seq))
867  (#(0 1 2 3 4 5 6 7 8 9))
868  :element-type (unsigned-byte 64))
869
870#+known-bug-280
871(def-open-io-test open.io.19 ()
872  (progn (file-position s :start)
873         (let ((seq (make-array 10)))
874           (read-sequence seq s)
875           seq))
876  (#(0 1 2 3 4 5 6 7 8 9))
877  :element-type (unsigned-byte 100))
878
879(deftest open.io.20
880  (let ((pn #p"tmp.dat"))
881    (with-open-file (s pn :direction :io :if-exists :supersede))
882    (open pn :direction :io :if-exists nil))
883  nil)
884
885(def-open-test open.io.21 (:if-exists :new-version :direction :io)
886  (progn (write-sequence "wxyz" s)
887         (file-position s :start)
888         (values (read-line s nil)))
889  ("wxyz")
890  :notes (:open-if-exists-new-version-no-error)
891  )
892
893(def-open-test open.io.22 (:if-exists :rename :direction :io)
894  (progn (write-sequence "wxyz" s)
895         (file-position s :start)
896         (values (read-line s nil)))
897  ("wxyz"))
898
899(def-open-test open.io.23 (:if-exists :rename-and-delete
900                           :direction :io)
901  (progn (write-sequence "wxyz" s)
902         (file-position s :start)
903         (values (read-line s nil)))
904  ("wxyz"))
905
906(def-open-test open.io.24 (:if-exists :overwrite
907                           :direction :io)
908  (progn (write-sequence "wxyz" s)
909         (file-position s :start)
910         (values (read-line s nil)))
911  ("wxyzefghij"))
912
913(def-open-test open.io.25 (:if-exists :append
914                           :direction :io)
915  (progn (write-sequence "wxyz" s)
916         (file-position s :start)
917         (values (read-line s nil)))
918  ("abcdefghijwxyz"))
919
920(def-open-test open.io.26 (:if-exists :supersede
921                           :direction :io)
922  (progn (write-sequence "wxyz" s)
923         (file-position s :start)
924         (values (read-line s nil)))
925  ("wxyz"))
926
927(def-open-io-test open.io.27 (:if-does-not-exist :create
928                              :direction :io)
929  (progn (file-position s :start)
930         (values (read-line s nil)))
931  ("abcdefghij"))
932
933(deftest open.io.28
934  (let ((pn #p"tmp.dat"))
935    (delete-all-versions pn)
936    (open pn :direction :io :if-does-not-exist nil))
937  nil)
938
939(def-open-io-test open.io.28a (:external-format :default)
940  (progn (file-position s :start)
941         (values (read-line s nil)))
942  ("abcdefghij"))
943
944(def-open-io-test open.io.29
945  (:external-format (prog1
946                      (with-open-file (s "foo.dat" :direction :io
947                                         :if-exists :supersede)
948                                      (stream-external-format s))
949                      (delete-all-versions "foo.dat")
950                      ))
951  (progn (file-position s :start)
952         (values (read-line s nil)))
953  ("abcdefghij"))
954
955;;; Default behavior of open :if-exists is :create when the version
956;;; of the filespec is :newest
957
958(deftest open.io.30
959  :notes (:open-if-exists-new-version-no-error)
960  (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest)))
961    (or (not (eql (pathname-version pn) :newest))
962        (progn
963          ;; Create file
964          (let ((s1 (open pn :direction :io :if-exists :overwrite
965                          :if-does-not-exist :create)))
966            (unwind-protect
967                ;; Now try again
968                (let ((s2 (open pn :direction :io)))
969                  (unwind-protect
970                      (write-line "abcdef" s2)
971                    (close s2))
972                  (unwind-protect
973                      (progn
974                        (setq s2 (open s1 :direction :input))
975                        (equalt (read-line s2 nil) "abcdef"))
976                    (close s2)))
977              (close s1)
978              (delete-all-versions pn)
979              )))))
980  t)
981
982(def-open-io-test open.io.31 (:if-exists :rename
983                              :direction :io)
984  (progn (file-position s :start)
985         (values (read-line s nil)))
986  ("abcdefghij"))
987
988(def-open-io-test open.io.32 (:if-exists :rename-and-delete
989                              :direction :io)
990  (progn (file-position s :start)
991         (values (read-line s nil)))
992  ("abcdefghij"))
993
994(def-open-io-test open.io.33 (:if-exists :new-version
995                              :direction :io)
996  (progn (file-position s :start)
997         (values (read-line s nil)))
998  ("abcdefghij"))
999
1000(def-open-io-test open.io.34 (:if-exists :supersede
1001                              :direction :io)
1002  (progn (file-position s :start)
1003         (values (read-line s nil)))
1004  ("abcdefghij"))
1005
1006(def-open-io-test open.io.35 (:if-exists nil
1007                              :direction :io)
1008  (progn (file-position s :start)
1009         (values (read-line s nil)))
1010  ("abcdefghij"))
1011
1012;;;; :PROBE tests
1013
1014(defmacro def-open-probe-test
1015  (name args form
1016        &key (build-form nil build-form-p)
1017        (pathname #p"tmp.dat"))
1018  (unless build-form-p
1019    (setf build-form
1020          `(with-open-file (s pn :direction :output
1021                              :if-exists :supersede))))
1022  `(deftest ,name
1023     (let ((pn ,pathname))
1024       (delete-all-versions pn)
1025       ,build-form
1026       (let ((s (open pn :direction :probe ,@args)))
1027         (values
1028          ,(if build-form
1029               `(and
1030                 (typep s 'file-stream)
1031                 (not (open-stream-p s))
1032                 )
1033             `(not s))
1034          ,form)))
1035     t t))
1036
1037(def-open-probe-test open.probe.1 () t)
1038(def-open-probe-test open.probe.2 (:if-exists :error) t)
1039(def-open-probe-test open.probe.3 (:if-exists :new-version) t)
1040(def-open-probe-test open.probe.4 (:if-exists :rename) t)
1041(def-open-probe-test open.probe.5 (:if-exists :rename-and-delete) t)
1042(def-open-probe-test open.probe.6 (:if-exists :overwrite) t)
1043(def-open-probe-test open.probe.7 (:if-exists :append) t)
1044(def-open-probe-test open.probe.8 (:if-exists :supersede) t)
1045
1046(def-open-probe-test open.probe.9 (:if-does-not-exist :error) t)
1047(def-open-probe-test open.probe.10 (:if-does-not-exist nil) t)
1048(def-open-probe-test open.probe.11 (:if-does-not-exist :create) t)
1049
1050(def-open-probe-test open.probe.12 () t :build-form nil)
1051(def-open-probe-test open.probe.13 (:if-exists :error) t :build-form nil)
1052(def-open-probe-test open.probe.14 (:if-exists :new-version) t :build-form nil)
1053(def-open-probe-test open.probe.15 (:if-exists :rename) t :build-form nil)
1054(def-open-probe-test open.probe.16 (:if-exists :rename-and-delete) t
1055  :build-form nil)
1056(def-open-probe-test open.probe.17 (:if-exists :overwrite) t
1057  :build-form nil)
1058(def-open-probe-test open.probe.18 (:if-exists :append) t
1059  :build-form nil)
1060(def-open-probe-test open.probe.19 (:if-exists :supersede) t
1061  :build-form nil)
1062
1063(def-open-probe-test open.probe.20 (:if-does-not-exist nil) t
1064  :build-form nil)
1065
1066(deftest open.probe.21
1067  (let ((pn #p"tmp.dat"))
1068    (delete-all-versions pn)
1069    (let ((s (open pn :direction :probe :if-does-not-exist :create)))
1070      (values
1071       (notnot s)
1072       (notnot (probe-file pn)))))
1073  t t)
1074
1075(deftest open.probe.22
1076  (let ((pn #p"tmp.dat"))
1077    (delete-all-versions pn)
1078    (let ((s (open pn :direction :probe :if-does-not-exist :create
1079                   :if-exists :error)))
1080      (values
1081       (notnot s)
1082       (notnot (probe-file pn)))))
1083  t t)
1084
1085(def-open-probe-test open.probe.23 (:external-format :default) t)
1086(def-open-probe-test open.probe.24 (:element-type 'character) t)
1087(def-open-probe-test open.probe.25 (:element-type 'bit) t)
1088(def-open-probe-test open.probe.26 (:element-type '(unsigned-byte 2)) t)
1089(def-open-probe-test open.probe.27 (:element-type '(unsigned-byte 4)) t)
1090(def-open-probe-test open.probe.28 (:element-type '(unsigned-byte 8)) t)
1091(def-open-probe-test open.probe.29 (:element-type '(unsigned-byte 9)) t)
1092(def-open-probe-test open.probe.30 (:element-type '(unsigned-byte 15)) t)
1093(def-open-probe-test open.probe.31 (:element-type '(unsigned-byte 16)) t)
1094(def-open-probe-test open.probe.32 (:element-type '(unsigned-byte 17)) t)
1095(def-open-probe-test open.probe.33 (:element-type '(unsigned-byte 31)) t)
1096(def-open-probe-test open.probe.34 (:element-type '(unsigned-byte 32)) t)
1097(def-open-probe-test open.probe.35 (:element-type '(unsigned-byte 33)) t)
1098(def-open-probe-test open.probe.36 (:element-type '(integer -1002 13112)) t)
1099
1100;;;; Error tests
1101
1102(deftest open.error.1
1103  (signals-error (open) program-error)
1104  t)
1105
1106(deftest open.error.2
1107  (signals-error-always
1108   (let ((pn #p"tmp.dat"))
1109     (close (open pn :direction :output :if-does-not-exist :create))
1110     (open pn :if-exists :error :direction :output))
1111   file-error)
1112  t t)
1113
1114(deftest open.error.3
1115  (signals-error-always
1116   (let ((pn #p"tmp.dat"))
1117     (close (open pn :direction :output :if-does-not-exist :create))
1118     (open pn :if-exists :error :direction :io))
1119   file-error)
1120  t t)
1121
1122(deftest open.error.4
1123  (signals-error-always
1124   (let ((pn #p"tmp.dat"))
1125     (delete-all-versions pn)
1126     (open pn))
1127   file-error)
1128  t t)
1129
1130(deftest open.error.5
1131  (signals-error-always
1132   (let ((pn #p"tmp.dat"))
1133     (delete-all-versions pn)
1134     (open pn :if-does-not-exist :error))
1135   file-error)
1136  t t)
1137
1138(deftest open.error.6
1139  (signals-error-always
1140   (let ((pn #p"tmp.dat"))
1141     (delete-all-versions pn)
1142     (open pn :direction :input))
1143   file-error)
1144  t t)
1145
1146(deftest open.error.7
1147  (signals-error-always
1148   (let ((pn #p"tmp.dat"))
1149     (delete-all-versions pn)
1150     (open pn :if-does-not-exist :error :direction :input))
1151   file-error)
1152  t t)
1153
1154(deftest open.error.8
1155  (signals-error-always
1156   (let ((pn #p"tmp.dat"))
1157     (delete-all-versions pn)
1158     (open pn :direction :output :if-does-not-exist :error))
1159   file-error)
1160  t t)
1161
1162(deftest open.error.9
1163  (signals-error-always
1164   (let ((pn #p"tmp.dat"))
1165     (delete-all-versions pn)
1166     (open pn :direction :io :if-does-not-exist :error))
1167   file-error)
1168  t t)
1169
1170(deftest open.error.10
1171  (signals-error-always
1172   (let ((pn #p"tmp.dat"))
1173     (delete-all-versions pn)
1174     (open pn :direction :probe :if-does-not-exist :error))
1175   file-error)
1176  t t)
1177
1178(deftest open.error.11
1179  (signals-error-always
1180   (let ((pn #p"tmp.dat"))
1181     (delete-all-versions pn)
1182     (open pn :direction :output :if-exists :overwrite))
1183   file-error)
1184  t t)
1185
1186(deftest open.error.12
1187  (signals-error-always
1188   (let ((pn #p"tmp.dat"))
1189     (delete-all-versions pn)
1190     (open pn :direction :output :if-exists :append))
1191   file-error)
1192  t t)
1193
1194(deftest open.error.13
1195  (signals-error-always
1196   (let ((pn #p"tmp.dat"))
1197     (delete-all-versions pn)
1198     (open pn :direction :io :if-exists :overwrite))
1199   file-error)
1200  t t)
1201
1202(deftest open.error.14
1203  (signals-error-always
1204   (let ((pn #p"tmp.dat"))
1205     (delete-all-versions pn)
1206     (open pn :direction :io :if-exists :append))
1207   file-error)
1208  t t)
1209
1210(deftest open.error.15
1211  (signals-error-always
1212   (open (make-pathname :name :wild :type "lsp"))
1213   file-error)
1214  t t)
1215
1216(deftest open.error.16
1217  (signals-error-always
1218   (open (make-pathname :name "open" :type :wild))
1219   file-error)
1220  t t)
1221
1222(deftest open.error.17
1223  (signals-error-always
1224   (let ((pn (make-pathname :name "open" :type "lsp" :version :wild)))
1225     (if (wild-pathname-p pn) (open pn)
1226       (error 'file-error)))
1227   file-error)
1228  t t)
1229
1230(deftest open.error.18
1231  (signals-error-always
1232   (open #p"tmp.dat" :direction :output :if-exists :supersede
1233         :external-form (gensym))
1234   error)
1235  t t)
1236
1237
1238;;; FIXME -- add tests for :element-type :default
1239
1240;;; FIXME -- add tests for filespec being a specialized string
Note: See TracBrowser for help on using the repository browser.