wild-pathname-p.lsp 5.83 KB
Newer Older
1
2
3
4
5
6
7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Dec 31 16:54:55 2003
;;;; Contains: Tests of WILD-PATHNAME-P

(in-package :cl-test)

8
9
(compile-and-load "pathnames-aux.lsp")

10
11
12
13
14
15
(deftest wild-pathname-p.1
  (wild-pathname-p (make-pathname))
  nil)

(deftest wild-pathname-p.2
  (loop for key in '(:host :device :directory :name :type :version nil)
sds's avatar
sds committed
16
17
        when (wild-pathname-p (make-pathname) key)
        collect key)
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
  nil)

(deftest wild-pathname-p.3
  (let ((p (make-pathname :directory :wild)))
    (notnot-mv (wild-pathname-p p)))
  t)

(deftest wild-pathname-p.4
  (let ((p (make-pathname :directory :wild)))
    (notnot-mv (wild-pathname-p p nil)))
  t)

(deftest wild-pathname-p.5
  (let ((p (make-pathname :directory :wild)))
    (notnot-mv (wild-pathname-p p :directory)))
  t)

(deftest wild-pathname-p.6
  (let ((p (make-pathname :directory :wild)))
    (loop for key in '(:host :device :name :type :version)
sds's avatar
sds committed
38
39
        when (wild-pathname-p p key)
        collect key))
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
  nil)


