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

(in-package :cl-test)

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)