file-error.lsp 2.7 KB
Newer Older
1
2
3
4
5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Jan 13 19:10:02 2004
;;;; Contains: Tests of the FILE-ERROR condition, and associated accessor function

Daniel Kochmański's avatar
Daniel Kochmański committed
6

7
8
9

(deftest file-error.1
  (let ((pn (make-pathname :name :wild
sds's avatar
sds committed
10
11
12
                           :type "txt"
                           :version :newest
                           :defaults *default-pathname-defaults*)))
13
14
15
    (handler-case
     (probe-file pn)
     (error (c)
sds's avatar
sds committed
16
17
18
19
20
            (values
             (notnot (typep c 'file-error))
             (if (equalp (file-error-pathname c) pn)
                 t
               (list (file-error-pathname c) pn))))))
21
22
23
  t t)

(deftest file-error-pathname.1
24
  (let ((c (make-condition 'file-error :pathname "scratch/foo.txt")))
25
26
27
28
    (values
     (notnot (typep c 'file-error))
     (eqlt (class-of c) (find-class 'file-error))
     (file-error-pathname c)))
29
  t t "scratch/foo.txt")
30
31

(deftest file-error-pathname.2
32
  (let ((c (make-condition 'file-error :pathname #p"scratch/foo.txt")))
33
34
35
    (values
     (notnot (typep c 'file-error))
     (eqlt (class-of c) (find-class 'file-error))
36
     (equalt #p"scratch/foo.txt" (file-error-pathname c))))
37
38
39
  t t t)

(deftest file-error-pathname.3
40
  (let ((c (make-condition 'file-error :pathname "CLTEST:scratch/foo.txt")))
41
42
43
    (values
     (notnot (typep c 'file-error))
     (eqlt (class-of c) (find-class 'file-error))
44
     (equalpt "CLTEST:scratch/foo.txt"
sds's avatar
sds committed
45
              (file-error-pathname c))))
46
47
48
  t t t)

(deftest file-error-pathname.4
49
50
  (let ((c (make-condition
            'file-error :pathname (logical-pathname "CLTEST:scratch/foo.txt"))))
51
52
53
    (values
     (notnot (typep c 'file-error))
     (eqlt (class-of c) (find-class 'file-error))
54
     (equalpt (logical-pathname "CLTEST:scratch/foo.txt")
sds's avatar
sds committed
55
              (file-error-pathname c))))
56
57
58
  t t t)

(deftest file-error-pathname.5
59
  (with-open-file (s "file-error.txt" :direction :input)
sds's avatar
sds committed
60
61
62
63
64
                  (let ((c (make-condition 'file-error :pathname s)))
                    (values
                     (notnot (typep c 'file-error))
                     (eqlt (class-of c) (find-class 'file-error))
                     (equalpt s (file-error-pathname c)))))
65
66
67
  t t t)

(deftest file-error-pathname.6
68
  (let ((s (open "file-error.txt" :direction :input)))
69
70
71
72
73
74
75
76
77
    (close s)
    (let ((c (make-condition 'file-error :pathname s)))
      (values
       (notnot (typep c 'file-error))
       (eqlt (class-of c) (find-class 'file-error))
       (equalpt s (file-error-pathname c)))))
  t t t)

(deftest file-error-pathname.error.1
78
79
  (signals-error (file-error-pathname) program-error)
  t)
80
81

(deftest file-error-pathname.error.2
82
  (signals-error
83
84
85
86
   (file-error-pathname
    (make-condition 'file-error :pathname "scratch/foo.txt")
    nil)
   program-error) t)