source: trunk/source/tests/ansi-tests/merge-pathnames.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Dec 31 11:25:55 2003
4;;;; Contains: Tests of MERGE-PATHNAMES
5
6(in-package :cl-test)
7
8#|
9(defun merge-pathnames-test (&rest args)
10  (assert (<= 1 (length args) 3))
11  (let* ((p1 (car args))
12         (p2 (if (cdr args) (cadr args) *default-pathname-defaults*))
13         (default-version (if (cddr args) (caddr args) :newest))
14         (results (multiple-value-list (apply #'merge-pathnames args))))
15    (assert (= (length results) 1))
16    (let ((p3 (first results)))
17     
18|#
19
20(deftest merge-pathnames.1
21  (let* ((p1 (make-pathname :name "foo"))
22         (p2 (merge-pathnames p1 p1 nil)))
23    (values
24     (equalpt (pathname-name p1) "foo")
25     (if (equalpt p1 p2) t
26       (list p1 p2))))
27  t t)
28
29(deftest merge-pathnames.2
30  (let* ((p1 (make-pathname :name "foo"))
31         (p2 (merge-pathnames p1 p1)))
32    (values
33     (equalpt (pathname-host p1) (pathname-host p2))
34     (equalpt (pathname-device p1) (pathname-device p2))
35     (equalpt (pathname-directory p1) (pathname-directory p2))
36     (pathname-name p1)
37     (pathname-name p2)
38     (equalpt (pathname-type p1) (pathname-type p2))
39     (if (pathname-version p1)
40         (equalpt (pathname-version p1) (pathname-version p2))
41       (equalpt (pathname-version p2) :newest))))
42  t t t "foo" "foo" t t)
43
44(deftest merge-pathnames.3
45  (let* ((p1 (make-pathname :name "foo"))
46         (p2 (make-pathname :name "bar"))
47         (p3 (merge-pathnames p1 p2)))
48    (values
49     (equalpt (pathname-host p1) (pathname-host p3))
50     (equalpt (pathname-device p1) (pathname-device p3))
51     (equalpt (pathname-directory p1) (pathname-directory p3))
52     (pathname-name p1)
53     (pathname-name p3)
54     (equalpt (pathname-type p1) (pathname-type p3))
55     (if (pathname-version p1)
56         (equalpt (pathname-version p1) (pathname-version p3))
57       (equalpt (pathname-version p3) :newest))))
58  t t t "foo" "foo" t t)
59
60(deftest merge-pathnames.4
61  (let* ((p1 (make-pathname :name "foo"))
62         (p2 (make-pathname :type "lsp"))
63         (p3 (merge-pathnames p1 p2)))
64    (values
65     (equalpt (pathname-host p1) (pathname-host p3))
66     (equalpt (pathname-device p1) (pathname-device p3))
67     (equalpt (pathname-directory p1) (pathname-directory p3))
68     (pathname-name p1)
69     (pathname-type p2)
70     (pathname-type p3)
71     (equalpt (pathname-type p2) (pathname-type p3))
72     (if (pathname-version p1)
73         (equalpt (pathname-version p1) (pathname-version p3))
74       (equalpt (pathname-version p3) :newest))))
75  t t t "foo" "lsp" "lsp" t t)
76
77(deftest merge-pathnames.5
78  (let* ((p1 (make-pathname :name "foo"))
79         (p2 (make-pathname :type "lsp" :version :newest))
80         (p3 (merge-pathnames p1 p2 nil)))
81    (values
82     (equalpt (pathname-host p1) (pathname-host p3))
83     (equalpt (pathname-device p1) (pathname-device p3))
84     (equalpt (pathname-directory p1) (pathname-directory p3))
85     (pathname-name p1)
86     (pathname-name p3)
87     (pathname-type p2)
88     (pathname-type p3)
89     (equalpt (pathname-version p1) (pathname-version p3))))
90  t t t "foo" "foo" "lsp" "lsp" t)
91
92(deftest merge-pathnames.6
93  (let* ((p1 (make-pathname))
94         (p2 (make-pathname :name "foo" :version :newest))
95         (p3 (merge-pathnames p1 p2 nil)))
96    (values
97     (equalpt (pathname-host p1) (pathname-host p3))
98     (equalpt (pathname-device p1) (pathname-device p3))
99     (equalpt (pathname-directory p1) (pathname-directory p3))
100     (pathname-name p2)
101     (pathname-name p3)
102     (equalpt (pathname-type p2) (pathname-type p3))
103     (pathname-version p2)
104     (pathname-version p3)))
105  t t t "foo" "foo" t :newest :newest)
106
107(deftest merge-pathnames.7
108  (let* ((p1 (make-pathname))
109         (p2 *default-pathname-defaults*)
110         (p3 (merge-pathnames p1)))
111    (values
112     (equalpt (pathname-host p1) (pathname-host p3))
113     (equalpt (pathname-host p2) (pathname-host p3))
114     (equalpt (pathname-device p2) (pathname-device p3))
115     (equalpt (pathname-directory p2) (pathname-directory p3))
116     (equalpt (pathname-name p2) (pathname-name p3))
117     (equalpt (pathname-type p2) (pathname-type p3))
118     (cond
119      ((pathname-version p1) (equalpt (pathname-version p1)
120                                      (pathname-version p3)))
121      ((pathname-version p2) (equalpt (pathname-version p2)
122                                      (pathname-version p3)))
123      (t (equalpt (pathname-version p3) :newest)))))
124  t t t t t t t)
Note: See TracBrowser for help on using the repository browser.