merge-pathnames.lsp 4.33 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Dec 31 11:25:55 2003
;;;; Contains: Tests of MERGE-PATHNAMES

6

7

8 9 10 11
#|
(defun merge-pathnames-test (&rest args)
  (assert (<= 1 (length args) 3))
  (let* ((p1 (car args))
sds's avatar
sds committed
12 13 14
         (p2 (if (cdr args) (cadr args) *default-pathname-defaults*))
         (default-version (if (cddr args) (caddr args) :newest))
         (results (multiple-value-list (apply #'merge-pathnames args))))
15 16
    (assert (= (length results) 1))
    (let ((p3 (first results)))
sds's avatar
sds committed
17

18 19
|#

20 21
(deftest merge-pathnames.1
  (let* ((p1 (make-pathname :name "foo"))
sds's avatar
sds committed
22
         (p2 (merge-pathnames p1 p1 nil)))
23
    (values
24 25
     (equalpt (pathname-name p1) "foo")
     (if (equalpt p1 p2) t
26 27 28 29 30
       (list p1 p2))))
  t t)

(deftest merge-pathnames.2
  (let* ((p1 (make-pathname :name "foo"))
sds's avatar
sds committed
31
         (p2 (merge-pathnames p1 p1)))
32
    (values
33 34 35 36 37 38
     (equalpt (pathname-host p1) (pathname-host p2))
     (equalpt (pathname-device p1) (pathname-device p2))
     (equalpt (pathname-directory p1) (pathname-directory p2))
     (pathname-name p1)
     (pathname-name p2)
     (equalpt (pathname-type p1) (pathname-type p2))
39
     (if (pathname-version p1)
sds's avatar
sds committed
40
         (equalpt (pathname-version p1) (pathname-version p2))
41 42
       (equalpt (pathname-version p2) :newest))))
  t t t "foo" "foo" t t)
43 44 45

(deftest merge-pathnames.3
  (let* ((p1 (make-pathname :name "foo"))
sds's avatar
sds committed
46 47
         (p2 (make-pathname :name "bar"))
         (p3 (merge-pathnames p1 p2)))
48
    (values
49 50 51 52 53 54
     (equalpt (pathname-host p1) (pathname-host p3))
     (equalpt (pathname-device p1) (pathname-device p3))
     (equalpt (pathname-directory p1) (pathname-directory p3))
     (pathname-name p1)
     (pathname-name p3)
     (equalpt (pathname-type p1) (pathname-type p3))
55
     (if (pathname-version p1)
sds's avatar
sds committed
56
         (equalpt (pathname-version p1) (pathname-version p3))
57 58
       (equalpt (pathname-version p3) :newest))))
  t t t "foo" "foo" t t)
59 60 61

(deftest merge-pathnames.4
  (let* ((p1 (make-pathname :name "foo"))
sds's avatar
sds committed
62 63
         (p2 (make-pathname :type "lsp"))
         (p3 (merge-pathnames p1 p2)))
64
    (values
65 66 67 68 69 70 71
     (equalpt (pathname-host p1) (pathname-host p3))
     (equalpt (pathname-device p1) (pathname-device p3))
     (equalpt (pathname-directory p1) (pathname-directory p3))
     (pathname-name p1)
     (pathname-type p2)
     (pathname-type p3)
     (equalpt (pathname-type p2) (pathname-type p3))
72
     (if (pathname-version p1)
sds's avatar
sds committed
73
         (equalpt (pathname-version p1) (pathname-version p3))
74 75
       (equalpt (pathname-version p3) :newest))))
  t t t "foo" "lsp" "lsp" t t)
76 77 78

(deftest merge-pathnames.5
  (let* ((p1 (make-pathname :name "foo"))
sds's avatar
sds committed
79 80
         (p2 (make-pathname :type "lsp" :version :newest))
         (p3 (merge-pathnames p1 p2 nil)))
81
    (values
82 83 84 85 86 87 88 89 90
     (equalpt (pathname-host p1) (pathname-host p3))
     (equalpt (pathname-device p1) (pathname-device p3))
     (equalpt (pathname-directory p1) (pathname-directory p3))
     (pathname-name p1)
     (pathname-name p3)
     (pathname-type p2)
     (pathname-type p3)
     (equalpt (pathname-version p1) (pathname-version p3))))
  t t t "foo" "foo" "lsp" "lsp" t)
91 92 93

(deftest merge-pathnames.6
  (let* ((p1 (make-pathname))
sds's avatar
sds committed
94 95
         (p2 (make-pathname :name "foo" :version :newest))
         (p3 (merge-pathnames p1 p2 nil)))
96
    (values
97 98 99 100 101 102
     (equalpt (pathname-host p1) (pathname-host p3))
     (equalpt (pathname-device p1) (pathname-device p3))
     (equalpt (pathname-directory p1) (pathname-directory p3))
     (pathname-name p2)
     (pathname-name p3)
     (equalpt (pathname-type p2) (pathname-type p3))
103 104
     (pathname-version p2)
     (pathname-version p3)))
105
  t t t "foo" "foo" t :newest :newest)
106

107 108
(deftest merge-pathnames.7
  (let* ((p1 (make-pathname))
sds's avatar
sds committed
109 110
         (p2 *default-pathname-defaults*)
         (p3 (merge-pathnames p1)))
111 112 113 114 115 116 117 118 119
    (values
     (equalpt (pathname-host p1) (pathname-host p3))
     (equalpt (pathname-host p2) (pathname-host p3))
     (equalpt (pathname-device p2) (pathname-device p3))
     (equalpt (pathname-directory p2) (pathname-directory p3))
     (equalpt (pathname-name p2) (pathname-name p3))
     (equalpt (pathname-type p2) (pathname-type p3))
     (cond
      ((pathname-version p1) (equalpt (pathname-version p1)
sds's avatar
sds committed
120
                                      (pathname-version p3)))
121
      ((pathname-version p2) (equalpt (pathname-version p2)
sds's avatar
sds committed
122
                                      (pathname-version p3)))
123 124
      (t (equalpt (pathname-version p3) :newest)))))
  t t t t t t t)