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