source: project/chicken/trunk/tests/path-tests.scm @ 15819

Last change on this file since 15819 was 15819, checked in by Kon Lovett, 10 years ago

files, path-tests Fix for "empty" but absolute pathnames
library, runtime, chicken Better names for experimental "module" introspection
files Deprecated 'make-pathname' separator argument

File size: 3.3 KB
Line 
1(use files)
2
3(assert (equal? "/" (pathname-directory "/")))
4(assert (equal? "/" (pathname-directory "/abc")))
5(assert (equal? "abc" (pathname-directory "abc/")))
6(assert (equal? "abc" (pathname-directory "abc/def")))
7(assert (equal? "abc" (pathname-directory "abc/def.ghi")))
8(assert (equal? "abc" (pathname-directory "abc/.def.ghi")))
9(assert (equal? "abc" (pathname-directory "abc/.ghi")))
10(assert (equal? "/abc" (pathname-directory "/abc/")))
11(assert (equal? "/abc" (pathname-directory "/abc/def")))
12(assert (equal? "/abc" (pathname-directory "/abc/def.ghi")))
13(assert (equal? "/abc" (pathname-directory "/abc/.def.ghi")))
14(assert (equal? "/abc" (pathname-directory "/abc/.ghi")))
15(assert (equal? "q/abc" (pathname-directory "q/abc/")))
16(assert (equal? "q/abc" (pathname-directory "q/abc/def")))
17(assert (equal? "q/abc" (pathname-directory "q/abc/def.ghi")))
18(assert (equal? "q/abc" (pathname-directory "q/abc/.def.ghi")))
19(assert (equal? "q/abc" (pathname-directory "q/abc/.ghi")))
20
21(define-syntax test
22  (syntax-rules ()
23    ((_ expected exp)
24     (let ((result exp)
25           (expd expected))
26       (unless (equal? result expd)
27         (error "test failed" result expd 'exp))))))
28
29(test "./" (normalize-pathname "" 'unix))
30(test ".\\" (normalize-pathname "" 'windows))
31(test "/../" (normalize-pathname "/../"))
32(test "/." (normalize-pathname "/abc/../."))
33(test "/." (normalize-pathname "/" 'unix))
34(test "/." (normalize-pathname "/./" 'unix))
35(test "/." (normalize-pathname "/." 'unix))
36(test "./" (normalize-pathname "./" 'unix))
37(test "a" (normalize-pathname "a"))
38(test "a/" (normalize-pathname "a/" '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" 'windows))
42(test "a\\b" (normalize-pathname "a/b" 'windows))
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 "/a/b" (normalize-pathname "///a//b" 'unix))
48(test "c:a\\b" (normalize-pathname "c:a/./b" 'windows))
49(test "c:/a/b" (normalize-pathname "c:/a/./b" 'unix))
50(test "c:a\\b" (normalize-pathname "c:a/./b" 'windows))
51(test "c:b" (normalize-pathname "c:a/../b" 'windows))
52(test "c:\\b" (normalize-pathname "c:\\a\\..\\b" 'windows))
53(test "a/b" (normalize-pathname "a/./././b" 'unix))
54(test "a/b" (normalize-pathname "a/b/c/d/../.." 'unix))
55(test "a/b/" (normalize-pathname "a/b/c/d/../../" 'unix))
56
57(define home (get-environment-variable "HOME"))
58
59(test (string-append home "/foo") (normalize-pathname "~/foo" 'unix))
60(test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
61(test (string-append home "\\foo") (normalize-pathname "c:~\\foo" 'windows))
62
63(assert (directory-null? "/.//"))
64(assert (directory-null? ""))
65(assert (not (directory-null? "//foo//")))
66
67(test '(#f "/" (".")) (receive (decompose-directory "/.//")))
68(test '(#f "/" (".")) (receive (decompose-directory (normalize-pathname "/.//"))))
69(test '(#f "/" #f) (receive (decompose-directory "///\\///")))
70(test '(#f "/" ("foo")) (receive (decompose-directory "//foo//")))
71(test '(#f "/" ("foo" "bar")) (receive (decompose-directory "//foo//bar")))
72(test '(#f #f (" " "foo" "bar")) (receive (decompose-directory " //foo//bar")))
73(test '(#f #f ("foo" "bar")) (receive (decompose-directory "foo//bar/")))
Note: See TracBrowser for help on using the repository browser.