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

Last change on this file since 15813 was 15813, checked in by kon, 10 years ago

posixwin use of 'fx= 0' instead of 'zero?'
posixunix use of 'fx= 0' instead of 'zero?', fix for 'create-directory' when absolute pathname & easier to read
files common code for "is this a pds char?", added 'decompose-directory', rmvd redundent compile-time proc cache
files added 'decompose-directory'
data-structures 'random-seed' not here

File size: 3.2 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;this is weird
32(test "./" (normalize-pathname "/" 'unix))
33(test "./" (normalize-pathname "/./" 'unix))
34(test "./" (normalize-pathname "/." 'unix))
35(test "./" (normalize-pathname "./" 'unix))
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
56(define home (get-environment-variable "HOME"))
57
58(test (string-append home "/foo") (normalize-pathname "~/foo" 'unix))
59(test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
60(test (string-append home "\\foo") (normalize-pathname "c:~\\foo" 'windows))
61
62(assert (directory-null? "/.//"))
63(assert (directory-null? ""))
64(assert (not (directory-null? "//foo//")))
65
66(test '(#f "/" (".")) (receive (decompose-directory "/.//")))
67; 'normalize-pathname' can be weird
68(test '(#f #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.