blob: de4bf8e3defcc7c4fc2b140bf35a846594be0f65 (
plain)
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
|
(define-module (test hnh-util-path)
:use-module (srfi srfi-64)
:use-module (srfi srfi-64 test-error)
:use-module (srfi srfi-88)
:use-module ((hnh util env) :select (with-working-directory))
:use-module (hnh util path))
(test-equal
"no slashes"
"home/user"
(path-append "home" "user"))
(test-equal
"no slashes, absolute"
"/home/user"
(path-append "" "home" "user"))
(test-equal
"slashes in one component, absolute"
"/home/user"
(path-append "" "/home/" "user"))
(test-equal
"slashes in one component, absolute due to first"
"/home/user"
(path-append "/home/" "user"))
(test-equal
"Slashes in both"
"home/user"
(path-append "home/" "/user"))
(test-equal "root" "/" (path-append ""))
(test-equal
'("usr" "lib" "test")
(path-split "usr/lib/test"))
(test-equal
'("usr" "lib" "test")
(path-split "usr/lib/test/"))
(test-equal
'("" "usr" "lib" "test")
(path-split "/usr/lib/test"))
(test-equal
'("" "usr" "lib" "test")
(path-split "//usr////lib/test"))
(test-assert (file-hidden? ".just-filename"))
(test-assert (file-hidden? "/path/to/.hidden"))
(test-assert (not (file-hidden? "/visible/.in/hidden")))
(test-assert (not (file-hidden? "")))
;; TODO test realpath with .. and similar
(test-equal "Realpath for path fragment"
"/home/hugo"
(with-working-directory
"/home"
(lambda () (realpath "hugo"))))
(test-equal "Realpath for already absolute path"
"/home/hugo"
(with-working-directory
"/tmp"
(lambda () (realpath "/home/hugo"))))
(test-equal "Realpath for already absolute path"
"/home/hugo"
(with-working-directory
"/tmp"
(lambda () (realpath "/home/hugo"))))
(test-group "Relative to"
(test-group "With relative child"
(test-equal "/some/path" (relative-to "/some" "path")))
;; Relative parent just adds (getcwd) to start of parent,
;; but this is "hard" to test.
;; (test-group "With relative parent")
(test-group "With absolute child"
(test-error 'misc-error (relative-to "" "/some/path"))
(test-equal "some/path" (relative-to "/" "/some/path"))
(test-group "Without trailing slashes"
(test-equal "path" (relative-to "/some" "/some/path"))
(test-equal "../path" (relative-to "/some" "/other/path")))
(test-group "With trailing slashes"
(test-equal "path" (relative-to "/some" "/some/path/"))
(test-equal "../path" (relative-to "/some" "/other/path/"))))
(test-equal "/a/b" (relative-to "/a/b/c" "/a/b"))
)
(test-equal "Extension of simple file"
"txt" (filename-extension "file.txt"))
(test-equal "Extension of file with directory"
"txt" (filename-extension "/direcotry/file.txt"))
(test-equal "Extension of file with multiple"
"gz" (filename-extension "filename.tar.gz"))
(test-equal "Filename extension when none is present"
"" (filename-extension "filename"))
(test-equal "Filename extension when none is present, but directory has"
"" (filename-extension "config.d/filename"))
(test-equal "Filename extension of directory"
"d" (filename-extension "config.d/"))
(test-equal "Extension of hidden file"
"sh" (filename-extension ".bashrc.sh"))
(test-equal "Extension of hidden file without extension"
"bashrc" (filename-extension ".bashrc"))
|
