~ chicken-core (chicken-5) /tests/path-tests.scm

  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))))