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

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

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(def-open-output-test open.output.19 ()
533  (progn (close s) (with-open-file (is #p"tmp.dat"
534                                       :element-type '(unsigned-byte 100))
535                                   (let ((seq (make-array 10)))
536                                     (read-sequence seq is)
537                                     seq)))
538  (#(0 1 2 3 4 5 6 7 8 9))
539  :element-type (unsigned-byte 100))
540
541(deftest open.output.20
542  (let ((pn #p"tmp.dat"))
543    (with-open-file (s pn :direction :output :if-exists :supersede))
544    (open pn :direction :output :if-exists nil))
545  nil)
546
547(def-open-test open.output.21 (:if-exists :new-version :direction :output)
548  (progn (write-sequence "wxyz" s)
549         (close s)
550         (with-open-file
551          (s pn :direction :input)
552          (values (read-line s nil))))
553  ("wxyz")
554  :notes (:open-if-exists-new-version-no-error)
555  )
556
557(def-open-test open.output.22 (:if-exists :rename :direction :output)
558  (progn (write-sequence "wxyz" s)
559         (close s)
560         (with-open-file
561          (s pn :direction :input)
562          (values (read-line s nil))))
563  ("wxyz"))
564
565(def-open-test open.output.23 (:if-exists :rename-and-delete
566                                          :direction :output)
567  (progn (write-sequence "wxyz" s)
568         (close s)
569         (with-open-file
570          (s pn :direction :input)
571          (values (read-line s nil))))
572  ("wxyz"))
573
574(def-open-test open.output.24 (:if-exists :overwrite
575                                          :direction :output)
576  (progn (write-sequence "wxyz" s)
577         (close s)
578         (with-open-file
579          (s pn :direction :input)
580          (values (read-line s nil))))
581  ("wxyzefghij"))
582
583(def-open-test open.output.25 (:if-exists :append
584                                          :direction :output)
585  (progn (write-sequence "wxyz" s)
586         (close s)
587         (with-open-file
588          (s pn :direction :input)
589          (values (read-line s nil))))
590  ("abcdefghijwxyz"))
591
592(def-open-test open.output.26 (:if-exists :supersede
593                                          :direction :output)
594  (progn (write-sequence "wxyz" s)
595         (close s)
596         (with-open-file
597          (s pn :direction :input)
598          (values (read-line s nil))))
599  ("wxyz"))
600
601(def-open-output-test open.output.27 (:if-does-not-exist :create
602                                                         :direction :output)
603  (progn (close s)
604         (with-open-file
605          (is pn :direction :input)
606          (values (read-line is nil))))
607  ("abcdefghij"))
608
609(deftest open.output.28
610  (let ((pn #p"tmp.dat"))
611    (delete-all-versions pn)
612    (open pn :direction :output :if-does-not-exist nil))
613  nil)
614
615(def-open-output-test open.output.28a (:external-format :default)
616  (progn (close s)
617         (with-open-file (is #p"tmp.dat") (values (read-line is nil))))
618  ("abcdefghij"))
619
620(def-open-output-test open.output.29
621  (:external-format (prog1
622                      (with-open-file (s "foo.dat" :direction :output
623                                         :if-exists :supersede)
624                                      (stream-external-format s))
625                      (delete-all-versions "foo.dat")
626                      ))
627  (progn (close s)
628         (with-open-file (is #p"tmp.dat") (values (read-line is nil))))
629  ("abcdefghij"))
630
631;;; Default behavior of open :if-exists is :create when the version
632;;; of the filespec is :newest
633
634(deftest open.output.30
635  :notes (:open-if-exists-new-version-no-error)
636  (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest)))
637    (or (not (eql (pathname-version pn) :newest))
638        (progn
639          ;; Create file
640          (let ((s1 (open pn :direction :output :if-exists :overwrite
641                          :if-does-not-exist :create)))
642            (unwind-protect
643                ;; Now try again
644                (let ((s2 (open pn :direction :output)))
645                  (unwind-protect
646                      (write-line "abcdef" s2)
647                    (close s2))
648                  (unwind-protect
649                      (progn
650                        (setq s2 (open s1 :direction :input))
651                        (equalt (read-line s2 nil) "abcdef"))
652                    (close s2)))
653              (close s1)
654              (delete-all-versions pn)
655              )))))
656  t)
657
658(def-open-output-test open.output.31 (:if-exists :rename
659                                      :direction :output)
660  (progn (close s)
661         (with-open-file
662          (is pn :direction :input)
663          (values (read-line is nil))))
664  ("abcdefghij"))
665
666(def-open-output-test open.output.32 (:if-exists :rename-and-delete
667                                      :direction :output)
668  (progn (close s)
669         (with-open-file
670          (is pn :direction :input)
671          (values (read-line is nil))))
672  ("abcdefghij"))
673
674(def-open-output-test open.output.33 (:if-exists :new-version
675                                      :direction :output)
676  (progn (close s)
677         (with-open-file
678          (is pn :direction :input)
679          (values (read-line is nil))))
680  ("abcdefghij"))
681
682(def-open-output-test open.output.34 (:if-exists :supersede
683                                      :direction :output)
684  (progn (close s)
685         (with-open-file
686          (is pn :direction :input)
687          (values (read-line is nil))))
688  ("abcdefghij"))
689
690(def-open-output-test open.output.35 (:if-exists nil
691                                      :direction :output)
692  (progn (close s)
693         (with-open-file
694          (is pn :direction :input)
695          (values (read-line is nil))))
696  ("abcdefghij"))           
697
698;;; Add -- tests for when the filespec is a stream
699
700
701;;; Tests of bidirectional IO
702
703(defmacro def-open-io-test
704  (name args form expected
705        &rest keyargs
706        &key
707        (element-type 'character)
708        (build-form
709         `(dotimes (i 10)
710            ,(cond
711              ((subtypep element-type 'integer)
712               `(write-byte
713                 (funcall (the function
714                            (generator-for-element-type ',element-type)) i)
715                 s))
716              ((subtypep element-type 'character)
717               `(write-char
718                 (funcall (the function
719                            (generator-for-element-type ',element-type)) i)
720                 s)))))
721        &allow-other-keys)
722  `(def-open-test ,name (:direction :io ,@args)
723     (progn
724       ,build-form
725       (assert (input-stream-p s))
726       (assert (output-stream-p s))
727       ,form)
728     ,expected
729     :build-form nil
730     ,@keyargs))
731
732;; (compile 'def-open-io-test)
733
734(def-open-io-test open.io.1 ()
735  (progn (file-position s :start)
736         (values (read-line s nil)))
737  ("abcdefghij"))
738
739(def-open-io-test open.io.2 ()
740  (progn (file-position s :start)
741         (values (read-line s nil)))
742  ("abcdefghij")
743  :pathname "tmp.dat")
744
745(def-open-io-test open.io.3
746  ()
747  (progn (file-position s :start)
748         (values (read-line s nil)))
749  ("abcdefghij")
750  :pathname (logical-pathname "CLTEST:TMP.DAT"))
751
752(def-open-io-test open.io.4 ()
753  (progn (file-position s :start)
754         (values (read-line s nil)))
755  ("abcdefghij")
756  :element-type character)
757
758(def-open-io-test open.io.5 ()
759  (progn (file-position s :start)
760         (values (read-line s nil)))
761  ("abcdefghij")
762  :element-type base-char)
763
764(def-open-io-test open.io.6 ()
765  (progn (file-position s :start)
766         (let ((seq (make-array 10)))
767           (read-sequence seq s)
768           seq))
769  (#(0 1 0 1 0 1 0 1 0 1))
770  :element-type (integer 0 1))
771
772(def-open-io-test open.io.7 ()
773  (progn (file-position s :start)
774         (let ((seq (make-array 10)))
775           (read-sequence seq s)
776           seq))
777  (#(0 1 0 1 0 1 0 1 0 1))
778  :element-type bit)
779
780(def-open-io-test open.io.8 ()
781  (progn (file-position s :start)
782         (let ((seq (make-array 10)))
783           (read-sequence seq s)
784           seq))
785  (#(0 1 0 1 0 1 0 1 0 1))
786  :element-type (unsigned-byte 1))
787
788(def-open-io-test open.io.9 ()
789  (progn (file-position s :start)
790         (let ((seq (make-array 10)))
791           (read-sequence seq s)
792           seq))
793  (#(0 1 2 3 0 1 2 3 0 1))
794  :element-type (unsigned-byte 2))
795
796(def-open-io-test open.io.10 ()
797  (progn (file-position s :start)
798         (let ((seq (make-array 10)))
799           (read-sequence seq s)
800           seq))
801  (#(0 1 2 3 4 5 6 7 0 1))
802  :element-type (unsigned-byte 3))
803
804(def-open-io-test open.io.11 ()
805  (progn (file-position s :start)
806         (let ((seq (make-array 10)))
807           (read-sequence seq s)
808           seq))
809  (#(0 1 2 3 4 5 6 7 8 9))
810  :element-type (unsigned-byte 4))
811
812
813(def-open-io-test open.io.12 ()
814  (progn (file-position s :start)
815         (let ((seq (make-array 10)))
816           (read-sequence seq s)
817           seq))
818  (#(0 1 2 3 4 5 6 7 8 9))
819  :element-type (unsigned-byte 6))
820
821(def-open-io-test open.io.13 ()
822  (progn (file-position s :start)
823         (let ((seq (make-array 10)))
824           (read-sequence seq s)
825           seq))
826  (#(0 1 2 3 4 5 6 7 8 9))
827  :element-type (unsigned-byte 8))
828
829(def-open-io-test open.io.14 ()
830  (progn (file-position s :start)
831         (let ((seq (make-array 10)))
832           (read-sequence seq s)
833           seq))
834  (#(0 1 2 3 4 5 6 7 8 9))
835  :element-type (unsigned-byte 12))
836
837(def-open-io-test open.io.15 ()
838  (progn (file-position s :start)
839         (let ((seq (make-array 10)))
840           (read-sequence seq s)
841           seq))
842  (#(0 1 2 3 4 5 6 7 8 9))
843  :element-type (unsigned-byte 16))
844
845(def-open-io-test open.io.16 ()
846  (progn (file-position s :start)
847         (let ((seq (make-array 10)))
848           (read-sequence seq s)
849           seq))
850  (#(0 1 2 3 4 5 6 7 8 9))
851  :element-type (unsigned-byte 24))
852
853(def-open-io-test open.io.17 ()
854  (progn (file-position s :start)
855         (let ((seq (make-array 10)))
856           (read-sequence seq s)
857           seq))
858  (#(0 1 2 3 4 5 6 7 8 9))
859  :element-type (unsigned-byte 32))
860
861(def-open-io-test open.io.18 ()
862  (progn (file-position s :start)
863         (let ((seq (make-array 10)))
864           (read-sequence seq s)
865           seq))
866  (#(0 1 2 3 4 5 6 7 8 9))
867  :element-type (unsigned-byte 64))
868
869(def-open-io-test open.io.19 ()
870  (progn (file-position s :start)
871         (let ((seq (make-array 10)))
872           (read-sequence seq s)
873           seq))
874  (#(0 1 2 3 4 5 6 7 8 9))
875  :element-type (unsigned-byte 100))
876
877(deftest open.io.20
878  (let ((pn #p"tmp.dat"))
879    (with-open-file (s pn :direction :io :if-exists :supersede))
880    (open pn :direction :io :if-exists nil))
881  nil)
882
883(def-open-test open.io.21 (:if-exists :new-version :direction :io)
884  (progn (write-sequence "wxyz" s)
885         (file-position s :start)
886         (values (read-line s nil)))
887  ("wxyz")
888  :notes (:open-if-exists-new-version-no-error)
889  )
890
891(def-open-test open.io.22 (:if-exists :rename :direction :io)
892  (progn (write-sequence "wxyz" s)
893         (file-position s :start)
894         (values (read-line s nil)))
895  ("wxyz"))
896
897(def-open-test open.io.23 (:if-exists :rename-and-delete
898                           :direction :io)
899  (progn (write-sequence "wxyz" s)
900         (file-position s :start)
901         (values (read-line s nil)))
902  ("wxyz"))
903
904(def-open-test open.io.24 (:if-exists :overwrite
905                           :direction :io)
906  (progn (write-sequence "wxyz" s)
907         (file-position s :start)
908         (values (read-line s nil)))
909  ("wxyzefghij"))
910
911(def-open-test open.io.25 (:if-exists :append
912                           :direction :io)
913  (progn (write-sequence "wxyz" s)
914         (file-position s :start)
915         (values (read-line s nil)))
916  ("abcdefghijwxyz"))
917
918(def-open-test open.io.26 (:if-exists :supersede
919                           :direction :io)
920  (progn (write-sequence "wxyz" s)
921         (file-position s :start)
922         (values (read-line s nil)))
923  ("wxyz"))
924
925(def-open-io-test open.io.27 (:if-does-not-exist :create
926                              :direction :io)
927  (progn (file-position s :start)
928         (values (read-line s nil)))
929  ("abcdefghij"))
930
931(deftest open.io.28
932  (let ((pn #p"tmp.dat"))
933    (delete-all-versions pn)
934    (open pn :direction :io :if-does-not-exist nil))
935  nil)
936
937(def-open-io-test open.io.28a (:external-format :default)
938  (progn (file-position s :start)
939         (values (read-line s nil)))
940  ("abcdefghij"))
941
942(def-open-io-test open.io.29
943  (:external-format (prog1
944                      (with-open-file (s "foo.dat" :direction :io
945                                         :if-exists :supersede)
946                                      (stream-external-format s))
947                      (delete-all-versions "foo.dat")
948                      ))
949  (progn (file-position s :start)
950         (values (read-line s nil)))
951  ("abcdefghij"))
952
953;;; Default behavior of open :if-exists is :create when the version
954;;; of the filespec is :newest
955
956(deftest open.io.30
957  :notes (:open-if-exists-new-version-no-error)
958  (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest)))
959    (or (not (eql (pathname-version pn) :newest))
960        (progn
961          ;; Create file
962          (let ((s1 (open pn :direction :io :if-exists :overwrite
963                          :if-does-not-exist :create)))
964            (unwind-protect
965                ;; Now try again
966                (let ((s2 (open pn :direction :io)))
967                  (unwind-protect
968                      (write-line "abcdef" s2)
969                    (close s2))
970                  (unwind-protect
971                      (progn
972                        (setq s2 (open s1 :direction :input))
973                        (equalt (read-line s2 nil) "abcdef"))
974                    (close s2)))
975              (close s1)
976              (delete-all-versions pn)
977              )))))
978  t)
979
980(def-open-io-test open.io.31 (:if-exists :rename
981                              :direction :io)
982  (progn (file-position s :start)
983         (values (read-line s nil)))
984  ("abcdefghij"))
985
986(def-open-io-test open.io.32 (:if-exists :rename-and-delete
987                              :direction :io)
988  (progn (file-position s :start)
989         (values (read-line s nil)))
990  ("abcdefghij"))
991
992(def-open-io-test open.io.33 (:if-exists :new-version
993                              :direction :io)
994  (progn (file-position s :start)
995         (values (read-line s nil)))
996  ("abcdefghij"))
997
998(def-open-io-test open.io.34 (:if-exists :supersede
999                              :direction :io)
1000  (progn (file-position s :start)
1001         (values (read-line s nil)))
1002  ("abcdefghij"))
1003
1004(def-open-io-test open.io.35 (:if-exists nil
1005                              :direction :io)
1006  (progn (file-position s :start)
1007         (values (read-line s nil)))
1008  ("abcdefghij"))
1009
1010;;;; :PROBE tests
1011
1012(defmacro def-open-probe-test
1013  (name args form
1014        &key (build-form nil build-form-p)
1015        (pathname #p"tmp.dat"))
1016  (unless build-form-p
1017    (setf build-form
1018          `(with-open-file (s pn :direction :output
1019                              :if-exists :supersede))))
1020  `(deftest ,name
1021     (let ((pn ,pathname))
1022       (delete-all-versions pn)
1023       ,build-form
1024       (let ((s (open pn :direction :probe ,@args)))
1025         (values
1026          ,(if build-form
1027               `(and
1028                 (typep s 'file-stream)
1029                 (not (open-stream-p s))
1030                 )
1031             `(not s))
1032          ,form)))
1033     t t))
1034
1035(def-open-probe-test open.probe.1 () t)
1036(def-open-probe-test open.probe.2 (:if-exists :error) t)
1037(def-open-probe-test open.probe.3 (:if-exists :new-version) t)
1038(def-open-probe-test open.probe.4 (:if-exists :rename) t)
1039(def-open-probe-test open.probe.5 (:if-exists :rename-and-delete) t)
1040(def-open-probe-test open.probe.6 (:if-exists :overwrite) t)
1041(def-open-probe-test open.probe.7 (:if-exists :append) t)
1042(def-open-probe-test open.probe.8 (:if-exists :supersede) t)
1043
1044(def-open-probe-test open.probe.9 (:if-does-not-exist :error) t)
1045(def-open-probe-test open.probe.10 (:if-does-not-exist nil) t)
1046(def-open-probe-test open.probe.11 (:if-does-not-exist :create) t)
1047
1048(def-open-probe-test open.probe.12 () t :build-form nil)
1049(def-open-probe-test open.probe.13 (:if-exists :error) t :build-form nil)
1050(def-open-probe-test open.probe.14 (:if-exists :new-version) t :build-form nil)
1051(def-open-probe-test open.probe.15 (:if-exists :rename) t :build-form nil)
1052(def-open-probe-test open.probe.16 (:if-exists :rename-and-delete) t
1053  :build-form nil)
1054(def-open-probe-test open.probe.17 (:if-exists :overwrite) t
1055  :build-form nil)
1056(def-open-probe-test open.probe.18 (:if-exists :append) t
1057  :build-form nil)
1058(def-open-probe-test open.probe.19 (:if-exists :supersede) t
1059  :build-form nil)
1060
1061(def-open-probe-test open.probe.20 (:if-does-not-exist nil) t
1062  :build-form nil)
1063
1064(deftest open.probe.21
1065  (let ((pn #p"tmp.dat"))
1066    (delete-all-versions pn)
1067    (let ((s (open pn :direction :probe :if-does-not-exist :create)))
1068      (values
1069       (notnot s)
1070       (notnot (probe-file pn)))))
1071  t t)
1072
1073(deftest open.probe.22
1074  (let ((pn #p"tmp.dat"))
1075    (delete-all-versions pn)
1076    (let ((s (open pn :direction :probe :if-does-not-exist :create
1077                   :if-exists :error)))
1078      (values
1079       (notnot s)
1080       (notnot (probe-file pn)))))
1081  t t)
1082
1083(def-open-probe-test open.probe.23 (:external-format :default) t)
1084(def-open-probe-test open.probe.24 (:element-type 'character) t)
1085(def-open-probe-test open.probe.25 (:element-type 'bit) t)
1086(def-open-probe-test open.probe.26 (:element-type '(unsigned-byte 2)) t)
1087(def-open-probe-test open.probe.27 (:element-type '(unsigned-byte 4)) t)
1088(def-open-probe-test open.probe.28 (:element-type '(unsigned-byte 8)) t)
1089(def-open-probe-test open.probe.29 (:element-type '(unsigned-byte 9)) t)
1090(def-open-probe-test open.probe.30 (:element-type '(unsigned-byte 15)) t)
1091(def-open-probe-test open.probe.31 (:element-type '(unsigned-byte 16)) t)
1092(def-open-probe-test open.probe.32 (:element-type '(unsigned-byte 17)) t)
1093(def-open-probe-test open.probe.33 (:element-type '(unsigned-byte 31)) t)
1094(def-open-probe-test open.probe.34 (:element-type '(unsigned-byte 32)) t)
1095(def-open-probe-test open.probe.35 (:element-type '(unsigned-byte 33)) t)
1096(def-open-probe-test open.probe.36 (:element-type '(integer -1002 13112)) t)
1097
1098;;;; Error tests
1099
1100(deftest open.error.1
1101  (signals-error (open) program-error)
1102  t)
1103
1104(deftest open.error.2
1105  (signals-error-always
1106   (let ((pn #p"tmp.dat"))
1107     (close (open pn :direction :output :if-does-not-exist :create))
1108     (open pn :if-exists :error :direction :output))
1109   file-error)
1110  t t)
1111
1112(deftest open.error.3
1113  (signals-error-always
1114   (let ((pn #p"tmp.dat"))
1115     (close (open pn :direction :output :if-does-not-exist :create))
1116     (open pn :if-exists :error :direction :io))
1117   file-error)
1118  t t)
1119
1120(deftest open.error.4
1121  (signals-error-always
1122   (let ((pn #p"tmp.dat"))
1123     (delete-all-versions pn)
1124     (open pn))
1125   file-error)
1126  t t)
1127
1128(deftest open.error.5
1129  (signals-error-always
1130   (let ((pn #p"tmp.dat"))
1131     (delete-all-versions pn)
1132     (open pn :if-does-not-exist :error))
1133   file-error)
1134  t t)
1135
1136(deftest open.error.6
1137  (signals-error-always
1138   (let ((pn #p"tmp.dat"))
1139     (delete-all-versions pn)
1140     (open pn :direction :input))
1141   file-error)
1142  t t)
1143
1144(deftest open.error.7
1145  (signals-error-always
1146   (let ((pn #p"tmp.dat"))
1147     (delete-all-versions pn)
1148     (open pn :if-does-not-exist :error :direction :input))
1149   file-error)
1150  t t)
1151
1152(deftest open.error.8
1153  (signals-error-always
1154   (let ((pn #p"tmp.dat"))
1155     (delete-all-versions pn)
1156     (open pn :direction :output :if-does-not-exist :error))
1157   file-error)
1158  t t)
1159
1160(deftest open.error.9
1161  (signals-error-always
1162   (let ((pn #p"tmp.dat"))
1163     (delete-all-versions pn)
1164     (open pn :direction :io :if-does-not-exist :error))
1165   file-error)
1166  t t)
1167
1168(deftest open.error.10
1169  (signals-error-always
1170   (let ((pn #p"tmp.dat"))
1171     (delete-all-versions pn)
1172     (open pn :direction :probe :if-does-not-exist :error))
1173   file-error)
1174  t t)
1175
1176(deftest open.error.11
1177  (signals-error-always
1178   (let ((pn #p"tmp.dat"))
1179     (delete-all-versions pn)
1180     (open pn :direction :output :if-exists :overwrite))
1181   file-error)
1182  t t)
1183
1184(deftest open.error.12
1185  (signals-error-always
1186   (let ((pn #p"tmp.dat"))
1187     (delete-all-versions pn)
1188     (open pn :direction :output :if-exists :append))
1189   file-error)
1190  t t)
1191
1192(deftest open.error.13
1193  (signals-error-always
1194   (let ((pn #p"tmp.dat"))
1195     (delete-all-versions pn)
1196     (open pn :direction :io :if-exists :overwrite))
1197   file-error)
1198  t t)
1199
1200(deftest open.error.14
1201  (signals-error-always
1202   (let ((pn #p"tmp.dat"))
1203     (delete-all-versions pn)
1204     (open pn :direction :io :if-exists :append))
1205   file-error)
1206  t t)
1207
1208(deftest open.error.15
1209  (signals-error-always
1210   (open (make-pathname :name :wild :type "lsp"))
1211   file-error)
1212  t t)
1213
1214(deftest open.error.16
1215  (signals-error-always
1216   (open (make-pathname :name "open" :type :wild))
1217   file-error)
1218  t t)
1219
1220(deftest open.error.17
1221  (signals-error-always
1222   (let ((pn (make-pathname :name "open" :type "lsp" :version :wild)))
1223     (if (wild-pathname-p pn) (open pn)
1224       (error 'file-error)))
1225   file-error)
1226  t t)
1227
1228(deftest open.error.18
1229  (signals-error-always
1230   (open #p"tmp.dat" :direction :output :if-exists :supersede
1231         :external-form (gensym))
1232   error)
1233  t t)
1234
1235
1236;;; FIXME -- add tests for :element-type :default
1237
1238;;; FIXME -- add tests for filespec being a specialized string
Note: See TracBrowser for help on using the repository browser.