1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
#lang zuo
(require "harness.zuo")
(alert "paths")
(check (path-string? "x"))
(check (path-string? "") #f)
(check (path-string? "xy\0z") #f)
(check (path-string? 'apple) #f)
(define unix? (eq? (hash-ref (runtime-env) 'system-type) 'unix))
(check (build-path "x" "y") (if unix? "x/y" "x\\y"))
(check (build-path "." "y") "y")
(check (build-raw-path "." "y") (if unix? "./y" ".\\y"))
(check (build-path ".." "y") (if unix? "../y" "..\\y"))
(check (build-path "x" ".") "x")
(check (build-raw-path "x" ".") (if unix? "x/." "x\\."))
(check (build-path "x" "..") ".")
(check (build-raw-path "x" "..") (if unix? "x/.." "x\\.."))
(check (build-path "x/y/z/./.." "..") "x/")
(check (build-raw-path "x/y/z/./.." "..") (if unix? "x/y/z/./../.." "x/y/z/./..\\.."))
(check (build-path "x/y/./.." "..") ".")
(check (build-path "x/y/./.." "../../..") (if unix? "../.." "..\\.."))
(check (build-path "x/y/./.." "../q/../..") "..")
(check (build-path "x/" "y") (if unix? "x/y" "x/y"))
(check (build-path "x//" "y") (if unix? "x//y" "x//y"))
(check (build-path "x\\" "y") (if unix? "x\\/y" "x\\y"))
(check (build-path "x" "y/z") (if unix? "x/y/z" "x\\y\\z"))
(check (build-raw-path "x" "y/z") (if unix? "x/y/z" "x\\y/z"))
(check (build-path "x/y" "z") (if unix? "x/y/z" "x/y\\z"))
(check (build-path "x/y/" "z") (if unix? "x/y/z" "x/y/z"))
(check (build-path "/x" "z") (if unix? "/x/z" "/x\\z"))
(check-arg-fail (build-path "" "z") "not a path string")
(check-arg-fail (build-path "z" "") "not a path string")
(check-arg-fail (build-path 0 "z") "not a path string")
(check-arg-fail (build-path "z" 0) "not a path string")
(check-arg-fail (build-path "z" "/x") "path is not relative")
(check (build-path "x") "x")
(check (build-path "x" "y" "z") (if unix? "x/y/z" "x\\y\\z"))
(check (split-path "x/y") '("x/" . "y"))
(check (split-path "x/y/") '("x/" . "y"))
(check (split-path "x//y/") '("x//" . "y"))
(check (split-path "x/y///") '("x/" . "y"))
(check (split-path "x") '(#f . "x"))
(check (split-path "x/") '(#f . "x"))
(check (split-path "x//") '(#f . "x"))
(check (split-path "x\\y") (if unix? '(#f . "x\\y") '("x\\" . "y")))
(check (split-path "/") '(#f . "/"))
(check-arg-fail (split-path "") "not a path string")
(check-arg-fail (split-path 0) "not a path string")
(unless unix?
(check (split-path "c:/") '(#f . "c:/"))
(check (split-path "c:///") '(#f . "c:/"))
(check (split-path "c:/x") '("c:/" . "x"))
(check (split-path "c:/x/") '("c:/" . "x"))
(check (split-path "c:\\") '(#f . "c:\\"))
(check (split-path "c:\\x") '("c:\\" . "x"))
(check (split-path "//mach/drive/") '(#f . "//mach/drive/"))
(check (split-path "//mach/drive/\\\\") '(#f . "//mach/drive/"))
(check (split-path "//mach/drive/z") '("//mach/drive/" . "z"))
(check (split-path "\\\\mach\\drive\\") '(#f . "\\\\mach\\drive\\"))
(check (split-path "\\\\mach\\drive\\z") '("\\\\mach\\drive\\" . "z"))
(check (split-path "\\\\?\\c:\\elem") '("\\\\?\\c:\\" . "elem"))
(check (split-path "\\\\?\\c:\\") '(#f . "\\\\?\\c:\\")))
(check (relative-path? "x/y"))
(check (relative-path? "x/y/"))
(check (relative-path? "/x/") #f)
(check (relative-path? "/") #f)
(check (relative-path? "\\x") unix?)
(check-arg-fail (relative-path? "") "not a path string")
(check-arg-fail (relative-path? 0) "not a path string")
(check (path-string? (at-source "adjacent.txt")))
(check (at-source) (path-only (quote-module-path)))
(check (procedure? at-source))
(check-fail (at-source . x) bad-stx)
(check (simple-form-path "a//b//c/d/../f/g")
(if unix?
"a/b/c/f/g"
"a\\b\\c\\f\\g"))
(check (simple-form-path "a//b//c/d/.././../f/g")
(if unix?
"a/b/f/g"
"a\\b\\f\\g"))
(check (simple-form-path "../../a//b//c/d")
(if unix?
"../../a/b/c/d"
"..\\..\\a\\b\\c\\d"))
(check (find-relative-path "home/zuo/src" "home/zuo/src/private/optimize")
(build-path "private" "optimize"))
(check (find-relative-path "home/zuo/src" "home/zuo/lib")
(build-path ".." "lib"))
(check (find-relative-path "home/zuo/src" "home/zuo/src")
".")
(check (find-relative-path "home/zuo/src" "tmp/cache")
(build-path ".." ".." ".." "tmp" "cache"))
(check (find-relative-path "." (build-path "tmp" "cache"))
(build-path "tmp" "cache"))
(check (find-relative-path "tmp/cache" ".")
(build-path ".." ".."))
(check (find-relative-path "../bin/tarm64osx/bin/" "main.o")
(build-path ".." ".." ".." (cdr (split-path (hash-ref (runtime-env) 'dir))) "main.o"))
(let ([l (reverse (explode-path (hash-ref (runtime-env) 'dir)))])
(when (> (length l) 3)
(check (find-relative-path "../../../bin/tarm64osx/bin/" "../main.o")
(build-path ".." ".." ".." (list-ref l 2) (list-ref l 1) "main.o"))))
(check (find-relative-path "tmp/cache" "/home/zuo/src")
"/home/zuo/src")
(when unix?
(check (find-relative-path "/home/zuo/src" "/home/zuo/src/private/optimize")
"private/optimize")
(check (find-relative-path "/home/zuo/src" "/home/zuo/lib")
"../lib")
(check (find-relative-path "/home/zuo/src" "/home/zuo/src")
".")
(check (find-relative-path "/home/zuo/src" "/tmp/cache")
"../../../tmp/cache"))
(check (path-only "hello.txt") ".")
(check (path-only ".") ".")
(check (path-only "greeting/hello.txt") "greeting/")
(check (path-only "in/greeting/hello.txt") "in/greeting/")
(check (path-only "/") "/")
(check (path-only "a/") "a/")
(check (path-only "a\\") (if unix? "." "a\\"))
(check (path-only "a/.") "a/.")
(check (path-only "a/..") "a/..")
(check-arg-fail (path-only 10) not-path)
(check (file-name-from-path "hello.txt") "hello.txt")
(check (file-name-from-path ".") #f)
(check (file-name-from-path "greeting/hello.txt") "hello.txt")
(check (file-name-from-path "in/greeting/hello.txt") "hello.txt")
(check (file-name-from-path "/") #f)
(check (file-name-from-path "a/") #f)
(check (file-name-from-path "a\\") (if unix? "a\\" #f))
(check (file-name-from-path "a/.") #f)
(check (file-name-from-path "a/..") #f)
(check-arg-fail (file-name-from-path 10) not-path)
(check (path-replace-extension "a.c" ".o") "a.o")
(check (path-replace-extension "p/a.c" ".o") (build-path "p/a.o"))
(check (path-replace-extension "p/.rc" ".o") (build-path "p/.rc.o"))
(check-arg-fail (path-replace-extension 10 "x") not-path)
(check-arg-fail (path-replace-extension "x" 10) not-string)
|
