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

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

Assorted cleanup:

In infrastructure:

  • add *test-verbose* and :verbose argument to do-test and do-tests. Avoid random output if false, only show failures
  • muffle-wawrnings and/or bind *suppress-compiler-warnings* in some tests that unavoidably generate them (mainly with duplicate typecase/case clauses)
  • Add record-source-file for tests so meta-. can find them
  • If *catch-errors* (or the :catch-errors arg) is :break, enter a breakloop when catch an error
  • Make test fns created by *compile-tests* have names, so can find them in backtraces
  • fix misc compiler warnings
  • Fixed cases of duplicate test numbers
  • Disable note :make-condition-with-compound-name for openmcl.

In tests themselves:

I commented out the following tests with #+bogus-test, because they just seemed wrong to me:

lambda.47
lambda.50
upgraded-array-element-type.8
upgraded-array-element-type.nil.1
pathname-match-p.5
load.17
load.18
macrolet.47
ctypecase.15

In addition, I commented out the following tests with #+bogus-test because I was too lazy to make a note
for "doesn't signal underflow":

exp.error.8 exp.error.9 exp.error.10 exp.error.11 expt.error.8 expt.error.9 expt.error.10 expt.error.11

Finally, I entered bug reports in trac, and then commented out the tests
below with #+known-bug-NNN, where nnn is the ticket number in trac:

