|
sl@0
|
1 |
# This file tests the filesystem and vfs internals.
|
|
sl@0
|
2 |
#
|
|
sl@0
|
3 |
# This file contains a collection of tests for one or more of the Tcl
|
|
sl@0
|
4 |
# built-in commands. Sourcing this file into Tcl runs the tests and
|
|
sl@0
|
5 |
# generates output for errors. No output means no errors were found.
|
|
sl@0
|
6 |
#
|
|
sl@0
|
7 |
# Copyright (c) 2002 Vincent Darley.
|
|
sl@0
|
8 |
#
|
|
sl@0
|
9 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
10 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
11 |
|
|
sl@0
|
12 |
package require tcltest 2
|
|
sl@0
|
13 |
namespace eval ::tcl::test::fileSystem {
|
|
sl@0
|
14 |
|
|
sl@0
|
15 |
catch {
|
|
sl@0
|
16 |
namespace import ::tcltest::cleanupTests
|
|
sl@0
|
17 |
namespace import ::tcltest::makeDirectory
|
|
sl@0
|
18 |
namespace import ::tcltest::makeFile
|
|
sl@0
|
19 |
namespace import ::tcltest::removeDirectory
|
|
sl@0
|
20 |
namespace import ::tcltest::removeFile
|
|
sl@0
|
21 |
namespace import ::tcltest::test
|
|
sl@0
|
22 |
}
|
|
sl@0
|
23 |
|
|
sl@0
|
24 |
catch {
|
|
sl@0
|
25 |
file delete -force link.file
|
|
sl@0
|
26 |
file delete -force dir.link
|
|
sl@0
|
27 |
file delete -force [file join dir.file linkinside.file]
|
|
sl@0
|
28 |
}
|
|
sl@0
|
29 |
|
|
sl@0
|
30 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
31 |
makeFile "test file" gorp.file
|
|
sl@0
|
32 |
makeDirectory dir.file
|
|
sl@0
|
33 |
makeFile "test file in directory" [file join dir.file inside.file]
|
|
sl@0
|
34 |
|
|
sl@0
|
35 |
if {[catch {
|
|
sl@0
|
36 |
file link link.file gorp.file
|
|
sl@0
|
37 |
file link \
|
|
sl@0
|
38 |
[file join dir.file linkinside.file] \
|
|
sl@0
|
39 |
[file join dir.file inside.file]
|
|
sl@0
|
40 |
file link dir.link dir.file
|
|
sl@0
|
41 |
}]} {
|
|
sl@0
|
42 |
tcltest::testConstraint hasLinks 0
|
|
sl@0
|
43 |
} else {
|
|
sl@0
|
44 |
tcltest::testConstraint hasLinks 1
|
|
sl@0
|
45 |
}
|
|
sl@0
|
46 |
|
|
sl@0
|
47 |
tcltest::testConstraint testsimplefilesystem \
|
|
sl@0
|
48 |
[string equal testsimplefilesystem [info commands testsimplefilesystem]]
|
|
sl@0
|
49 |
|
|
sl@0
|
50 |
test filesystem-1.0 {link normalisation} {hasLinks} {
|
|
sl@0
|
51 |
string equal [file normalize gorp.file] [file normalize link.file]
|
|
sl@0
|
52 |
} {0}
|
|
sl@0
|
53 |
|
|
sl@0
|
54 |
test filesystem-1.1 {link normalisation} {hasLinks} {
|
|
sl@0
|
55 |
string equal [file normalize dir.file] [file normalize dir.link]
|
|
sl@0
|
56 |
} {0}
|
|
sl@0
|
57 |
|
|
sl@0
|
58 |
test filesystem-1.2 {link normalisation} {hasLinks macOrUnix} {
|
|
sl@0
|
59 |
string equal [file normalize [file join gorp.file foo]] \
|
|
sl@0
|
60 |
[file normalize [file join link.file foo]]
|
|
sl@0
|
61 |
} {1}
|
|
sl@0
|
62 |
|
|
sl@0
|
63 |
test filesystem-1.3 {link normalisation} {hasLinks} {
|
|
sl@0
|
64 |
string equal [file normalize [file join dir.file foo]] \
|
|
sl@0
|
65 |
[file normalize [file join dir.link foo]]
|
|
sl@0
|
66 |
} {1}
|
|
sl@0
|
67 |
|
|
sl@0
|
68 |
test filesystem-1.4 {link normalisation} {hasLinks} {
|
|
sl@0
|
69 |
string equal [file normalize [file join dir.file inside.file]] \
|
|
sl@0
|
70 |
[file normalize [file join dir.link inside.file]]
|
|
sl@0
|
71 |
} {1}
|
|
sl@0
|
72 |
|
|
sl@0
|
73 |
test filesystem-1.5 {link normalisation} {hasLinks} {
|
|
sl@0
|
74 |
string equal [file normalize [file join dir.file linkinside.file]] \
|
|
sl@0
|
75 |
[file normalize [file join dir.file linkinside.file]]
|
|
sl@0
|
76 |
} {1}
|
|
sl@0
|
77 |
|
|
sl@0
|
78 |
test filesystem-1.6 {link normalisation} {hasLinks} {
|
|
sl@0
|
79 |
string equal [file normalize [file join dir.file linkinside.file]] \
|
|
sl@0
|
80 |
[file normalize [file join dir.link inside.file]]
|
|
sl@0
|
81 |
} {0}
|
|
sl@0
|
82 |
|
|
sl@0
|
83 |
test filesystem-1.7 {link normalisation} {hasLinks macOrUnix} {
|
|
sl@0
|
84 |
string equal [file normalize [file join dir.link linkinside.file foo]] \
|
|
sl@0
|
85 |
[file normalize [file join dir.file inside.file foo]]
|
|
sl@0
|
86 |
} {1}
|
|
sl@0
|
87 |
|
|
sl@0
|
88 |
test filesystem-1.8 {link normalisation} {hasLinks} {
|
|
sl@0
|
89 |
string equal [file normalize [file join dir.file linkinside.filefoo]] \
|
|
sl@0
|
90 |
[file normalize [file join dir.link inside.filefoo]]
|
|
sl@0
|
91 |
} {0}
|
|
sl@0
|
92 |
|
|
sl@0
|
93 |
test filesystem-1.9 {link normalisation} {macOrUnix hasLinks} {
|
|
sl@0
|
94 |
file delete -force dir.link
|
|
sl@0
|
95 |
file link dir.link [file nativename dir.file]
|
|
sl@0
|
96 |
string equal [file normalize [file join dir.file linkinside.file foo]] \
|
|
sl@0
|
97 |
[file normalize [file join dir.link inside.file foo]]
|
|
sl@0
|
98 |
} {1}
|
|
sl@0
|
99 |
|
|
sl@0
|
100 |
test filesystem-1.10 {link normalisation: double link} {macOrUnix hasLinks} {
|
|
sl@0
|
101 |
file link dir2.link dir.link
|
|
sl@0
|
102 |
string equal [file normalize [file join dir.file linkinside.file foo]] \
|
|
sl@0
|
103 |
[file normalize [file join dir2.link inside.file foo]]
|
|
sl@0
|
104 |
} {1}
|
|
sl@0
|
105 |
|
|
sl@0
|
106 |
makeDirectory dir2.file
|
|
sl@0
|
107 |
|
|
sl@0
|
108 |
test filesystem-1.11 {link normalisation: double link, back in tree} {macOrUnix hasLinks} {
|
|
sl@0
|
109 |
file link [file join dir2.file dir2.link] dir2.link
|
|
sl@0
|
110 |
string equal [file normalize [file join dir.file linkinside.file foo]] \
|
|
sl@0
|
111 |
[file normalize [file join dir2.file dir2.link inside.file foo]]
|
|
sl@0
|
112 |
} {1}
|
|
sl@0
|
113 |
|
|
sl@0
|
114 |
test filesystem-1.12 {file new native path} {} {
|
|
sl@0
|
115 |
for {set i 0} {$i < 10} {incr i} {
|
|
sl@0
|
116 |
foreach f [lsort [glob -nocomplain -type l *]] {
|
|
sl@0
|
117 |
catch {file readlink $f}
|
|
sl@0
|
118 |
}
|
|
sl@0
|
119 |
}
|
|
sl@0
|
120 |
# If we reach here we've succeeded. We used to crash above.
|
|
sl@0
|
121 |
expr 1
|
|
sl@0
|
122 |
} {1}
|
|
sl@0
|
123 |
|
|
sl@0
|
124 |
test filesystem-1.13 {file normalisation} {winOnly} {
|
|
sl@0
|
125 |
# This used to be broken
|
|
sl@0
|
126 |
file normalize C:/thislongnamedoesntexist
|
|
sl@0
|
127 |
} {C:/thislongnamedoesntexist}
|
|
sl@0
|
128 |
|
|
sl@0
|
129 |
test filesystem-1.14 {file normalisation} {winOnly} {
|
|
sl@0
|
130 |
# This used to be broken
|
|
sl@0
|
131 |
file normalize c:/
|
|
sl@0
|
132 |
} {C:/}
|
|
sl@0
|
133 |
|
|
sl@0
|
134 |
file delete -force dir2.file
|
|
sl@0
|
135 |
file delete -force dir2.link
|
|
sl@0
|
136 |
file delete -force link.file dir.link
|
|
sl@0
|
137 |
removeFile [file join dir.file inside.file]
|
|
sl@0
|
138 |
removeDirectory dir.file
|
|
sl@0
|
139 |
|
|
sl@0
|
140 |
test filesystem-2.0 {new native path} {unixOnly} {
|
|
sl@0
|
141 |
foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
|
|
sl@0
|
142 |
catch {file readlink $f}
|
|
sl@0
|
143 |
}
|
|
sl@0
|
144 |
# If we reach here we've succeeded. We used to crash above.
|
|
sl@0
|
145 |
expr 1
|
|
sl@0
|
146 |
} {1}
|
|
sl@0
|
147 |
|
|
sl@0
|
148 |
if {[catch {package require tcltest 2}]} {
|
|
sl@0
|
149 |
puts stderr "Skipping tests filesystem-{3,4}.*: tcltest 2 required."
|
|
sl@0
|
150 |
} else {
|
|
sl@0
|
151 |
namespace import ::tcltest::testConstraint
|
|
sl@0
|
152 |
|
|
sl@0
|
153 |
# Is the Tcltest package loaded?
|
|
sl@0
|
154 |
# - that is, the special C-coded testing commands in tclTest.c
|
|
sl@0
|
155 |
# - tests use testing commands introduced in Tcltest 8.4
|
|
sl@0
|
156 |
testConstraint Tcltest [expr {
|
|
sl@0
|
157 |
[llength [package provide Tcltest]]
|
|
sl@0
|
158 |
&& [package vsatisfies [package provide Tcltest] 8.4]}]
|
|
sl@0
|
159 |
|
|
sl@0
|
160 |
# Make sure the testfilesystem hasn't been registered.
|
|
sl@0
|
161 |
while {![catch {testfilesystem 0}]} {}
|
|
sl@0
|
162 |
|
|
sl@0
|
163 |
test filesystem-3.0 {Tcl_FSRegister} Tcltest {
|
|
sl@0
|
164 |
testfilesystem 1
|
|
sl@0
|
165 |
} {registered}
|
|
sl@0
|
166 |
|
|
sl@0
|
167 |
test filesystem-3.1 {Tcl_FSUnregister} Tcltest {
|
|
sl@0
|
168 |
testfilesystem 0
|
|
sl@0
|
169 |
} {unregistered}
|
|
sl@0
|
170 |
|
|
sl@0
|
171 |
test filesystem-3.2 {Tcl_FSUnregister} Tcltest {
|
|
sl@0
|
172 |
list [catch {testfilesystem 0} err] $err
|
|
sl@0
|
173 |
} {1 failed}
|
|
sl@0
|
174 |
|
|
sl@0
|
175 |
test filesystem-3.3 {Tcl_FSRegister} Tcltest {
|
|
sl@0
|
176 |
testfilesystem 1
|
|
sl@0
|
177 |
testfilesystem 1
|
|
sl@0
|
178 |
testfilesystem 0
|
|
sl@0
|
179 |
testfilesystem 0
|
|
sl@0
|
180 |
} {unregistered}
|
|
sl@0
|
181 |
|
|
sl@0
|
182 |
test filesystem-3.4 {Tcl_FSRegister} Tcltest {
|
|
sl@0
|
183 |
testfilesystem 1
|
|
sl@0
|
184 |
file system bar
|
|
sl@0
|
185 |
} {reporting}
|
|
sl@0
|
186 |
|
|
sl@0
|
187 |
test filesystem-3.5 {Tcl_FSUnregister} Tcltest {
|
|
sl@0
|
188 |
testfilesystem 0
|
|
sl@0
|
189 |
lindex [file system bar] 0
|
|
sl@0
|
190 |
} {native}
|
|
sl@0
|
191 |
|
|
sl@0
|
192 |
test filesystem-4.0 {testfilesystem} {
|
|
sl@0
|
193 |
-constraints Tcltest
|
|
sl@0
|
194 |
-match glob
|
|
sl@0
|
195 |
-body {
|
|
sl@0
|
196 |
testfilesystem 1
|
|
sl@0
|
197 |
set filesystemReport {}
|
|
sl@0
|
198 |
file exists foo
|
|
sl@0
|
199 |
testfilesystem 0
|
|
sl@0
|
200 |
set filesystemReport
|
|
sl@0
|
201 |
}
|
|
sl@0
|
202 |
-result {* {access foo}}
|
|
sl@0
|
203 |
}
|
|
sl@0
|
204 |
|
|
sl@0
|
205 |
test filesystem-4.1 {testfilesystem} {
|
|
sl@0
|
206 |
-constraints Tcltest
|
|
sl@0
|
207 |
-match glob
|
|
sl@0
|
208 |
-body {
|
|
sl@0
|
209 |
testfilesystem 1
|
|
sl@0
|
210 |
set filesystemReport {}
|
|
sl@0
|
211 |
catch {file stat foo bar}
|
|
sl@0
|
212 |
testfilesystem 0
|
|
sl@0
|
213 |
set filesystemReport
|
|
sl@0
|
214 |
}
|
|
sl@0
|
215 |
-result {* {stat foo}}
|
|
sl@0
|
216 |
}
|
|
sl@0
|
217 |
|
|
sl@0
|
218 |
test filesystem-4.2 {testfilesystem} {
|
|
sl@0
|
219 |
-constraints Tcltest
|
|
sl@0
|
220 |
-match glob
|
|
sl@0
|
221 |
-body {
|
|
sl@0
|
222 |
testfilesystem 1
|
|
sl@0
|
223 |
set filesystemReport {}
|
|
sl@0
|
224 |
catch {file lstat foo bar}
|
|
sl@0
|
225 |
testfilesystem 0
|
|
sl@0
|
226 |
set filesystemReport
|
|
sl@0
|
227 |
}
|
|
sl@0
|
228 |
-result {* {lstat foo}}
|
|
sl@0
|
229 |
}
|
|
sl@0
|
230 |
|
|
sl@0
|
231 |
test filesystem-4.3 {testfilesystem} {
|
|
sl@0
|
232 |
-constraints Tcltest
|
|
sl@0
|
233 |
-match glob
|
|
sl@0
|
234 |
-body {
|
|
sl@0
|
235 |
testfilesystem 1
|
|
sl@0
|
236 |
set filesystemReport {}
|
|
sl@0
|
237 |
catch {glob *}
|
|
sl@0
|
238 |
testfilesystem 0
|
|
sl@0
|
239 |
set filesystemReport
|
|
sl@0
|
240 |
}
|
|
sl@0
|
241 |
-result {* {matchindirectory *}*}
|
|
sl@0
|
242 |
}
|
|
sl@0
|
243 |
|
|
sl@0
|
244 |
test filesystem-5.1 {cache and ~} {
|
|
sl@0
|
245 |
-constraints Tcltest
|
|
sl@0
|
246 |
-match regexp
|
|
sl@0
|
247 |
-body {
|
|
sl@0
|
248 |
set orig $env(HOME)
|
|
sl@0
|
249 |
set ::env(HOME) /foo/bar/blah
|
|
sl@0
|
250 |
set testdir ~
|
|
sl@0
|
251 |
set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
|
|
sl@0
|
252 |
set ::env(HOME) /a/b/c
|
|
sl@0
|
253 |
set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
|
|
sl@0
|
254 |
set ::env(HOME) $orig
|
|
sl@0
|
255 |
list $res1 $res2
|
|
sl@0
|
256 |
}
|
|
sl@0
|
257 |
-result {{Parent of ~ \(/foo/bar/blah\) is (/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is (/a/b|a:b)}}
|
|
sl@0
|
258 |
}
|
|
sl@0
|
259 |
|
|
sl@0
|
260 |
test filesystem-6.1 {empty file name} {
|
|
sl@0
|
261 |
list [catch {open ""} msg] $msg
|
|
sl@0
|
262 |
} {1 {couldn't open "": no such file or directory}}
|
|
sl@0
|
263 |
|
|
sl@0
|
264 |
test filesystem-6.2 {empty file name} {
|
|
sl@0
|
265 |
list [catch {file stat "" arr} msg] $msg
|
|
sl@0
|
266 |
} {1 {could not read "": no such file or directory}}
|
|
sl@0
|
267 |
|
|
sl@0
|
268 |
test filesystem-6.3 {empty file name} {
|
|
sl@0
|
269 |
list [catch {file atime ""} msg] $msg
|
|
sl@0
|
270 |
} {1 {could not read "": no such file or directory}}
|
|
sl@0
|
271 |
|
|
sl@0
|
272 |
test filesystem-6.4 {empty file name} {
|
|
sl@0
|
273 |
list [catch {file attributes ""} msg] $msg
|
|
sl@0
|
274 |
} {1 {could not read "": no such file or directory}}
|
|
sl@0
|
275 |
|
|
sl@0
|
276 |
test filesystem-6.5 {empty file name} {
|
|
sl@0
|
277 |
list [catch {file copy "" ""} msg] $msg
|
|
sl@0
|
278 |
} {1 {error copying "": no such file or directory}}
|
|
sl@0
|
279 |
|
|
sl@0
|
280 |
test filesystem-6.6 {empty file name} {
|
|
sl@0
|
281 |
list [catch {file delete ""} msg] $msg
|
|
sl@0
|
282 |
} {0 {}}
|
|
sl@0
|
283 |
|
|
sl@0
|
284 |
test filesystem-6.7 {empty file name} {
|
|
sl@0
|
285 |
list [catch {file dirname ""} msg] $msg
|
|
sl@0
|
286 |
} {0 .}
|
|
sl@0
|
287 |
|
|
sl@0
|
288 |
test filesystem-6.8 {empty file name} {
|
|
sl@0
|
289 |
list [catch {file executable ""} msg] $msg
|
|
sl@0
|
290 |
} {0 0}
|
|
sl@0
|
291 |
|
|
sl@0
|
292 |
test filesystem-6.9 {empty file name} {
|
|
sl@0
|
293 |
list [catch {file exists ""} msg] $msg
|
|
sl@0
|
294 |
} {0 0}
|
|
sl@0
|
295 |
|
|
sl@0
|
296 |
test filesystem-6.10 {empty file name} {
|
|
sl@0
|
297 |
list [catch {file extension ""} msg] $msg
|
|
sl@0
|
298 |
} {0 {}}
|
|
sl@0
|
299 |
|
|
sl@0
|
300 |
test filesystem-6.11 {empty file name} {
|
|
sl@0
|
301 |
list [catch {file isdirectory ""} msg] $msg
|
|
sl@0
|
302 |
} {0 0}
|
|
sl@0
|
303 |
|
|
sl@0
|
304 |
test filesystem-6.12 {empty file name} {
|
|
sl@0
|
305 |
list [catch {file isfile ""} msg] $msg
|
|
sl@0
|
306 |
} {0 0}
|
|
sl@0
|
307 |
|
|
sl@0
|
308 |
test filesystem-6.13 {empty file name} {
|
|
sl@0
|
309 |
list [catch {file join ""} msg] $msg
|
|
sl@0
|
310 |
} {0 {}}
|
|
sl@0
|
311 |
|
|
sl@0
|
312 |
test filesystem-6.14 {empty file name} {
|
|
sl@0
|
313 |
list [catch {file link ""} msg] $msg
|
|
sl@0
|
314 |
} {1 {could not read link "": no such file or directory}}
|
|
sl@0
|
315 |
|
|
sl@0
|
316 |
test filesystem-6.15 {empty file name} {
|
|
sl@0
|
317 |
list [catch {file lstat "" arr} msg] $msg
|
|
sl@0
|
318 |
} {1 {could not read "": no such file or directory}}
|
|
sl@0
|
319 |
|
|
sl@0
|
320 |
test filesystem-6.16 {empty file name} {
|
|
sl@0
|
321 |
list [catch {file mtime ""} msg] $msg
|
|
sl@0
|
322 |
} {1 {could not read "": no such file or directory}}
|
|
sl@0
|
323 |
|
|
sl@0
|
324 |
test filesystem-6.17 {empty file name} {
|
|
sl@0
|
325 |
list [catch {file mtime "" 0} msg] $msg
|
|
sl@0
|
326 |
} {1 {could not read "": no such file or directory}}
|
|
sl@0
|
327 |
|
|
sl@0
|
328 |
test filesystem-6.18 {empty file name} {
|
|
sl@0
|
329 |
list [catch {file mkdir ""} msg] $msg
|
|
sl@0
|
330 |
} {1 {can't create directory "": no such file or directory}}
|
|
sl@0
|
331 |
|
|
sl@0
|
332 |
test filesystem-6.19 {empty file name} {
|
|
sl@0
|
333 |
list [catch {file nativename ""} msg] $msg
|
|
sl@0
|
334 |
} {0 {}}
|
|
sl@0
|
335 |
|
|
sl@0
|
336 |
test filesystem-6.20 {empty file name} {
|
|
sl@0
|
337 |
list [catch {file normalize ""} msg] $msg
|
|
sl@0
|
338 |
} {0 {}}
|
|
sl@0
|
339 |
|
|
sl@0
|
340 |
test filesystem-6.21 {empty file name} {
|
|
sl@0
|
341 |
list [catch {file owned ""} msg] $msg
|
|
sl@0
|
342 |
} {0 0}
|
|
sl@0
|
343 |
|
|
sl@0
|
344 |
test filesystem-6.22 {empty file name} {
|
|
sl@0
|
345 |
list [catch {file pathtype ""} msg] $msg
|
|
sl@0
|
346 |
} {0 relative}
|
|
sl@0
|
347 |
|
|
sl@0
|
348 |
test filesystem-6.23 {empty file name} {
|
|
sl@0
|
349 |
list [catch {file readable ""} msg] $msg
|
|
sl@0
|
350 |
} {0 0}
|
|
sl@0
|
351 |
|
|
sl@0
|
352 |
test filesystem-6.24 {empty file name} {
|
|
sl@0
|
353 |
list [catch {file readlink ""} msg] $msg
|
|
sl@0
|
354 |
} {1 {could not readlink "": no such file or directory}}
|
|
sl@0
|
355 |
|
|
sl@0
|
356 |
test filesystem-6.25 {empty file name} {
|
|
sl@0
|
357 |
list [catch {file rename "" ""} msg] $msg
|
|
sl@0
|
358 |
} {1 {error renaming "": no such file or directory}}
|
|
sl@0
|
359 |
|
|
sl@0
|
360 |
test filesystem-6.26 {empty file name} {
|
|
sl@0
|
361 |
list [catch {file rootname ""} msg] $msg
|
|
sl@0
|
362 |
} {0 {}}
|
|
sl@0
|
363 |
|
|
sl@0
|
364 |
test filesystem-6.27 {empty file name} {
|
|
sl@0
|
365 |
list [catch {file separator ""} msg] $msg
|
|
sl@0
|
366 |
} {1 {Unrecognised path}}
|
|
sl@0
|
367 |
|
|
sl@0
|
368 |
test filesystem-6.28 {empty file name} {
|
|
sl@0
|
369 |
list [catch {file size ""} msg] $msg
|
|
sl@0
|
370 |
} {1 {could not read "": no such file or directory}}
|
|
sl@0
|
371 |
|
|
sl@0
|
372 |
test filesystem-6.29 {empty file name} {
|
|
sl@0
|
373 |
list [catch {file split ""} msg] $msg
|
|
sl@0
|
374 |
} {0 {}}
|
|
sl@0
|
375 |
|
|
sl@0
|
376 |
test filesystem-6.30 {empty file name} {
|
|
sl@0
|
377 |
list [catch {file system ""} msg] $msg
|
|
sl@0
|
378 |
} {1 {Unrecognised path}}
|
|
sl@0
|
379 |
|
|
sl@0
|
380 |
test filesystem-6.31 {empty file name} {
|
|
sl@0
|
381 |
list [catch {file tail ""} msg] $msg
|
|
sl@0
|
382 |
} {0 {}}
|
|
sl@0
|
383 |
|
|
sl@0
|
384 |
test filesystem-6.32 {empty file name} {
|
|
sl@0
|
385 |
list [catch {file type ""} msg] $msg
|
|
sl@0
|
386 |
} {1 {could not read "": no such file or directory}}
|
|
sl@0
|
387 |
|
|
sl@0
|
388 |
test filesystem-6.33 {empty file name} {
|
|
sl@0
|
389 |
list [catch {file writable ""} msg] $msg
|
|
sl@0
|
390 |
} {0 0}
|
|
sl@0
|
391 |
|
|
sl@0
|
392 |
# Make sure the testfilesystem hasn't been registered.
|
|
sl@0
|
393 |
while {![catch {testfilesystem 0}]} {}
|
|
sl@0
|
394 |
}
|
|
sl@0
|
395 |
|
|
sl@0
|
396 |
test filesystem-7.1 {load from vfs} {win testsimplefilesystem} {
|
|
sl@0
|
397 |
# This may cause a crash on exit
|
|
sl@0
|
398 |
set dir [pwd]
|
|
sl@0
|
399 |
cd [file dirname [info nameof]]
|
|
sl@0
|
400 |
set dde [lindex [glob *dde*[info sharedlib]] 0]
|
|
sl@0
|
401 |
testsimplefilesystem 1
|
|
sl@0
|
402 |
# This loads dde via a complex copy-to-temp operation
|
|
sl@0
|
403 |
load simplefs:/$dde dde
|
|
sl@0
|
404 |
testsimplefilesystem 0
|
|
sl@0
|
405 |
cd $dir
|
|
sl@0
|
406 |
set res "ok"
|
|
sl@0
|
407 |
# The real result of this test is what happens when Tcl exits.
|
|
sl@0
|
408 |
} {ok}
|
|
sl@0
|
409 |
|
|
sl@0
|
410 |
test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} \
|
|
sl@0
|
411 |
{testsimplefilesystem} {
|
|
sl@0
|
412 |
set dir [pwd]
|
|
sl@0
|
413 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
414 |
# We created this file several tests ago.
|
|
sl@0
|
415 |
set origtime [file mtime gorp.file]
|
|
sl@0
|
416 |
testsimplefilesystem 1
|
|
sl@0
|
417 |
file delete -force theCopy
|
|
sl@0
|
418 |
file copy simplefs:/gorp.file theCopy
|
|
sl@0
|
419 |
testsimplefilesystem 0
|
|
sl@0
|
420 |
set newtime [file mtime theCopy]
|
|
sl@0
|
421 |
file delete theCopy
|
|
sl@0
|
422 |
cd $dir
|
|
sl@0
|
423 |
expr {$origtime == $newtime}
|
|
sl@0
|
424 |
} {1}
|
|
sl@0
|
425 |
|
|
sl@0
|
426 |
removeFile gorp.file
|
|
sl@0
|
427 |
|
|
sl@0
|
428 |
test filesystem-8.1 {relative path objects and caching of pwd} {
|
|
sl@0
|
429 |
set dir [pwd]
|
|
sl@0
|
430 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
431 |
makeDirectory abc
|
|
sl@0
|
432 |
makeDirectory def
|
|
sl@0
|
433 |
makeFile "contents" [file join abc foo]
|
|
sl@0
|
434 |
cd abc
|
|
sl@0
|
435 |
set f "foo"
|
|
sl@0
|
436 |
set res {}
|
|
sl@0
|
437 |
lappend res [file exists $f]
|
|
sl@0
|
438 |
lappend res [file exists $f]
|
|
sl@0
|
439 |
cd ..
|
|
sl@0
|
440 |
cd def
|
|
sl@0
|
441 |
# If we haven't cleared the object's cwd cache, Tcl
|
|
sl@0
|
442 |
# will think it still exists.
|
|
sl@0
|
443 |
lappend res [file exists $f]
|
|
sl@0
|
444 |
lappend res [file exists $f]
|
|
sl@0
|
445 |
removeFile [file join abc foo]
|
|
sl@0
|
446 |
removeDirectory abc
|
|
sl@0
|
447 |
removeDirectory def
|
|
sl@0
|
448 |
cd $dir
|
|
sl@0
|
449 |
set res
|
|
sl@0
|
450 |
} {1 1 0 0}
|
|
sl@0
|
451 |
|
|
sl@0
|
452 |
test filesystem-8.2 {relative path objects and use of pwd} {
|
|
sl@0
|
453 |
set origdir [pwd]
|
|
sl@0
|
454 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
455 |
set dir "abc"
|
|
sl@0
|
456 |
makeDirectory $dir
|
|
sl@0
|
457 |
makeFile "contents" [file join abc foo]
|
|
sl@0
|
458 |
cd $dir
|
|
sl@0
|
459 |
set res [file exists [lindex [glob *] 0]]
|
|
sl@0
|
460 |
cd ..
|
|
sl@0
|
461 |
removeFile [file join abc foo]
|
|
sl@0
|
462 |
removeDirectory abc
|
|
sl@0
|
463 |
cd $origdir
|
|
sl@0
|
464 |
set res
|
|
sl@0
|
465 |
} {1}
|
|
sl@0
|
466 |
|
|
sl@0
|
467 |
test filesystem-8.3 {path objects and empty string} {
|
|
sl@0
|
468 |
set anchor ""
|
|
sl@0
|
469 |
set dst foo
|
|
sl@0
|
470 |
set res $dst
|
|
sl@0
|
471 |
|
|
sl@0
|
472 |
set yyy [file split $anchor]
|
|
sl@0
|
473 |
set dst [file join $anchor $dst]
|
|
sl@0
|
474 |
lappend res $dst $yyy
|
|
sl@0
|
475 |
} {foo foo {}}
|
|
sl@0
|
476 |
|
|
sl@0
|
477 |
proc TestFind1 {d f} {
|
|
sl@0
|
478 |
set r1 [file exists [file join $d $f]]
|
|
sl@0
|
479 |
lappend res "[file join $d $f] found: $r1"
|
|
sl@0
|
480 |
lappend res "is dir a dir? [file isdirectory $d]"
|
|
sl@0
|
481 |
set r2 [file exists [file join $d $f]]
|
|
sl@0
|
482 |
lappend res "[file join $d $f] found: $r2"
|
|
sl@0
|
483 |
set res
|
|
sl@0
|
484 |
}
|
|
sl@0
|
485 |
proc TestFind2 {d f} {
|
|
sl@0
|
486 |
set r1 [file exists [file join $d $f]]
|
|
sl@0
|
487 |
lappend res "[file join $d $f] found: $r1"
|
|
sl@0
|
488 |
lappend res "is dir a dir? [file isdirectory [file join $d]]"
|
|
sl@0
|
489 |
set r2 [file exists [file join $d $f]]
|
|
sl@0
|
490 |
lappend res "[file join $d $f] found: $r2"
|
|
sl@0
|
491 |
set res
|
|
sl@0
|
492 |
}
|
|
sl@0
|
493 |
|
|
sl@0
|
494 |
test filesystem-9.1 {path objects and join and object rep} {
|
|
sl@0
|
495 |
set origdir [pwd]
|
|
sl@0
|
496 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
497 |
file mkdir [file join a b c]
|
|
sl@0
|
498 |
set res [TestFind1 a [file join b . c]]
|
|
sl@0
|
499 |
file delete -force a
|
|
sl@0
|
500 |
cd $origdir
|
|
sl@0
|
501 |
set res
|
|
sl@0
|
502 |
} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
|
|
sl@0
|
503 |
|
|
sl@0
|
504 |
test filesystem-9.2 {path objects and join and object rep} {
|
|
sl@0
|
505 |
set origdir [pwd]
|
|
sl@0
|
506 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
507 |
file mkdir [file join a b c]
|
|
sl@0
|
508 |
set res [TestFind2 a [file join b . c]]
|
|
sl@0
|
509 |
file delete -force a
|
|
sl@0
|
510 |
cd $origdir
|
|
sl@0
|
511 |
set res
|
|
sl@0
|
512 |
} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
|
|
sl@0
|
513 |
|
|
sl@0
|
514 |
test filesystem-9.2.1 {path objects and join and object rep} {
|
|
sl@0
|
515 |
set origdir [pwd]
|
|
sl@0
|
516 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
517 |
file mkdir [file join a b c]
|
|
sl@0
|
518 |
set res [TestFind2 a [file join b .]]
|
|
sl@0
|
519 |
file delete -force a
|
|
sl@0
|
520 |
cd $origdir
|
|
sl@0
|
521 |
set res
|
|
sl@0
|
522 |
} {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
|
|
sl@0
|
523 |
|
|
sl@0
|
524 |
test filesystem-9.3 {path objects and join and object rep} {
|
|
sl@0
|
525 |
set origdir [pwd]
|
|
sl@0
|
526 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
527 |
file mkdir [file join a b c]
|
|
sl@0
|
528 |
set res [TestFind1 a [file join b .. b c]]
|
|
sl@0
|
529 |
file delete -force a
|
|
sl@0
|
530 |
cd $origdir
|
|
sl@0
|
531 |
set res
|
|
sl@0
|
532 |
} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
|
|
sl@0
|
533 |
|
|
sl@0
|
534 |
test filesystem-9.4 {path objects and join and object rep} {
|
|
sl@0
|
535 |
set origdir [pwd]
|
|
sl@0
|
536 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
537 |
file mkdir [file join a b c]
|
|
sl@0
|
538 |
set res [TestFind2 a [file join b .. b c]]
|
|
sl@0
|
539 |
file delete -force a
|
|
sl@0
|
540 |
cd $origdir
|
|
sl@0
|
541 |
set res
|
|
sl@0
|
542 |
} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
|
|
sl@0
|
543 |
|
|
sl@0
|
544 |
test filesystem-9.5 {path objects and file tail and object rep} {
|
|
sl@0
|
545 |
set origdir [pwd]
|
|
sl@0
|
546 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
547 |
file mkdir dgp
|
|
sl@0
|
548 |
close [open dgp/test w]
|
|
sl@0
|
549 |
foreach relative [glob -nocomplain [file join * test]] {
|
|
sl@0
|
550 |
set absolute [file join [pwd] $relative]
|
|
sl@0
|
551 |
set res [list [file tail $absolute] "test"]
|
|
sl@0
|
552 |
}
|
|
sl@0
|
553 |
file delete -force dgp
|
|
sl@0
|
554 |
cd $origdir
|
|
sl@0
|
555 |
set res
|
|
sl@0
|
556 |
} {test test}
|
|
sl@0
|
557 |
|
|
sl@0
|
558 |
test filesystem-9.6 {path objects and file join and object rep} {winOnly} {
|
|
sl@0
|
559 |
set res {}
|
|
sl@0
|
560 |
set p "C:\\toto"
|
|
sl@0
|
561 |
lappend res [file join $p toto]
|
|
sl@0
|
562 |
file isdirectory $p
|
|
sl@0
|
563 |
lappend res [file join $p toto]
|
|
sl@0
|
564 |
} {C:/toto/toto C:/toto/toto}
|
|
sl@0
|
565 |
|
|
sl@0
|
566 |
test filesystem-9.7 {path objects and glob and file tail and tilde} {
|
|
sl@0
|
567 |
set res {}
|
|
sl@0
|
568 |
set origdir [pwd]
|
|
sl@0
|
569 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
570 |
file mkdir tilde
|
|
sl@0
|
571 |
close [open tilde/~testNotExist w]
|
|
sl@0
|
572 |
cd tilde
|
|
sl@0
|
573 |
set file [lindex [glob *test*] 0]
|
|
sl@0
|
574 |
lappend res [file exists $file] [catch {file tail $file} r] $r
|
|
sl@0
|
575 |
lappend res $file
|
|
sl@0
|
576 |
lappend res [file exists $file] [catch {file tail $file} r] $r
|
|
sl@0
|
577 |
lappend res [catch {file tail $file} r] $r
|
|
sl@0
|
578 |
cd ..
|
|
sl@0
|
579 |
file delete -force tilde
|
|
sl@0
|
580 |
cd $origdir
|
|
sl@0
|
581 |
set res
|
|
sl@0
|
582 |
} {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
|
|
sl@0
|
583 |
test filesystem-9.8 {path objects and glob and file tail and tilde} {
|
|
sl@0
|
584 |
set res {}
|
|
sl@0
|
585 |
set origdir [pwd]
|
|
sl@0
|
586 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
587 |
file mkdir tilde
|
|
sl@0
|
588 |
close [open tilde/~testNotExist w]
|
|
sl@0
|
589 |
cd tilde
|
|
sl@0
|
590 |
set file1 [lindex [glob *test*] 0]
|
|
sl@0
|
591 |
set file2 "~testNotExist"
|
|
sl@0
|
592 |
lappend res $file1 $file2
|
|
sl@0
|
593 |
lappend res [catch {file tail $file1} r] $r
|
|
sl@0
|
594 |
lappend res [catch {file tail $file2} r] $r
|
|
sl@0
|
595 |
cd ..
|
|
sl@0
|
596 |
file delete -force tilde
|
|
sl@0
|
597 |
cd $origdir
|
|
sl@0
|
598 |
set res
|
|
sl@0
|
599 |
} {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
|
|
sl@0
|
600 |
test filesystem-9.9 {path objects and glob and file tail and tilde} {
|
|
sl@0
|
601 |
set res {}
|
|
sl@0
|
602 |
set origdir [pwd]
|
|
sl@0
|
603 |
cd [tcltest::temporaryDirectory]
|
|
sl@0
|
604 |
file mkdir tilde
|
|
sl@0
|
605 |
close [open tilde/~testNotExist w]
|
|
sl@0
|
606 |
cd tilde
|
|
sl@0
|
607 |
set file1 [lindex [glob *test*] 0]
|
|
sl@0
|
608 |
set file2 "~testNotExist"
|
|
sl@0
|
609 |
lappend res [catch {file exists $file1} r] $r
|
|
sl@0
|
610 |
lappend res [catch {file exists $file2} r] $r
|
|
sl@0
|
611 |
lappend res [string equal $file1 $file2]
|
|
sl@0
|
612 |
cd ..
|
|
sl@0
|
613 |
file delete -force tilde
|
|
sl@0
|
614 |
cd $origdir
|
|
sl@0
|
615 |
set res
|
|
sl@0
|
616 |
} {0 0 0 0 1}
|
|
sl@0
|
617 |
|
|
sl@0
|
618 |
cleanupTests
|
|
sl@0
|
619 |
}
|
|
sl@0
|
620 |
namespace delete ::tcl::test::fileSystem
|
|
sl@0
|
621 |
return
|