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
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
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)

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))
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)))
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)