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