ticket#268: encode-universal-time.3 encode-universal-time.3.1
ticket#269: macrolet.36
ticket#270: values.20 values.21
ticket#271: defclass.error.13 defclass.error.22
ticket#272: phase.10 phase.12 asin.5 asin.6 asin.8
ticket#273: phase.18 phase.19 acos.8
ticket#274: exp.error.4 exp.error.5 exp.error.6 exp.error.7
ticket#275: car.error.2 cdr.error.2
ticket#276: map.error.11
ticket#277: subtypep.cons.43
ticket#278: subtypep-function.3
ticket#279: subtypep-complex.8
ticket#280: open.output.19 open.io.19 file-position.8 file-length.4 file-length.5 read-byte.4 stream-element-type.2 stream-element-type.3
ticket#281: open.65
ticket#288: set-syntax-from-char.sharp.1

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#+known-bug-281
288(deftest open.65
289  (let ((type '(or (integer 0 1) (integer 100 200)))
290        (pn #p"tmp.dat")
291        (vals '(0 1 100 120 130 190 200 1 0 150)))
292    (or
293     (not (subtypep type 'integer))
294     (progn
295       (with-open-file
296        (os pn :direction :output
297            :element-type type
298            :if-exists :supersede)
299        (dolist (e vals) (write-byte e os)))
300       (let ((s (open pn :direction :input
301                      :element-type type))
302             (seq (make-array 10)))
303         (unwind-protect
304             (progn (read-sequence seq s) seq)
305           (close s))
306         (notnot (every #'eql seq vals))))))
307  t)
308
309;;; FIXME: Add -- tests for when the filespec is a stream
310
311(deftest open.66
312  (let ((pn #p"tmp.dat"))
313    (delete-all-versions pn)
314    (with-open-file
315     (s pn :direction :io :if-exists :rename-and-delete
316        :if-does-not-exist :create)
317     (format s "some stuff~%")
318     (finish-output s)
319     (let ((is (open s :direction :input)))
320       (unwind-protect
321           (values
322            (read-char is)
323            (notnot (file-position s :start))
324            (read-line is)
325            (read-line s))
326         (close is)))))
327  #\s
328  t
329  "ome stuff"
330  "some stuff")
331
332(deftest open.67
333  (let ((pn #p"tmp.dat"))
334    (delete-all-versions pn)
335    (let ((s (open pn :direction :output)))
336      (unwind-protect
337          (progn
338            (format s "some stuff~%")
339            (finish-output s)
340            (close s)
341            (let ((is (open s :direction :input)))
342              (unwind-protect
343                  (values (read-line is))
344                (close is))))
345        (when (open-stream-p s) (close s)))))
346  "some stuff")
347
348;;; FIXME: Add -- tests for when element-type is :default
349
350;;; Tests of file creation
351
352(defmacro def-open-output-test
353  (name args form expected
354        &rest keyargs
355        &key
356        (element-type 'character)
357        (build-form
358         `(dotimes (i 10)
359            ,(cond
360              ((subtypep element-type 'integer)
361               `(write-byte
362                 (funcall (the function
363                            (generator-for-element-type ',element-type)) i)
364                 s))
365              ((subtypep element-type 'character)
366               `(write-char
367                 (funcall (the function
368                            (generator-for-element-type ',element-type)) i)
369                 s)))))
370        &allow-other-keys)
371  `(def-open-test ,name (:direction :output ,@args)
372     (progn
373       ,build-form
374       (assert (output-stream-p s))
375       ,form)
376     ,expected
377     :build-form nil
378     ,@keyargs))
379
380;; (compile 'def-open-output-test)
381
382(def-open-output-test open.output.1 ()
383  (progn (close s)
384         (with-open-file (is #p"tmp.dat") (values (read-line is nil))))
385  ("abcdefghij"))
386
387(def-open-output-test open.output.2 ()
388  (progn (close s)
389         (with-open-file (is "tmp.dat") (values (read-line is nil))))
390  ("abcdefghij")
391  :pathname "tmp.dat")
392
393(def-open-output-test open.output.3
394  ()
395  (progn (close s)
396         (with-open-file (is (logical-pathname "CLTEST:TMP.DAT"))
397                         (values (read-line is nil))))
398  ("abcdefghij")
399  :pathname (logical-pathname "CLTEST:TMP.DAT"))
400
401(def-open-output-test open.output.4 ()
402  (progn (close s)
403         (with-open-file (is #p"tmp.dat" :element-type 'character)
404                         (values (read-line is nil))))
405  ("abcdefghij")
406  :element-type character)
407
408(def-open-output-test open.output.5 ()
409  (progn (close s) (with-open-file (is #p"tmp.dat"
410                                       :element-type 'base-char)
411                                   (values (read-line is nil))))
412  ("abcdefghij")
413  :element-type base-char)
414
415(def-open-output-test open.output.6 ()
416  (progn (close s) (with-open-file (is #p"tmp.dat"
417                                       :element-type '(integer 0 1))
418                                   (let ((seq (make-array 10)))
419                                     (read-sequence seq is)
420                                     seq)))
421  (#(0 1 0 1 0 1 0 1 0 1))
422  :element-type (integer 0 1))
423
424(def-open-output-test open.output.7 ()
425  (progn (close s) (with-open-file (is #p"tmp.dat"
426                                       :element-type 'bit)
427                                   (let ((seq (make-array 10)))
428                                     (read-sequence seq is)
429                                     seq)))
430  (#(0 1 0 1 0 1 0 1 0 1))
431  :element-type bit)
432
433(def-open-output-test open.output.8 ()
434  (progn (close s) (with-open-file (is #p"tmp.dat"
435                                       :element-type '(unsigned-byte 1))
436                                   (let ((seq (make-array 10)))
437                                     (read-sequence seq is)
438                                     seq)))
439  (#(0 1 0 1 0 1 0 1 0 1))
440  :element-type (unsigned-byte 1))
441
442(def-open-output-test open.output.9 ()
443  (progn (close s) (with-open-file (is #p"tmp.dat"
444                                       :element-type '(unsigned-byte 2))
445                                   (let ((seq (make-array 10)))
446                                     (read-sequence seq is)
447                                     seq)))
448  (#(0 1 2 3 0 1 2 3 0 1))
449  :element-type (unsigned-byte 2))
450
451(def-open-output-test open.output.10 ()
452  (progn (close s) (with-open-file (is #p"tmp.dat"
453                                       :element-type '(unsigned-byte 3))
454                                   (let ((seq (make-array 10)))
455                                     (read-sequence seq is)
456                                     seq)))
457  (#(0 1 2 3 4 5 6 7 0 1))
458  :element-type (unsigned-byte 3))
459
460(def-open-output-test open.output.11 ()
461  (progn (close s) (with-open-file (is #p"tmp.dat"
462                                       :element-type '(unsigned-byte 4))
463                                   (let ((seq (make-array 10)))
464                                     (read-sequence seq is)
465                                     seq)))
466  (#(0 1 2 3 4 5 6 7 8 9))
467  :element-type (unsigned-byte 4))
468
469
470(def-open-output-test open.output.12 ()
471  (progn (close s) (with-open-file (is #p"tmp.dat"
472                                       :element-type '(unsigned-byte 6))
473                                   (let ((seq (make-array 10)))
474                                     (read-sequence seq is)
475                                     seq)))
476  (#(0 1 2 3 4 5 6 7 8 9))
477  :element-type (unsigned-byte 6))
478
479(def-open-output-test open.output.13 ()
480  (progn (close s) (with-open-file (is #p"tmp.dat"
481                                       :element-type '(unsigned-byte 8))
482                                   (let ((seq (make-array 10)))
483                                     (read-sequence seq is)
484                                     seq)))
485  (#(0 1 2 3 4 5 6 7 8 9))
486  :element-type (unsigned-byte 8))
487
488(def-open-output-test open.output.14 ()
489  (progn (close s) (with-open-file (is #p"tmp.dat"
490                                       :element-type '(unsigned-byte 12))
491                                   (let ((seq (make-array 10)))
492                                     (read-sequence seq is)
493                                     seq)))
494  (#(0 1 2 3 4 5 6 7 8 9))
495  :element-type (unsigned-byte 12))
496
497(def-open-output-test open.output.15 ()
498  (progn (close s) (with-open-file (is #p"tmp.dat"
499                                       :element-type '(unsigned-byte 16))
500                                   (let ((seq (make-array 10)))
501                                     (read-sequence seq is)
502                                     seq)))
503  (#(0 1 2 3 4 5 6 7 8 9))
504  :element-type (unsigned-byte 16))
505
506(def-open-output-test open.output.16 ()
507  (progn (close s) (with-open-file (is #p"tmp.dat"
508                                       :element-type '(unsigned-byte 24))
509                                   (let ((seq (make-array 10)))
510                                     (read-sequence seq is)
511                                     seq)))
512  (#(0 1 2 3 4 5 6 7 8 9))
513  :element-type (unsigned-byte 24))
514
515(def-open-output-test open.output.17 ()
516  (progn (close s) (with-open-file (is #p"tmp.dat"
517                                       :element-type '(unsigned-byte 32))
518                                   (let ((seq (make-array 10)))
519                                     (read-sequence seq is)
520                                     seq)))
521  (#(0 1 2 3 4 5 6 7 8 9))
522  :element-type (unsigned-byte 32))
523
524(def-open-output-test open.output.18 ()
525  (progn (close s) (with-open-file (is #p"tmp.dat"
526                                       :element-type '(unsigned-byte 64))
527                                   (let ((seq (make-array 10)))
528                                     (read-sequence seq is)
529                                     seq)))
530  (#(0 1 2 3 4 5 6 7 8 9))
531  :element-type (unsigned-byte 64))
532
533#+known-bug-280
534(def-open-output-test open.output.19 ()
535  (progn (close s) (with-open-file (is #p"tmp.dat"
536                                       :element-type '(unsigned-byte 100))
537                                   (let ((seq (make-array 10)))
538                                     (read-sequence seq is)
539                                     seq)))
540  (#(0 1 2 3 4 5 6 7 8 9))
541  :element-type (unsigned-byte 100))
542
543(deftest open.output.20
544  (let ((pn #p"tmp.dat"))
545    (with-open-file (s pn :direction :output :if-exists :supersede))
546    (open pn :direction :output :if-exists nil))
547  nil)
548
549(def-open-test open.output.21 (:if-exists :new-version :direction :output)
550  (progn (write-sequence "wxyz" s)
551         (close s)
552         (with-open-file
553          (s pn :direction :input)
554          (values (read-line s nil))))
555  ("wxyz")
556  :notes (:open-if-exists-new-version-no-error)
557  )
558
559(def-open-test open.output.22 (:if-exists :rename :direction :output)
560  (progn (write-sequence "wxyz" s)
561         (close s)
562         (with-open-file
563          (s pn :direction :input)
564          (values (read-line s nil))))
565  ("wxyz"))
566
567(def-open-test open.output.23 (:if-exists :rename-and-delete
568                                          :direction :output)
569  (progn (write-sequence "wxyz" s)
570         (close s)
571         (with-open-file
572          (s pn :direction :input)
573          (values (read-line s nil))))
574  ("wxyz"))
575
576(def-open-test open.output.24 (:if-exists :overwrite
577                                          :direction :output)
578  (progn (write-sequence "wxyz" s)
579         (close s)
580         (with-open-file
581          (s pn :direction :input)
582          (values (read-line s nil))))
583  ("wxyzefghij"))
584
585(def-open-test open.output.25 (:if-exists :append
586                                          :direction :output)
587  (progn (write-sequence "wxyz" s)
588         (close s)
589         (with-open-file
590          (s pn :direction :input)
591          (values (read-line s nil))))
592  ("abcdefghijwxyz"))
593
594(def-open-test open.output.26 (:if-exists :supersede
595                                          :direction :output)
596  (progn (write-sequence "wxyz" s)
597         (close s)
598         (with-open-file
599          (s pn :direction :input)
600          (values (read-line s nil))))
601  ("wxyz"))
602
603(def-open-output-test open.output.27 (:if-does-not-exist :create
604                                                         :direction :output)
605  (progn (close s)
606         (with-open-file
607          (is pn :direction :input)
608          (values (read-line is nil))))
609  ("abcdefghij"))
610
611(deftest open.output.28
612  (let ((pn #p"tmp.dat"))
613    (delete-all-versions pn)
614    (open pn :direction :output :if-does-not-exist nil))
615  nil)
616
617(def-open-output-test open.output.28a (:external-format :default)
618  (progn (close s)
619         (with-open-file (is #p"tmp.dat") (values (read-line is nil))))
620  ("abcdefghij"))
621
622(def-open-output-test open.output.29
623  (:external-format (prog1
624                      (with-open-file (s "foo.dat" :direction :output
625                                         :if-exists :supersede)
626                                      (stream-external-format s))
627                      (delete-all-versions "foo.dat")
628                      ))
629  (progn (close s)
630         (with-open-file (is #p"tmp.dat") (values (read-line is nil))))
631  ("abcdefghij"))
632
633;;; Default behavior of open :if-exists is :create when the version
634;;; of the filespec is :newest
635
636(deftest open.output.30
637  :notes (:open-if-exists-new-version-no-error)
638  (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest)))
639    (or (not (eql (pathname-version pn) :newest))
640        (progn
641          ;; Create file
642          (let ((s1 (open pn :direction :output :if-exists :overwrite
643                          :if-does-not-exist :create)))
644            (unwind-protect
645                ;; Now try again
646                (let ((s2 (open pn :direction :output)))
647                  (unwind-protect
648                      (write-line "abcdef" s2)
649                    (close s2))
650                  (unwind-protect
651                      (progn
652                        (setq s2 (open s1 :direction :input))
653                        (equalt (read-line s2 nil) "abcdef"))
654                    (close s2)))
655              (close s1)
656              (delete-all-versions pn)
657              )))))
658  t)
659
660(def-open-output-test open.output.31 (:if-exists :rename
661                                      :direction :output)
662  (progn (close s)
663         (with-open-file
664          (is pn :direction :input)
665          (values (read-line is nil))))
666  ("abcdefghij"))
667
668(def-open-output-test open.output.32 (:if-exists :rename-and-delete
669                                      :direction :output)
670  (progn (close s)
671         (with-open-file
672          (is pn :direction :input)
673          (values (read-line is nil))))
674  ("abcdefghij"))
675
676(def-open-output-test open.output.33 (:if-exists :new-version
677                                      :direction :output)
678  (progn (close s)
679         (with-open-file
680          (is pn :direction :input)
681          (values (read-line is nil))))
682  ("abcdefghij"))
683
684(def-open-output-test open.output.34 (:if-exists :supersede
685                                      :direction :output)
686  (progn (close s)
687         (with-open-file
688          (is pn :direction :input)
689          (values (read-line is nil))))
690  ("abcdefghij"))
691
692(def-open-output-test open.output.35 (:if-exists nil
693                                      :direction :output)
694  (progn (close s)
695         (with-open-file
696          (is pn :direction :input)
697          (values (read-line is nil))))
698  ("abcdefghij"))           
699
700;;; Add -- tests for when the filespec is a stream
701
702
703;;; Tests of bidirectional IO
704
705(defmacro def-open-io-test
706  (name args form expected
707        &rest keyargs
708        &key
709        (element-type 'character)
710        (build-form
711         `(dotimes (i 10)
712            ,(cond
713              ((subtypep element-type 'integer)
714               `(write-byte
715                 (funcall (the function
716                            (generator-for-element-type ',element-type)) i)
717                 s))
718              ((subtypep element-type 'character)
719               `(write-char
720                 (funcall (the function
721                            (generator-for-element-type ',element-type)) i)
722                 s)))))
723        &allow-other-keys)
724  `(def-open-test ,name (:direction :io ,@args)
725     (progn
726       ,build-form
727       (assert (input-stream-p s))
728       (assert (output-stream-p s))
729       ,form)
730     ,expected
731     :build-form nil
732     ,@keyargs))
733
734;; (compile 'def-open-io-test)
735
736(def-open-io-test open.io.1 ()
737  (progn (file-position s :start)
738         (values (read-line s nil)))
739  ("abcdefghij"))
740
741(def-open-io-test open.io.2 ()
742  (progn (file-position s :start)
743         (values (read-line s nil)))
744  ("abcdefghij")
745  :pathname "tmp.dat")
746
747(def-open-io-test open.io.3
748  ()
749  (progn (file-position s :start)
750         (values (read-line s nil)))
751  ("abcdefghij")
752  :pathname (logical-pathname "CLTEST:TMP.DAT"))
753
754(def-open-io-test open.io.4 ()
755  (progn (file-position s :start)
756         (values (read-line s nil)))
757  ("abcdefghij")
758  :element-type character)
759
760(def-open-io-test open.io.5 ()
761  (progn (file-position s :start)
762         (values (read-line s nil)))
763  ("abcdefghij")
764  :element-type base-char)
765
766(def-open-io-test open.io.6 ()
767  (progn (file-position s :start)
768         (let ((seq (make-array 10)))
769           (read-sequence seq s)
770           seq))
771  (#(0 1 0 1 0 1 0 1 0 1))
772  :element-type (integer 0 1))
773
774(def-open-io-test open.io.7 ()
775  (progn (file-position s :start)
776         (let ((seq (make-array 10)))
777           (read-sequence seq s)
778           seq))
779  (#(0 1 0 1 0 1 0 1 0 1))
780  :element-type bit)
781
782(def-open-io-test open.io.8 ()
783  (progn (file-position s :start)
784         (let ((seq (make-array 10)))
785           (read-sequence seq s)
786           seq))
787  (#(0 1 0 1 0 1 0 1 0 1))
788  :element-type (unsigned-byte 1))
789
790(def-open-io-test open.io.9 ()
791  (progn (file-position s :start)
792         (let ((seq (make-array 10)))
793           (read-sequence seq s)
794           seq))
795  (#(0 1 2 3 0 1 2 3 0 1))
796  :element-type (unsigned-byte 2))
797
798(def-open-io-test open.io.10 ()
799  (progn (file-position s :start)
800         (let ((seq (make-array 10)))
801           (read-sequence seq s)
802           seq))
803  (#(0 1 2 3 4 5 6 7 0 1))
804  :element-type (unsigned-byte 3))
805
806(def-open-io-test open.io.11 ()
807  (progn (file-position s :start)
808         (let ((seq (make-array 10)))
809           (read-sequence seq s)
810           seq))
811  (#(0 1 2 3 4 5 6 7 8 9))
812  :element-type (unsigned-byte 4))
813
814
815(def-open-io-test open.io.12 ()
816  (progn (file-position s :start)
817         (let ((seq (make-array 10)))
818           (read-sequence seq s)
819           seq))
820  (#(0 1 2 3 4 5 6 7 8 9))
821  :element-type (unsigned-byte 6))
822
823(def-open-io-test open.io.13 ()
824  (progn (file-position s :start)
825         (let ((seq (make-array 10)))
826           (read-sequence seq s)
827           seq))
828  (#(0 1 2 3 4 5 6 7 8 9))
829  :element-type (unsigned-byte 8))
830
831(def-open-io-test open.io.14 ()
832  (progn (file-position s :start)
833         (let ((seq (make-array 10)))
834           (read-sequence seq s)
835           seq))
836  (#(0 1 2 3 4 5 6 7 8 9))
837  :element-type (unsigned-byte 12))
838
839(def-open-io-test open.io.15 ()
840  (progn (file-position s :start)
841         (let ((seq (make-array 10)))
842           (read-sequence seq s)
843           seq))
844  (#(0 1 2 3 4 5 6 7 8 9))
845  :element-type (unsigned-byte 16))
846
847(def-open-io-test open.io.16 ()
848  (progn (file-position s :start)
849         (let ((seq (make-array 10)))
850           (read-sequence seq s)
851           seq))
852  (#(0 1 2 3 4 5 6 7 8 9))
853  :element-type (unsigned-byte 24))
854
855(def-open-io-test open.io.17 ()
856  (progn (file-position s :start)
857         (let ((seq (make-array 10)))
858           (read-sequence seq s)
859           seq))
860  (#(0 1 2 3 4 5 6 7 8 9))
861  :element-type (unsigned-byte 32))
862
863(def-open-io-test open.io.18 ()
864  (progn (file-position s :start)
865         (let ((seq (make-array 10)))
866           (read-sequence seq s)
867           seq))
868  (#(0 1 2 3 4 5 6 7 8 9))
869  :element-type (unsigned-byte 64))
870
871#+known-bug-280
872(def-open-io-test open.io.19 ()
873  (progn (file-position s :start)
874         (let ((seq (make-array 10)))
875           (read-sequence seq s)
876           seq))
877  (#(0 1 2 3 4 5 6 7 8 9))
878  :element-type (unsigned-byte 100))
879
880(deftest open.io.20
881  (let ((pn #p"tmp.dat"))
882    (with-open-file (s pn :direction :io :if-exists :supersede))
883    (open pn :direction :io :if-exists nil))
884  nil)
885
886(def-open-test open.io.21 (:if-exists :new-version :direction :io)
887  (progn (write-sequence "wxyz" s)
888         (file-position s :start)
889         (values (read-line s nil)))
890  ("wxyz")
891  :notes (:open-if-exists-new-version-no-error)
892  )
893
894(def-open-test open.io.22 (:if-exists :rename :direction :io)
895  (progn (write-sequence "wxyz" s)
896         (file-position s :start)
897         (values (read-line s nil)))
898  ("wxyz"))
899
900(def-open-test open.io.23 (:if-exists :rename-and-delete
901                           :direction :io)
902  (progn (write-sequence "wxyz" s)
903         (file-position s :start)
904         (values (read-line s nil)))
905  ("wxyz"))
906
907(def-open-test open.io.24 (:if-exists :overwrite
908                           :direction :io)
909  (progn (write-sequence "wxyz" s)
910         (file-position s :start)
911         (values (read-line s nil)))
912  ("wxyzefghij"))
913
914(def-open-test open.io.25 (:if-exists :append
915                           :direction :io)
916  (progn (write-sequence "wxyz" s)
917         (file-position s :start)
918         (values (read-line s nil)))
919  ("abcdefghijwxyz"))
920
921(def-open-test open.io.26 (:if-exists :supersede
922                           :direction :io)
923  (progn (write-sequence "wxyz" s)
924         (file-position s :start)
925         (values (read-line s nil)))
926  ("wxyz"))
927
928(def-open-io-test open.io.27 (:if-does-not-exist :create
929                              :direction :io)
930  (progn (file-position s :start)
931         (values (read-line s nil)))
932  ("abcdefghij"))
933
934(deftest open.io.28
935  (let ((pn #p"tmp.dat"))
936    (delete-all-versions pn)
937    (open pn :direction :io :if-does-not-exist nil))
938  nil)
939
940(def-open-io-test open.io.28a (:external-format :default)
941  (progn (file-position s :start)
942         (values (read-line s nil)))
943  ("abcdefghij"))
944
945(def-open-io-test open.io.29
946  (:external-format (prog1
947                      (with-open-file (s "foo.dat" :direction :io
948                                         :if-exists :supersede)
949                                      (stream-external-format s))
950                      (delete-all-versions "foo.dat")
951                      ))
952  (progn (file-position s :start)
953         (values (read-line s nil)))
954  ("abcdefghij"))
955
956;;; Default behavior of open :if-exists is :create when the version
957;;; of the filespec is :newest
958
959(deftest open.io.30
960  :notes (:open-if-exists-new-version-no-error)
961  (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest)))
962    (or (not (eql (pathname-version pn) :newest))
963        (progn
964          ;; Create file
965          (let ((s1 (open pn :direction :io :if-exists :overwrite
966                          :if-does-not-exist :create)))
967            (unwind-protect
968                ;; Now try again
969                (let ((s2 (open pn :direction :io)))
970                  (unwind-protect
971                      (write-line "abcdef" s2)
972                    (close s2))
973                  (unwind-protect
974                      (progn
975                        (setq s2 (open s1 :direction :input))
976                        (equalt (read-line s2 nil) "abcdef"))
977                    (close s2)))
978              (close s1)
979              (delete-all-versions pn)
980              )))))
981  t)
982
983(def-open-io-test open.io.31 (:if-exists :rename
984                              :direction :io)
985  (progn (file-position s :start)
986         (values (read-line s nil)))
987  ("abcdefghij"))
988
989(def-open-io-test open.io.32 (:if-exists :rename-and-delete
990                              :direction :io)
991  (progn (file-position s :start)
992         (values (read-line s nil)))
993  ("abcdefghij"))
994
995(def-open-io-test open.io.33 (:if-exists :new-version
996                              :direction :io)
997  (progn (file-position s :start)
998         (values (read-line s nil)))
999  ("abcdefghij"))
1000
1001(def-open-io-test open.io.34 (:if-exists :supersede
1002                              :direction :io)
1003  (progn (file-position s :start)
1004         (values (read-line s nil)))
1005  ("abcdefghij"))
1006
1007(def-open-io-test open.io.35 (:if-exists nil
1008                              :direction :io)
1009  (progn (file-position s :start)
1010         (values (read-line s nil)))
1011  ("abcdefghij"))
1012
1013;;;; :PROBE tests
1014
1015(defmacro def-open-probe-test
1016  (name args form
1017        &key (build-form nil build-form-p)
1018        (pathname #p"tmp.dat"))
1019  (unless build-form-p
1020    (setf build-form
1021          `(with-open-file (s pn :direction :output
1022                              :if-exists :supersede))))
1023  `(deftest ,name
1024     (let ((pn ,pathname))
1025       (delete-all-versions pn)
1026       ,build-form
1027       (let ((s (open pn :direction :probe ,@args)))
1028         (values
1029          ,(if build-form
1030               `(and
1031                 (typep s 'file-stream)
1032                 (not (open-stream-p s))
1033                 )
1034             `(not s))
1035          ,form)))
1036     t t))
1037
1038(def-open-probe-test open.probe.1 () t)
1039(def-open-probe-test open.probe.2 (:if-exists :error) t)
1040(def-open-probe-test open.probe.3 (:if-exists :new-version) t)
1041(def-open-probe-test open.probe.4 (:if-exists :rename) t)
1042(def-open-probe-test open.probe.5 (:if-exists :rename-and-delete) t)
1043(def-open-probe-test open.probe.6 (:if-exists :overwrite) t)
1044(def-open-probe-test open.probe.7 (:if-exists :append) t)
1045(def-open-probe-test open.probe.8 (:if-exists :supersede) t)
1046
1047(def-open-probe-test open.probe.9 (:if-does-not-exist :error) t)
1048(def-open-probe-test open.probe.10 (:if-does-not-exist nil) t)
1049(def-open-probe-test open.probe.11 (:if-does-not-exist :create) t)
1050
1051(def-open-probe-test open.probe.12 () t :build-form nil)
1052(def-open-probe-test open.probe.13 (:if-exists :error) t :build-form nil)
1053(def-open-probe-test open.probe.14 (:if-exists :new-version) t :build-form nil)
1054(def-open-probe-test open.probe.15 (:if-exists :rename) t :build-form nil)
1055(def-open-probe-test open.probe.16 (:if-exists :rename-and-delete) t
1056  :build-form nil)
1057(def-open-probe-test open.probe.17 (:if-exists :overwrite) t
1058  :build-form nil)
1059(def-open-probe-test open.probe.18 (:if-exists :append) t
1060  :build-form nil)
1061(def-open-probe-test open.probe.19 (:if-exists :supersede) t
1062  :build-form nil)
1063
1064(def-open-probe-test open.probe.20 (:if-does-not-exist nil) t
1065  :build-form nil)
1066
1067(deftest open.probe.21
1068  (let ((pn #p"tmp.dat"))
1069    (delete-all-versions pn)
1070    (let ((s (open pn :direction :probe :if-does-not-exist :create)))
1071      (values
1072       (notnot s)
1073       (notnot (probe-file pn)))))
1074  t t)
1075
1076(deftest open.probe.22
1077  (let ((pn #p"tmp.dat"))
1078    (delete-all-versions pn)
1079    (let ((s (open pn :direction :probe :if-does-not-exist :create
1080                   :if-exists :error)))
1081      (values
1082       (notnot s)
1083       (notnot (probe-file pn)))))
1084  t t)
1085
1086(def-open-probe-test open.probe.23 (:external-format :default) t)
1087(def-open-probe-test open.probe.24 (:element-type 'character) t)
1088(def-open-probe-test open.probe.25 (:element-type 'bit) t)
1089(def-open-probe-test open.probe.26 (:element-type '(unsigned-byte 2)) t)
1090(def-open-probe-test open.probe.27 (:element-type '(unsigned-byte 4)) t)
1091(def-open-probe-test open.probe.28 (:element-type '(unsigned-byte 8)) t)
1092(def-open-probe-test open.probe.29 (:element-type '(unsigned-byte 9)) t)
1093(def-open-probe-test open.probe.30 (:element-type '(unsigned-byte 15)) t)
1094(def-open-probe-test open.probe.31 (:element-type '(unsigned-byte 16)) t)
1095(def-open-probe-test open.probe.32 (:element-type '(unsigned-byte 17)) t)
1096(def-open-probe-test open.probe.33 (:element-type '(unsigned-byte 31)) t)
1097(def-open-probe-test open.probe.34 (:element-type '(unsigned-byte 32)) t)
1098(def-open-probe-test open.probe.35 (:element-type '(unsigned-byte 33)) t)
1099(def-open-probe-test open.probe.36 (:element-type '(integer -1002 13112)) t)
1100
1101;;;; Error tests
1102
1103(deftest open.error.1
1104  (signals-error (open) program-error)
1105  t)
1106
1107(deftest open.error.2
1108  (signals-error-always
1109   (let ((pn #p"tmp.dat"))
1110     (close (open pn :direction :output :if-does-not-exist :create))
1111     (open pn :if-exists :error :direction :output))
1112   file-error)
1113  t t)
1114
1115(deftest open.error.3
1116  (signals-error-always
1117   (let ((pn #p"tmp.dat"))
1118     (close (open pn :direction :output :if-does-not-exist :create))
1119     (open pn :if-exists :error :direction :io))
1120   file-error)
1121  t t)
1122
1123(deftest open.error.4
1124  (signals-error-always
1125   (let ((pn #p"tmp.dat"))
1126     (delete-all-versions pn)
1127     (open pn))
1128   file-error)
1129  t t)
1130
1131(deftest open.error.5
1132  (signals-error-always
1133   (let ((pn #p"tmp.dat"))
1134     (delete-all-versions pn)
1135     (open pn :if-does-not-exist :error))
1136   file-error)
1137  t t)
1138
1139(deftest open.error.6
1140  (signals-error-always
1141   (let ((pn #p"tmp.dat"))
1142     (delete-all-versions pn)
1143     (open pn :direction :input))
1144   file-error)
1145  t t)
1146
1147(deftest open.error.7
1148  (signals-error-always
1149   (let ((pn #p"tmp.dat"))
1150     (delete-all-versions pn)
1151     (open pn :if-does-not-exist :error :direction :input))
1152   file-error)
1153  t t)
1154
1155(deftest open.error.8
1156  (signals-error-always
1157   (let ((pn #p"tmp.dat"))
1158     (delete-all-versions pn)
1159     (open pn :direction :output :if-does-not-exist :error))
1160   file-error)
1161  t t)
1162
1163(deftest open.error.9
1164  (signals-error-always
1165   (let ((pn #p"tmp.dat"))
1166     (delete-all-versions pn)
1167     (open pn :direction :io :if-does-not-exist :error))
1168   file-error)
1169  t t)
1170
1171(deftest open.error.10
1172  (signals-error-always
1173   (let ((pn #p"tmp.dat"))
1174     (delete-all-versions pn)
1175     (open pn :direction :probe :if-does-not-exist :error))
1176   file-error)
1177  t t)
1178
1179(deftest open.error.11
1180  (signals-error-always
1181   (let ((pn #p"tmp.dat"))
1182     (delete-all-versions pn)
1183     (open pn :direction :output :if-exists :overwrite))
1184   file-error)
1185  t t)
1186
1187(deftest open.error.12
1188  (signals-error-always
1189   (let ((pn #p"tmp.dat"))
1190     (delete-all-versions pn)
1191     (open pn :direction :output :if-exists :append))
1192   file-error)
1193  t t)
1194
1195(deftest open.error.13
1196  (signals-error-always
1197   (let ((pn #p"tmp.dat"))
1198     (delete-all-versions pn)
1199     (open pn :direction :io :if-exists :overwrite))
1200   file-error)
1201  t t)
1202
1203(deftest open.error.14
1204  (signals-error-always
1205   (let ((pn #p"tmp.dat"))
1206     (delete-all-versions pn)
1207     (open pn :direction :io :if-exists :append))
1208   file-error)
1209  t t)
1210
1211(deftest open.error.15
1212  (signals-error-always
1213   (open (make-pathname :name :wild :type "lsp"))
1214   file-error)
1215  t t)
1216
1217(deftest open.error.16
1218  (signals-error-always
1219   (open (make-pathname :name "open" :type :wild))
1220   file-error)
1221  t t)
1222
1223(deftest open.error.17
1224  (signals-error-always
1225   (let ((pn (make-pathname :name "open" :type "lsp" :version :wild)))
1226     (if (wild-pathname-p pn) (open pn)
1227       (error 'file-error)))
1228   file-error)
1229  t t)
1230
1231(deftest open.error.18
1232  (signals-error-always
1233   (open #p"tmp.dat" :direction :output :if-exists :supersede
1234         :external-form (gensym))
1235   error)
1236  t t)
1237
1238
1239;;; FIXME -- add tests for :element-type :default
1240
1241;;; FIXME -- add tests for filespec being a specialized string
Note: See TracBrowser for help on using the repository browser.