~ chicken-core (master) /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 "/" 'unix))
 28(test "/" (normalize-pathname "/." 'unix))
 29(test "/" (normalize-pathname "/./" 'unix))
 30(test "/" (normalize-pathname "/./." 'unix))
 31(test "." (normalize-pathname "./" 'unix))
 32(test "a" (normalize-pathname "./a"))
 33(test "a" (normalize-pathname ".///a"))
 34(test "a" (normalize-pathname "a"))
 35(test "a/" (normalize-pathname "a/" 'unix))
 36(test "a/b" (normalize-pathname "a/b" 'unix))
 37(test "a\\b" (normalize-pathname "a\\b" '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" 'unix))
 41(test "/a/b" (normalize-pathname "/a//b" 'unix))
 42(test "/a/b" (normalize-pathname "///a//b" 'unix))
 43(test "c:a/b" (normalize-pathname "c:a/./b" 'windows))
 44(test "c:/a/b" (normalize-pathname "c:/a/./b" 'unix))
 45(test "c:a/b" (normalize-pathname "c:a/./b" 'windows))
 46(test "c:b" (normalize-pathname "c:a/../b" 'windows))
 47(test "c:/b" (normalize-pathname "c:/a/../b" 'windows))
 48(test "a/b" (normalize-pathname "a/./././b" 'unix))
 49(test "a/b" (normalize-pathname "a/b/c/d/../.." 'unix))
 50(test "a/b/" (normalize-pathname "a/b/c/d/../../" 'unix))
 51(test "../../foo" (normalize-pathname "../../foo" 'unix))
 52(test "c:/" (normalize-pathname "c:/" 'windows))
 53(test "c:/" (normalize-pathname "c:/." 'windows))
 54(test "c:/" (normalize-pathname "c:/./" 'windows))
 55(test "c:/" (normalize-pathname "c:/./." 'windows))
 56
 57(test "~/foo" (normalize-pathname "~/foo" 'unix))
 58(test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
 59(test "c:~/foo" (normalize-pathname "c:~/foo" 'windows))
 60
 61(assert (directory-null? "/.//"))
 62(assert (directory-null? ""))
 63(assert (not (directory-null? "//foo//")))
 64
 65(test '(#f "/" (".")) (receive (decompose-directory "/.//")))
 66
 67(if ##sys#windows-platform
 68    (test '(#f "/" #f) (receive (decompose-directory "///\\///")))
 69    (test '(#f "/" ("\\")) (receive (decompose-directory "///\\///"))))
 70
 71(test '(#f "/" ("foo")) (receive (decompose-directory "//foo//")))
 72(test '(#f "/" ("foo" "bar")) (receive (decompose-directory "//foo//bar")))
 73(test '(#f #f (".")) (receive (decompose-directory ".//")))
 74(test '(#f #f ("." "foo")) (receive (decompose-directory ".//foo//")))
 75(test '(#f #f (" " "foo" "bar")) (receive (decompose-directory " //foo//bar")))
 76(test '(#f #f ("foo" "bar")) (receive (decompose-directory "foo//bar/")))
 77
 78(test '(#f #f #f) (receive (decompose-pathname "")))
 79(test '("/" #f #f) (receive (decompose-pathname "/")))
 80
 81(test '("/" "a" #f) (receive (decompose-pathname "/a")))
 82
 83(test '("/" #f #f) (receive (decompose-pathname "///")))
 84
 85(test '("/" "a" #f) (receive (decompose-pathname "///a")))
 86
 87(test '("/a" "b" #f) (receive (decompose-pathname "/a/b")))
 88
 89(test '("/a" "b" "c") (receive (decompose-pathname "/a/b.c")))
 90
 91(test '("." "a" #f) (receive (decompose-pathname "./a")))
 92
 93(test '("." "a" "b") (receive (decompose-pathname "./a.b")))
 94
 95(test '("./a" "b" #f) (receive (decompose-pathname "./a/b")))
 96
 97(test '(#f "a" #f) (receive (decompose-pathname "a")))
 98(test '(#f "a." #f) (receive (decompose-pathname "a.")))
 99(test '(#f ".a" #f) (receive (decompose-pathname ".a")))
100(test '("a" "b" #f) (receive (decompose-pathname "a/b")))
101
102(test '("a" "b" #f) (receive (decompose-pathname "a///b")))
103
104(test '("a/b" "c" #f) (receive (decompose-pathname "a/b/c")))
105
106(test '("a/b/c" #f #f) (receive (decompose-pathname "a/b/c/")))
107
108(test '("a/b/c" #f #f) (receive (decompose-pathname "a/b/c///")))
109
110(test '(#f "a" "b") (receive (decompose-pathname "a.b")))
111(test '("a.b" #f #f) (receive (decompose-pathname "a.b/")))
112
113(test '(#f "a.b" "c") (receive (decompose-pathname "a.b.c")))
114(test '(#f "a." "b") (receive (decompose-pathname "a..b")))
115(test '(#f "a.." "b") (receive (decompose-pathname "a...b")))
116(test '("a." ".b" #f) (receive (decompose-pathname "a./.b")))
117
118       (test "x/y/z.q" (make-pathname "x/y" "z" "q"))
119       (test "x/y/z.q" (make-pathname "x/y" "z.q"))
120       (test "x/y/z.q" (make-pathname "x/y/" "z.q"))
121       (test "x/y/z.q" (make-pathname "x/y/" "z.q"))
122       (test "x/y\\/z.q" (make-pathname "x/y\\" "z.q"))
123       (test "x//y/z.q" (make-pathname "x//y/" "z.q"))
124       (test "x\\y/z.q" (make-pathname "x\\y" "z.q"))
125
126(test 'error (handle-exceptions _ 'error (make-pathname '(#f) "foo")))
127
128(test "/x/y/z" (make-pathname #f "/x/y/z"))
129       (test "/x/y/z" (make-pathname "/" "x/y/z"))
130       (test "/x/y/z" (make-pathname "/x" "/y/z"))
131       (test "/x/y/z" (make-pathname '("/") "x/y/z"))
132       (test "/x/y/z" (make-pathname '("/" "x") "y/z"))
133       (test "/x/y/z" (make-pathname '("/x" "y") "z"))
134       (test "/x/y/z/" (make-pathname '("/x" "y" "z") #f))