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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
#lang zuo
(require "harness.zuo")
(alert "filesystem")
(check (hash? (stat tmp-dir #f)))
(check (stat (build-path tmp-dir "nonesuch.txt") #f) #f)
(let ([s (stat tmp-dir #f)])
(check (hash-ref s 'type) 'dir))
(check (directory-exists? tmp-dir))
(check (file-exists? tmp-dir) #f)
(check (link-exists? tmp-dir) #f)
(check-arg-fail (stat 10) not-path)
(define now (current-time))
(define exists.txt (build-path tmp-dir "exists.txt"))
(let ([fd (fd-open-output exists.txt :truncate)])
(fd-write fd "xyz")
(fd-close fd))
(define exists2.txt (build-path tmp-dir "exists2.txt"))
(fd-close (fd-open-output exists2.txt :can-update))
(check (file-exists? exists.txt))
(check (file-exists? exists2.txt))
(check (directory-exists? exists2.txt) #f)
(check (link-exists? exists2.txt) #f)
(check-arg-fail (file-exists? 10) not-path)
(check-arg-fail (directory-exists? 10) not-path)
(check-arg-fail (link-exists? 10) not-path)
(let ([s (stat exists.txt #f)])
(check (hash? s))
(check (hash-ref s 'type) 'file)
(check (hash-ref s 'size) 3)
;; Seems to be too precise for some Linux configurations:
#;
(check (or (> (hash-ref s 'modify-time-seconds) (car now))
(and (= (hash-ref s 'modify-time-seconds) (car now))
(>= (hash-ref s 'modify-time-nanoseconds) (cdr now)))))
(check (>= (hash-ref s 'modify-time-seconds) (car now)))
(let ([s2 (stat exists.txt #t)])
(check s s2))
(let ([s2 (stat exists2.txt #t)])
(check (hash? s2))
(check (not (equal? (hash-ref s 'inode) (hash-ref s2 'inode))))
(check (equal? (hash-ref s 'device-id) (hash-ref s2 'device-id)))))
(let ([l (ls tmp-dir)])
(check (pair? (member "exists.txt" l)))
(check (pair? (member "exists2.txt" l))))
(check-arg-fail (ls 10) not-path)
(rm exists2.txt)
(check (stat exists2.txt #t) #f)
(check (member "exists2.txt" (ls tmp-dir)) #f)
(define sub-dir (build-path tmp-dir "sub"))
(rm* sub-dir)
(check (directory-exists? sub-dir) #f)
(check (mkdir sub-dir) (void))
(check (directory-exists? sub-dir))
(check-arg-fail (mkdir 10) not-path)
(define sub-sub-dir (build-path sub-dir "subsub"))
(check (directory-exists? sub-sub-dir) #f)
(check (mkdir sub-sub-dir) (void))
(check (directory-exists? sub-sub-dir))
(check (rmdir sub-sub-dir) (void))
(check (directory-exists? sub-sub-dir) #f)
(check (mkdir sub-sub-dir) (void))
(fd-close (fd-open-output (build-path sub-sub-dir "apple") :can-update))
(fd-close (fd-open-output (build-path sub-sub-dir "banana") :can-update))
(fd-close (fd-open-output (build-path sub-sub-dir "cherry") :can-update))
(fd-close (fd-open-output (build-path sub-dir "donut") :can-update))
(check (length (ls sub-dir)) 2)
(check (length (ls sub-sub-dir)) 3)
(check (void? (mv (build-path sub-sub-dir "banana")
(build-path sub-dir "banana"))))
(check (length (ls sub-dir)) 3)
(check (length (ls sub-sub-dir)) 2)
(check (void? (mv (build-path sub-dir "banana")
(build-path sub-sub-dir "eclair"))))
(let ([l (ls sub-sub-dir)])
(check (pair? (member "apple" l)))
(check (pair? (member "cherry" l)))
(check (pair? (member "eclair" l)))
(check (not (member "banana" l))))
(check-arg-fail (mv 10 "x") not-path)
(check-arg-fail (mv "x" 10) not-path)
(check-fail (rm ,sub-dir) "failed")
(check-arg-fail (rm 10) not-path)
(rm* sub-dir)
(check (directory-exists? sub-sub-dir) #f)
(check (directory-exists? sub-dir) #f)
(check-arg-fail (rm* 10) not-path)
(mkdir-p sub-sub-dir)
(check (directory-exists? sub-sub-dir))
(check (directory-exists? sub-dir))
(check-arg-fail (mkdir-p 10) not-path)
(when (eq? 'unix (hash-ref (runtime-env) 'system-type))
(let ([fd (fd-open-output (build-path sub-dir "high") :can-update)])
(fd-write fd "HIGH")
(fd-close fd))
(let ([fd (fd-open-output (build-path sub-sub-dir "low") :can-update)])
(fd-write fd "LOW")
(fd-close fd))
(define (get path)
(let ([fd (fd-open-input path)])
(define v (fd-read fd eof))
(fd-close fd)
v))
(symlink "low" (build-path sub-sub-dir "below"))
(check (get (build-path sub-sub-dir "below")) "LOW")
(check (readlink (build-path sub-sub-dir "below")) "low")
(check (hash-ref (stat (build-path sub-sub-dir "below") #f) 'type) 'link)
(check (hash-ref (stat (build-path sub-sub-dir "below") #t) 'type) 'file)
(check (link-exists? (build-path sub-sub-dir "below")))
(check (rm (build-path sub-sub-dir "below")) (void))
(check (get (build-path sub-sub-dir "low")) "LOW")
(symlink "../high" (build-path sub-sub-dir "above"))
(check (get (build-path sub-sub-dir "above")) "HIGH")
(check (readlink (build-path sub-sub-dir "above")) "../high")
(check (rm (build-path sub-sub-dir "above")) (void))
(check (get (build-path sub-dir "high")) "HIGH")
(symlink ".." (build-path sub-sub-dir "again"))
(check (link-exists? (build-path sub-sub-dir "again")))
(check (hash-ref (stat (build-path sub-sub-dir "again") #f) 'type) 'link)
(check (hash-ref (stat (build-path sub-sub-dir "again") #t) 'type) 'dir)
(check (get (build-path sub-sub-dir "again" "high")) "HIGH")
(check (get (build-path sub-sub-dir "again" "subsub" "low")) "LOW")
(check (ls sub-dir) (ls (build-path sub-sub-dir "again")))
(rm* sub-sub-dir)
(check (get (build-path sub-dir "high")) "HIGH")
(void))
(check-arg-fail (readlink 10) not-path)
(check-arg-fail (symlink 10 "a") not-path)
(check-arg-fail (symlink "a" 10) not-path)
(rm* sub-dir)
(check (cp exists.txt exists2.txt) (void))
(check (equal? (hash-ref (stat exists.txt) 'mode)
(hash-ref (stat exists2.txt) 'mode)))
(check (file-exists? exists.txt))
(check (file-exists? exists2.txt))
(check (cp exists.txt exists2.txt (hash 'replace-mode #f)) (void))
(check (cp exists.txt exists2.txt :no-replace-mode) (void))
(check-arg-fail (cp "exists.txt" "exists2.txt" 'oops) "not a hash")
(check-arg-fail (cp "exists.txt" "exists2.txt" (hash 'mode 'oops)) "not an integer")
(check-arg-fail (cp "exists.txt" "exists2.txt" (hash 'other 0)) "unrecognized or unused option")
|