(deftest wild-pathname-p.7
  (let ((p (make-pathname :directory '(:absolute :wild))))
    (notnot-mv (wild-pathname-p p)))
  t)

(deftest wild-pathname-p.8
  (let ((p (make-pathname :directory '(:absolute :wild))))
    (notnot-mv (wild-pathname-p p nil)))
  t)

(deftest wild-pathname-p.9
  (let ((p (make-pathname :directory '(:absolute :wild))))
    (notnot-mv (wild-pathname-p p :directory)))
  t)

(deftest wild-pathname-p.10
  (let ((p (make-pathname :directory '(:absolute :wild))))
    (loop for key in '(:host :device :name :type :version)
sds's avatar
sds committed
61
62
        when (wild-pathname-p p key)
        collect key))
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
  nil)


(deftest wild-pathname-p.11
  (let ((p (make-pathname :directory '(:relative :wild))))
    (notnot-mv (wild-pathname-p p)))
  t)

(deftest wild-pathname-p.12
  (let ((p (make-pathname :directory '(:relative :wild))))
    (notnot-mv (wild-pathname-p p nil)))
  t)

(deftest wild-pathname-p.13
  (let ((p (make-pathname :directory '(:relative :wild))))
    (notnot-mv (wild-pathname-p p :directory)))
  t)

(deftest wild-pathname-p.14
  (let ((p (make-pathname :directory '(:relative :wild))))
    (loop for key in '(:host :device :name :type :version)
sds's avatar
sds committed
84
85
        when (wild-pathname-p p key)
        collect key))
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
  nil)

;;;

(deftest wild-pathname-p.15
  (let ((p (make-pathname :name :wild)))
    (notnot-mv (wild-pathname-p p)))
  t)

(deftest wild-pathname-p.16
  (let ((p (make-pathname :name :wild)))
    (notnot-mv (wild-pathname-p p nil)))
  t)

(deftest wild-pathname-p.17
  (let ((p (make-pathname :name :wild)))
    (notnot-mv (wild-pathname-p p :name)))
  t)

(deftest wild-pathname-p.18
  (let ((p (make-pathname :name :wild)))
    (loop for key in '(:host :device :directory :type :version)
sds's avatar
sds committed
108
109
        when (wild-pathname-p p key)
        collect key))
110
111
  nil)

sds's avatar
sds committed
112
113
;;;

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
(deftest wild-pathname-p.19
  (let ((p (make-pathname :type :wild)))
    (notnot-mv (wild-pathname-p p)))
  t)

(deftest wild-pathname-p.20
  (let ((p (make-pathname :type :wild)))
    (notnot-mv (wild-pathname-p p nil)))
  t)

(deftest wild-pathname-p.21
  (let ((p (make-pathname :type :wild)))
    (notnot-mv (wild-pathname-p p :type)))
  t)

(deftest wild-pathname-p.22
  (let ((p (make-pathname :type :wild)))
    (loop for key in '(:host :device :directory :name :version)
sds's avatar
sds committed
132
133
        when (wild-pathname-p p key)
        collect key))
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
  nil)

;;;

 (deftest wild-pathname-p.23
  (let ((p (make-pathname :version :wild)))
    (notnot-mv (wild-pathname-p p)))
  t)

(deftest wild-pathname-p.24
  (let ((p (make-pathname :version :wild)))
    (notnot-mv (wild-pathname-p p nil)))
  t)

(deftest wild-pathname-p.25
  (let ((p (make-pathname :version :wild)))
    (notnot-mv (wild-pathname-p p :version)))
  t)

(deftest wild-pathname-p.26
  (let ((p (make-pathname :version :wild)))
    (loop for key in '(:host :device :directory :name :type)
sds's avatar
sds committed
156
157
        when (wild-pathname-p p key)
        collect key))
158
159
160
161
162
  nil)

;;;

(deftest wild-pathname-p.27
pfdietz's avatar
pfdietz committed
163
  (loop for p in (append *pathnames* *logical-pathnames*)
sds's avatar
sds committed
164
165
166
        unless (if (wild-pathname-p p) (wild-pathname-p p nil)
                 (not (wild-pathname-p p nil)))
        collect p)
167
168
169
  nil)

(deftest wild-pathname-p.28
pfdietz's avatar
pfdietz committed
170
  (loop for p in (append *pathnames* *logical-pathnames*)
sds's avatar
sds committed
171
172
173
174
175
        when (and (loop for key in '(:host :device :directory
                                           :name :type :version)
                        thereis (wild-pathname-p p key))
                  (not (wild-pathname-p p)))
        collect p)
176
177
  nil)

pfdietz's avatar
pfdietz committed
178
179
180
181
;;; On streams associated with files

(deftest wild-pathname-p.29
  (with-open-file (s "foo.lsp"
sds's avatar
sds committed
182
183
184
185
                     :direction :output
                     :if-exists :append
                     :if-does-not-exist :create)
                  (wild-pathname-p s))
pfdietz's avatar
pfdietz committed
186
187
188
189
  nil)

(deftest wild-pathname-p.30
  (let ((s (open "foo.lsp"
sds's avatar
sds committed
190
191
192
                 :direction :output
                 :if-exists :append
                 :if-does-not-exist :create)))
pfdietz's avatar
pfdietz committed
193
194
195
196
197
198
199
200
201
202
    (close s)
    (wild-pathname-p s))
  nil)

;;; logical pathname designators

(deftest wild-pathname-p.31
  (wild-pathname-p "CLTEST:FOO.LISP")
  nil)

203
204
205
206
207
208
209
210
211
;;; Odd strings

(deftest wild-pathname-p.32
  (do-special-strings
   (s "CLTEST:FOO.LISP" nil)
   (let ((vals (multiple-value-list (wild-pathname-p s))))
     (assert (equal vals '(nil)))))
  nil)

212
213
214
;;;

(deftest wild-pathname-p.error.1
215
216
  (signals-error (wild-pathname-p) program-error)
  t)
217
218

(deftest wild-pathname-p.error.2
219
  (signals-error (wild-pathname-p *default-pathname-defaults* nil nil)
sds's avatar
sds committed
220
                 program-error)
221
  t)
222
223

(deftest wild-pathname-p.error.3
224
  (check-type-error #'wild-pathname-p
sds's avatar
sds committed
225
226
                    (typef '(or pathname string file-stream
                                synonym-stream)))
227
  nil)
228
229

(deftest wild-pathname-p.error.4
230
  (check-type-error #'(lambda (x) (declare (optimize (safety 0)))
sds's avatar
sds committed
231
232
233
                        (wild-pathname-p x))
                    (typef '(or pathname string file-stream
                                synonym-stream)))
234
  nil)