1(import (chicken pathname))
2
3(define-syntax test
4  (syntax-rules ()
5    ((_ r x) (let ((y x)) (print y) (assert (equal? r y))))))
6
7(test "/" (pathname-directory "/"))
8(test "/" (pathname-directory "/abc"))
9(test "abc" (pathname-directory "abc/"))
10(test "abc" (pathname-directory "abc/def"))
11(test "abc" (pathname-directory "abc/def.ghi"))
12(test "abc" (pathname-directory "abc/.def.ghi"))
13(test "abc" (pathname-directory "abc/.ghi"))
14(test "/abc" (pathname-directory "/abc/"))
15(test "/abc" (pathname-directory "/abc/def"))
16(test "/abc" (pathname-directory "/abc/def.ghi"))
17(test "/abc" (pathname-directory "/abc/.def.ghi"))
18(test "/abc" (pathname-directory "/abc/.ghi"))
19(test "q/abc" (pathname-directory "q/abc/"))
20(test "q/abc" (pathname-directory "q/abc/def"))
21(test "q/abc" (pathname-directory "q/abc/def.ghi"))
22(test "q/abc" (pathname-directory "q/abc/.def.ghi"))
23(test "q/abc" (pathname-directory "q/abc/.ghi"))
24
25(test "." (normalize-pathname "" 'unix))
26(test "." (normalize-pathname "" 'windows))
27(test "\\..\\" (normalize-pathname "/../" 'windows))
28(test "\\" (normalize-pathname "/abc/../." 'windows))
29(test "/" (normalize-pathname "/" 'unix))
30(test "/" (normalize-pathname "/." 'unix))
31(test "/" (normalize-pathname "/./" 'unix))
32(test "/" (normalize-pathname "/./." 'unix))
33(test "." (normalize-pathname "./" 'unix))
34(test "a" (normalize-pathname "./a"))
35(test "a" (normalize-pathname ".///a"))
36(test "a" (normalize-pathname "a"))
37(test "a/" (normalize-pathname "a/" 'unix))
38(test "a/b" (normalize-pathname "a/b" 'unix))
39(test "a\\b" (normalize-pathname "a\\b" 'unix))
40(test "a\\b" (normalize-pathname "a\\b" 'windows))
41(test "a\\b" (normalize-pathname "a/b" 'windows))
42(test "a/b/" (normalize-pathname "a/b/" 'unix))
43(test "a/b/" (normalize-pathname "a/b//" 'unix))
44(test "a/b" (normalize-pathname "a//b" 'unix))
45(test "/a/b" (normalize-pathname "/a//b" 'unix))
46(test "/a/b" (normalize-pathname "///a//b" 'unix))
47(test "c:a\\b" (normalize-pathname "c:a/./b" 'windows))
48(test "c:/a/b" (normalize-pathname "c:/a/./b" 'unix))
49(test "c:a\\b" (normalize-pathname "c:a/./b" 'windows))
50(test "c:b" (normalize-pathname "c:a/../b" 'windows))
51(test "c:\\b" (normalize-pathname "c:\\a\\..\\b" 'windows))
52(test "a/b" (normalize-pathname "a/./././b" 'unix))
53(test "a/b" (normalize-pathname "a/b/c/d/../.." 'unix))
54(test "a/b/" (normalize-pathname "a/b/c/d/../../" 'unix))
55(test "../../foo" (normalize-pathname "../../foo" 'unix))
56(test "c:\\" (normalize-pathname "c:\\" 'windows))
57(test "c:\\" (normalize-pathname "c:\\." 'windows))
58(test "c:\\" (normalize-pathname "c:\\.\\" 'windows))
59(test "c:\\" (normalize-pathname "c:\\.\\." 'windows))
60
61(test "~/foo" (normalize-pathname "~/foo" 'unix))
62(test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
63(test "c:~\\foo" (normalize-pathname "c:~\\foo" 'windows))
64
65(assert (directory-null? "/.//"))
66(assert (directory-null? ""))
67(assert (not (directory-null? "//foo//")))
68
69(test '(#f "/" (".")) (receive (decompose-directory "/.//")))
70
71(if ##sys#windows-platform
72    (test '(#f "/" #f) (receive (decompose-directory "///\\///")))
73    (test '(#f "/" ("\\")) (receive (decompose-directory "///\\///"))))
74
75(test '(#f "/" ("foo")) (receive (decompose-directory "//foo//")))
76(test '(#f "/" ("foo" "bar")) (receive (decompose-directory "//foo//bar")))
77(test '(#f #f (".")) (receive (decompose-directory ".//")))
78(test '(#f #f ("." "foo")) (receive (decompose-directory ".//foo//")))
79(test '(#f #f (" " "foo" "bar")) (receive (decompose-directory " //foo//bar")))
80(test '(#f #f ("foo" "bar")) (receive (decompose-directory "foo//bar/")))
81
82(test '(#f #f #f) (receive (decompose-pathname "")))
83(test '("/" #f #f) (receive (decompose-pathname "/")))
84
85(if ##sys#windows-platform
86    (test '("\\" #f #f) (receive (decompose-pathname "\\")))
87    (test '(#f "\\" #f) (receive (decompose-pathname "\\"))))
88
89(test '("/" "a" #f) (receive (decompose-pathname "/a")))
90
91(if ##sys#windows-platform
92    (test '("\\" "a" #f) (receive (decompose-pathname "\\a")))
93    (test '(#f "\\a" #f) (receive (decompose-pathname "\\a"))))
94
95(test '("/" #f #f) (receive (decompose-pathname "///")))
96
97(if ##sys#windows-platform
98    (test '("\\" #f #f) (receive (decompose-pathname "\\\\\\")))
99    (test '(#f "\\\\\\" #f) (receive (decompose-pathname "\\\\\\"))))
100
101(test '("/" "a" #f) (receive (decompose-pathname "///a")))
102
103(if ##sys#windows-platform
104    (test '("\\" "a" #f) (receive (decompose-pathname "\\\\\\a")))
105    (test '(#f "\\\\\\a" #f) (receive (decompose-pathname "\\\\\\a"))))
106
107(test '("/a" "b" #f) (receive (decompose-pathname "/a/b")))
108
109(if ##sys#windows-platform
110    (test '("\\a" "b" #f) (receive (decompose-pathname "\\a\\b")))
111    (test '(#f "\\a\\b" #f) (receive (decompose-pathname "\\a\\b"))))
112
113(test '("/a" "b" "c") (receive (decompose-pathname "/a/b.c")))
114
115(if ##sys#windows-platform
116    (test '("\\a" "b" "c") (receive (decompose-pathname "\\a\\b.c")))
117    (test '(#f "\\a\\b" "c") (receive (decompose-pathname "\\a\\b.c"))))
118
119(test '("." "a" #f) (receive (decompose-pathname "./a")))
120
121(if ##sys#windows-platform
122    (test '("." "a" #f) (receive (decompose-pathname ".\\a")))
123    (test '(#f ".\\a" #f) (receive (decompose-pathname ".\\a"))))
124
125(test '("." "a" "b") (receive (decompose-pathname "./a.b")))
126
127(if ##sys#windows-platform
128    (test '("." "a" "b") (receive (decompose-pathname ".\\a.b")))
129    (test '(#f ".\\a" "b") (receive (decompose-pathname ".\\a.b"))))
130
131(test '("./a" "b" #f) (receive (decompose-pathname "./a/b")))
132
133(if ##sys#windows-platform
134    (test '(".\\a" "b" #f) (receive (decompose-pathname ".\\a\\b")))
135    (test '(#f ".\\a\\b" #f) (receive (decompose-pathname ".\\a\\b"))))
136
137(test '(#f "a" #f) (receive (decompose-pathname "a")))
138(test '(#f "a." #f) (receive (decompose-pathname "a.")))
139(test '(#f ".a" #f) (receive (decompose-pathname ".a")))
140(test '("a" "b" #f) (receive (decompose-pathname "a/b")))
141
142(if ##sys#windows-platform
143    (test '("a" "b" #f) (receive (decompose-pathname "a\\b")))
144    (test '(#f "a\\b" #f) (receive (decompose-pathname "a\\b"))))
145
146(test '("a" "b" #f) (receive (decompose-pathname "a///b")))
147
148(if ##sys#windows-platform
149    (test '("a" "b" #f) (receive (decompose-pathname "a\\\\\\b")))
150    (test '(#f "a\\\\\\b" #f) (receive (decompose-pathname "a\\\\\\b"))))
151
152(test '("a/b" "c" #f) (receive (decompose-pathname "a/b/c")))
153
154(if ##sys#windows-platform
155    (test '("a\\b" "c" #f) (receive (decompose-pathname "a\\b\\c")))
156    (test '(#f "a\\b\\c" #f) (receive (decompose-pathname "a\\b\\c"))))
157
158(test '("a/b/c" #f #f) (receive (decompose-pathname "a/b/c/")))
159
160(if ##sys#windows-platform
161    (test '("a\\b\\c" #f #f) (receive (decompose-pathname "a\\b\\c\\")))
162    (test '(#f "a\\b\\c\\" #f) (receive (decompose-pathname "a\\b\\c\\"))))
163
164(test '("a/b/c" #f #f) (receive (decompose-pathname "a/b/c///")))
165
166(if ##sys#windows-platform
167    (test '("a\\b\\c" #f #f) (receive (decompose-pathname "a\\b\\c\\\\\\")))
168    (test '(#f "a\\b\\c\\\\\\" #f) (receive (decompose-pathname "a\\b\\c\\\\\\"))))
169
170(test '(#f "a" "b") (receive (decompose-pathname "a.b")))
171(test '("a.b" #f #f) (receive (decompose-pathname "a.b/")))
172
173(if ##sys#windows-platform
174    (test '("a.b" #f #f) (receive (decompose-pathname "a.b\\")))
175    (test '(#f "a" "b\\") (receive (decompose-pathname "a.b\\"))))
176
177(test '(#f "a.b" "c") (receive (decompose-pathname "a.b.c")))
178(test '(#f "a." "b") (receive (decompose-pathname "a..b")))
179(test '(#f "a.." "b") (receive (decompose-pathname "a...b")))
180(test '("a." ".b" #f) (receive (decompose-pathname "a./.b")))
181
182(if ##sys#windows-platform
183    (test '("a." ".b" #f) (receive (decompose-pathname "a.\\.b")))
184    (test '(#f "a.\\" "b") (receive (decompose-pathname "a.\\.b"))))
185
186(cond (##sys#windows-platform
187       (test "x/y\\z.q" (make-pathname "x/y" "z" "q"))
188       (test "x/y\\z.q" (make-pathname "x/y" "z.q"))
189       (test "x/y\\z.q" (make-pathname "x/y/" "z.q"))
190       (test "x/y\\z.q" (make-pathname "x/y/" "z.q"))
191       (test "x/y\\z.q" (make-pathname "x/y\\" "z.q"))
192       (test "x//y\\z.q" (make-pathname "x//y/" "z.q"))
193       (test "x\\y\\z.q" (make-pathname "x\\y" "z.q")))
194      (else
195       (test "x/y/z.q" (make-pathname "x/y" "z" "q"))
196       (test "x/y/z.q" (make-pathname "x/y" "z.q"))
197       (test "x/y/z.q" (make-pathname "x/y/" "z.q"))
198       (test "x/y/z.q" (make-pathname "x/y/" "z.q"))
199       (test "x/y\\/z.q" (make-pathname "x/y\\" "z.q"))
200       (test "x//y/z.q" (make-pathname "x//y/" "z.q"))
201       (test "x\\y/z.q" (make-pathname "x\\y" "z.q"))))
202
203(test 'error (handle-exceptions _ 'error (make-pathname '(#f) "foo")))
204
205(test "/x/y/z" (make-pathname #f "/x/y/z"))
206
207(cond (##sys#windows-platform
208       (test "\\x/y/z" (make-pathname "/" "x/y/z"))
209       (test "/x\\y/z" (make-pathname "/x" "/y/z"))
210       (test "\\x/y/z" (make-pathname '("/") "x/y/z"))
211       (test "\\x\\y/z" (make-pathname '("/" "x") "y/z"))
212       (test "/x\\y\\z" (make-pathname '("/x" "y") "z"))
213       (test "/x\\y\\z\\" (make-pathname '("/x" "y" "z") #f)))
214      (else
215       (test "/x/y/z" (make-pathname "/" "x/y/z"))
216       (test "/x/y/z" (make-pathname "/x" "/y/z"))
217       (test "/x/y/z" (make-pathname '("/") "x/y/z"))
218       (test "/x/y/z" (make-pathname '("/" "x") "y/z"))
219       (test "/x/y/z" (make-pathname '("/x" "y") "z"))
220       (test "/x/y/z/" (make-pathname '("/x" "y" "z") #f))))
221