OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [fCmd.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# This file tests the tclFCmd.c file.
2 
#
3 
# This file contains a collection of tests for one or more of the Tcl
4 
# built-in commands.  Sourcing this file into Tcl runs the tests and
5 
# generates output for errors.  No output means no errors were found.
6 
#
7 
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
8 
#
9 
# See the file "license.terms" for information on usage and redistribution
10 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 
#
12 
# RCS: @(#) $Id: fCmd.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
13 
#
14 
 
15 
if {[string compare test [info procs test]] == 1} then {source defs}
16 
 
17 
set platform [testgetplatform]
18 
 
19 
if {$user == "root"} {
20 
    puts "Skipping fCmd tests.  They depend on not being able to write to"
21 
    puts "certain directories.  It would be too dangerous to run them as root."
22 
    return
23 
}
24 
 
25 
if {"[info commands testchmod]" != "testchmod"} {
26 
    puts "Skipping fCmd tests. This application does not seem to have the"
27 
    puts "testchmod command that is needed to run these tests."
28 
    return
29 
}
30 
 
31 
proc createfile {file {string a}} {
32 
    set f [open $file w]
33 
    puts -nonewline $f $string
34 
    close $f
35 
    return $string
36 
}
37 
 
38 
#
39 
# checkcontent --
40 
#
41 
#  Ensures that file "file" contains only the string "matchString"
42 
#  returns 0 if the file does not exist, or has a different content
43 
#
44 
proc checkcontent {file matchString} {
45 
    if {[catch {
46 
        set f [open $file]
47 
        set fileString [read $f]
48 
        close $f
49 
    }]} {
50 
        return 0
51 
    }
52 
    return [string match $matchString $fileString]
53 
}
54 
 
55 
proc openup {path} {
56 
    testchmod 777 $path
57 
    if {[file isdirectory $path]} {
58 
        catch {
59 
            foreach p [glob [file join $path *]] {
60 
                openup $p
61 
            }
62 
        }
63 
    }
64 
}
65 
 
66 
proc cleanup {args} {
67 
    foreach p ". $args" {
68 
        set x ""
69 
        catch {
70 
            set x [glob [file join $p tf*] [file join $p td*]]
71 
        }
72 
        foreach file $x {
73 
            if {[catch {file delete -force -- $file}]} {
74 
                openup $file
75 
                file delete -force -- $file
76 
            }
77 
        }
78 
    }
79 
}
80 
 
81 
proc contents {file} {
82 
    set f [open $file r]
83 
    set r [read $f]
84 
    close $f
85 
    set r
86 
}
87 
 
88 
set testConfig(NT) 0
89 
set testConfig(95) 0
90 
 
91 
switch $tcl_platform(os) {
92 
    "Windows NT" {set testConfig(NT) 1}
93 
    "Windows 95" {set testConfig(95) 1}
94 
}
95 
 
96 
set testConfig(fileSharing) 0
97 
set testConfig(notFileSharing) 1
98 
 
99 
if {$tcl_platform(platform) == "macintosh"} {
100 
    catch {file delete -force foo.dir}
101 
    file mkdir foo.dir
102 
    if {[catch {file attributes foo.dir -readonly 1}] == 0} {
103 
        set testConfig(fileSharing) 1
104 
        set testConfig(notFileSharing) 0
105 
    }
106 
    file delete -force foo.dir
107 
}
108 
 
109 
set testConfig(xdev) 0
110 
 
111 
if {$tcl_platform(platform) == "unix"} {
112 
    if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
113 
        set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
114 
        set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
115 
        if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
116 
            set testConfig(xdev) 1
117 
        }
118 
    }
119 
}
120 
 
121 
set root [lindex [file split [pwd]] 0]
122 
 
123 
# A really long file name
124 
# length of long is 1216 chars, which should be greater than any static
125 
# buffer or allowable filename.
126 
 
127 
set long "abcdefghihjllmnopqrstuvwxyz01234567890"
128 
append long $long
129 
append long $long
130 
append long $long
131 
append long $long
132 
append long $long
133 
 
134 
test fCmd-1.1 {TclFileRenameCmd} {
135 
    cleanup
136 
    createfile tf1
137 
    file rename tf1 tf2
138 
    glob tf*
139 
} {tf2}
140 
 
141 
test fCmd-2.1 {TclFileCopyCmd} {
142 
    cleanup
143 
    createfile tf1
144 
    file copy tf1 tf2
145 
    lsort [glob tf*]
146 
} {tf1 tf2}
147 
 
148 
test fCmd-3.1 {FileCopyRename: FileForceOption fails} {
149 
    list [catch {file rename -xyz} msg] $msg
150 
} {1 {bad option "-xyz": should be -force or --}}
151 
test fCmd-3.2 {FileCopyRename: not enough args} {
152 
    list [catch {file rename xyz} msg] $msg
153 
} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
154 
test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {
155 
    list [catch {file rename xyz ~nonexistantuser} msg] $msg
156 
} {1 {user "nonexistantuser" doesn't exist}}
157 
test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {
158 
    cleanup
159 
    list [catch {file copy tf1 ~} msg] $msg
160 
} {1 {error copying "tf1": no such file or directory}}
161 
test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {
162 
    cleanup
163 
    list [catch {file rename tf1 tf2 tf3} msg] $msg
164 
} {1 {error renaming: target "tf3" is not a directory}}
165 
test fCmd-3.6 {FileCopyRename: target tf3 is not a directory: !S_ISDIR(target)} {
166 
    cleanup
167 
    createfile tf3
168 
    list [catch {file rename tf1 tf2 tf3} msg] $msg
169 
} {1 {error renaming: target "tf3" is not a directory}}
170 
test fCmd-3.7 {FileCopyRename: target exists & is directory} {
171 
    cleanup
172 
    file mkdir td1
173 
    createfile tf1 tf1
174 
    file rename tf1 td1
175 
    contents [file join td1 tf1]
176 
} {tf1}
177 
test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {
178 
    cleanup
179 
    list [catch {file rename tf1 tf2 tf3} msg] $msg
180 
} {1 {error renaming: target "tf3" is not a directory}}
181 
test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {
182 
    cleanup
183 
    list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
184 
} {1 {error copying: target "tf3" is not a directory}}
185 
test fCmd-3.10 {FileCopyRename: just 2 arguments} {
186 
    cleanup
187 
    createfile tf1 tf1
188 
    file rename tf1 tf2
189 
    contents tf2
190 
} {tf1}
191 
test fCmd-3.11 {FileCopyRename: just 2 arguments} {
192 
    cleanup
193 
    createfile tf1 tf1
194 
    file rename -force -force -- tf1 tf2
195 
    contents tf2
196 
} {tf1}
197 
test fCmd-3.12 {FileCopyRename: move each source: 1 source} {
198 
    cleanup
199 
    createfile tf1 tf1
200 
    file mkdir td1
201 
    file rename tf1 td1
202 
    contents [file join td1 tf1]
203 
} {tf1}
204 
test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {
205 
    cleanup
206 
    createfile tf1 tf1
207 
    createfile tf2 tf2
208 
    createfile tf3 tf3
209 
    createfile tf4 tf4
210 
    file mkdir td1
211 
    file rename tf1 tf2 tf3 tf4 td1
212 
    list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
213 
        [contents [file join td1 tf3]] [contents [file join td1 tf4]]
214 
} {tf1 tf2 tf3 tf4}
215 
test fCmd-3.14 {FileCopyRename: FileBasename fails} {
216 
    cleanup
217 
    file mkdir td1
218 
    list [catch {file rename ~nonexistantuser td1} msg] $msg
219 
} {1 {user "nonexistantuser" doesn't exist}}
220 
test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {unixOrPc} {
221 
    cleanup
222 
    file mkdir td1
223 
    list [catch {file rename / td1} msg] $msg
224 
} {1 {error renaming "/" to "td1": file already exists}}
225 
test fCmd-3.16 {FileCopyRename: break on first error} {
226 
    cleanup
227 
    createfile tf1
228 
    createfile tf2
229 
    createfile tf3
230 
    createfile tf4
231 
    file mkdir td1
232 
    createfile [file join td1 tf3]
233 
    list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
234 
} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]
235 
 
236 
test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {
237 
    cleanup
238 
    file mkdir td1
239 
    glob td*
240 
} {td1}
241 
test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {
242 
    cleanup
243 
    file mkdir td1 td2 td3
244 
    lsort [glob td*]
245 
} {td1 td2 td3}
246 
test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {
247 
    cleanup
248 
    createfile tf1
249 
    catch {file mkdir td1 td2 tf1 td3 td4}
250 
    glob td1 td2 tf1 td3 td4
251 
} {td1 td2 tf1}
252 
test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {
253 
    cleanup
254 
    list [catch {file mkdir ~nonexistantuser} msg] $msg
255 
} {1 {user "nonexistantuser" doesn't exist}}
256 
test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} {
257 
    cleanup
258 
    list [catch {file mkdir ""} msg] $msg
259 
} {1 {can't create directory "": no such file or directory}}
260 
test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {
261 
    cleanup
262 
    file mkdir td1
263 
    glob td1
264 
} {td1}
265 
test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {
266 
    cleanup
267 
    file mkdir [file join td1 td2 td3 td4]
268 
    glob td1 [file join td1 td2]
269 
} "td1 [file join td1 td2]"
270 
test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {
271 
    cleanup
272 
    file mkdir td1
273 
    set x [file exist td1]
274 
    file mkdir td1
275 
    list $x [file exist td1]
276 
} {1 1}
277 
test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {
278 
    cleanup
279 
    createfile tf1
280 
    list [catch {file mkdir tf1} msg] $msg
281 
} [subst {1 {can't create directory "[file join tf1]": file already exists}}]
282 
test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {
283 
    cleanup
284 
    file mkdir td1
285 
    set x [file exist td1]
286 
    file mkdir td1
287 
    list $x [file exist td1]
288 
} {1 1}
289 
test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {unixOnly} {
290 
    cleanup
291 
    file mkdir td1/td2/td3
292 
    testchmod 000 td1/td2
293 
    set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]
294 
    testchmod 755 td1/td2
295 
    set msg
296 
} {1 {can't create directory "td1/td2/td3": permission denied}}
297 
test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {
298 
    cleanup
299 
    list [catch {file mkdir nonexistantvolume:} msg] $msg
300 
} {1 {can't create directory "nonexistantvolume:": invalid argument}}
301 
test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {
302 
    cleanup
303 
    set x [file exist td1]
304 
    file mkdir td1
305 
    list $x [file exist td1]
306 
} {0 1}
307 
test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {unixOnly} {
308 
    cleanup
309 
    file delete -force foo
310 
    file mkdir foo
311 
    file attr foo -perm 040000
312 
    set result [list [catch {file mkdir foo/tf1} msg] $msg]
313 
    file delete -force foo
314 
    set result
315 
} {1 {can't create directory "foo/tf1": permission denied}}
316 
test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {
317 
    list [catch {file mkdir ${root}:} msg] $msg
318 
} [subst {1 {can't create directory "${root}:": no such file or directory}}]
319 
test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {
320 
    cleanup
321 
    file mkdir tf1
322 
    file exists tf1
323 
} {1}
324 
 
325 
test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {
326 
    list [catch {file delete -xyz} msg] $msg
327 
} {1 {bad option "-xyz": should be -force or --}}
328 
test fCmd-5.2 {TclFileDeleteCmd: not enough args} {
329 
    list [catch {file delete -force -force} msg] $msg
330 
} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
331 
test fCmd-5.3 {TclFileDeleteCmd: 1 file} {
332 
    cleanup
333 
    createfile tf1
334 
    createfile tf2
335 
    file mkdir td1
336 
    file delete tf2
337 
    glob tf* td*
338 
} {tf1 td1}
339 
test fCmd-5.4 {TclFileDeleteCmd: multiple files} {
340 
    cleanup
341 
    createfile tf1
342 
    createfile tf2
343 
    file mkdir td1
344 
    set x [list [file exist tf1] [file exist tf2] [file exist td1]]
345 
    file delete tf1 td1 tf2
346 
    lappend x [file exist tf1] [file exist tf2] [file exist tf3]
347 
} {1 1 1 0 0 0}
348 
test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {unixOrPc} {
349 
    cleanup
350 
    createfile tf1
351 
    createfile tf2
352 
    file mkdir td1
353 
    catch {file delete tf1 td1 $root tf2}
354 
    list [file exist tf1] [file exist tf2] [file exist td1]
355 
} {0 1 0}
356 
test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {
357 
    list [catch {file delete ~nonexistantuser} msg] $msg
358 
} {1 {user "nonexistantuser" doesn't exist}}
359 
test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {
360 
    catch {file delete ~/tf1}
361 
    createfile ~/tf1
362 
    file delete ~/tf1
363 
} {}
364 
test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {
365 
    cleanup
366 
    set x [file exist tf1]
367 
    file delete tf1
368 
    list $x [file exist tf1]
369 
} {0 0}
370 
test fCmd-5.9 {TclFileDeleteCmd: is directory} {
371 
    cleanup
372 
    file mkdir td1
373 
    file delete td1
374 
    file exist td1
375 
} {0}
376 
test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {
377 
    cleanup
378 
    file mkdir td1/td2
379 
    list [catch {file delete td1} msg] $msg
380 
} {1 {error deleting "td1": directory not empty}}
381 
 
382 
test fCmd-6.1 {CopyRenameOneFile: bad source} {
383 
    # can't test this, because it's caught by FileCopyRename
384 
} {}
385 
test fCmd-6.2 {CopyRenameOneFile: bad target} {
386 
    # can't test this, because it's caught by FileCopyRename
387 
} {}
388 
test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {
389 
    cleanup
390 
    list [catch {file rename tf1 tf2} msg] $msg
391 
} {1 {error renaming "tf1": no such file or directory}}
392 
test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {
393 
    cleanup
394 
    createfile tf1
395 
    file rename tf1 tf2
396 
    glob tf*
397 
} {tf2}
398 
test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {
399 
    cleanup
400 
    createfile tf1
401 
    file rename tf1 tf2
402 
    glob tf*
403 
} {tf2}
404 
test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly} {
405 
    cleanup
406 
    file mkdir td1
407 
    testchmod 000 td1
408 
    createfile tf1
409 
    set msg [list [catch {file rename tf1 td1} msg] $msg]
410 
    testchmod 755 td1
411 
    set msg
412 
} {1 {error renaming "tf1" to "td1/tf1": permission denied}}
413 
test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {95} {
414 
    cleanup
415 
    createfile tf1
416 
    list [catch {file rename tf1 $long} msg] $msg
417 
} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
418 
test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} {
419 
    cleanup
420 
    createfile tf1
421 
    list [catch {file rename tf1 $long} msg] $msg
422 
} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
423 
test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly} {
424 
    cleanup
425 
    createfile tf1
426 
    file rename tf1 tf2
427 
    glob tf*
428 
} {tf2}
429 
test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {
430 
    cleanup
431 
    createfile tf1
432 
    createfile tf2
433 
    list [catch {file rename tf1 tf2} msg] $msg
434 
} {1 {error renaming "tf1" to "tf2": file already exists}}
435 
test fCmd-6.11 {CopyRenameOneFile: force == 0} {
436 
    cleanup
437 
    createfile tf1
438 
    createfile tf2
439 
    list [catch {file rename tf1 tf2} msg] $msg
440 
} {1 {error renaming "tf1" to "tf2": file already exists}}
441 
test fCmd-6.12 {CopyRenameOneFile: force != 0} {
442 
    cleanup
443 
    createfile tf1
444 
    createfile tf2
445 
    file rename -force tf1 tf2
446 
    glob tf*
447 
} {tf2}
448 
test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {
449 
    cleanup
450 
    file mkdir td1
451 
    file mkdir td2
452 
    createfile [file join td2 td1]
453 
    list [catch {file rename -force td1 td2} msg] $msg
454 
} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
455 
test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {
456 
    cleanup
457 
    createfile tf1
458 
    file mkdir [file join td1 tf1]
459 
    list [catch {file rename -force tf1 td1} msg] $msg
460 
} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
461 
test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {
462 
    cleanup
463 
    file mkdir [file join td1 td2]
464 
    file mkdir td2
465 
    createfile [file join td2 tf1]
466 
    file rename -force td2 td1
467 
    file exists [file join td1 td2 tf1]
468 
} {1}
469 
test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {
470 
    cleanup
471 
    file mkdir [file join td1 td2]
472 
    createfile [file join td1 td2 tf1]
473 
    file mkdir td2
474 
    list [catch {file rename -force td2 td1} msg] $msg
475 
} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
476 
test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {!$testConfig(win32s) || ($root == "C:/")} {
477 
    # Don't run this test under Win32s on a drive mounted from an NT
478 
    # machine; it causes the NT machine to die.
479 
 
480 
    cleanup
481 
    list [catch {file rename -force $root tf1} msg] $msg
482 
} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
483 
test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {
484 
    cleanup
485 
    file mkdir [file join td1 td2]
486 
    createfile [file join td1 td2 tf1]
487 
    file mkdir td2
488 
    list [catch {file rename -force td2 td1} msg] $msg
489 
} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
490 
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly} {
491 
    cleanup /tmp
492 
    createfile tf1
493 
    file rename tf1 /tmp
494 
    glob tf* /tmp/tf1
495 
} {/tmp/tf1}
496 
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
497 
    catch {file delete -force c:/tcl8975@ d:/tcl8975@}
498 
    file mkdir c:/tcl8975@
499 
    if [catch {file rename c:/tcl8975@ d:/}] {
500 
        list d:/tcl8975@
501 
    } else {
502 
        set msg [glob c:/tcl8975@ d:/tcl8975@]
503 
        file delete -force d:/tcl8975@
504 
        set msg
505 
    }
506 
} {d:/tcl8975@}
507 
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} {unixOnly} {
508 
    cleanup /tmp
509 
    file mkdir td1
510 
    file rename td1 /tmp
511 
    glob td* /tmp/td*
512 
} {/tmp/td1}
513 
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} {unixOnly} {
514 
    cleanup /tmp
515 
    createfile tf1
516 
    file rename tf1 /tmp
517 
    glob tf* /tmp/tf*
518 
} {/tmp/tf1}
519 
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
520 
    cleanup /tmp
521 
    file mkdir td1/td2/td3
522 
    exec chmod 000 td1
523 
    set msg [list [catch {file rename td1 /tmp} msg] $msg]
524 
    exec chmod 755 td1
525 
    set msg
526 
} {1 {error renaming "td1": permission denied}}
527 
test fCmd-6.24 {CopyRenameOneFile: error uses original name} {unixOnly} {
528 
    cleanup
529 
    file mkdir ~/td1/td2
530 
    exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
531 
    set msg [list [catch {file copy ~/td1 td1} msg] $msg]
532 
    exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
533 
    file delete -force ~/td1
534 
    set msg
535 
} {1 {error copying "~/td1": permission denied}}
536 
test fCmd-6.25 {CopyRenameOneFile: error uses original name} {unixOnly} {
537 
    cleanup
538 
    file mkdir td2
539 
    file mkdir ~/td1
540 
    exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
541 
    set msg [list [catch {file copy td2 ~/td1} msg] $msg]
542 
    exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
543 
    file delete -force ~/td1
544 
    set msg
545 
} {1 {error copying "td2" to "~/td1/td2": permission denied}}
546 
test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} {unixOnly} {
547 
    cleanup
548 
    file mkdir ~/td1/td2
549 
    exec chmod 000 [file join [file dirname ~] [file tail ~] td1 td2]
550 
    set msg [list [catch {file copy ~/td1 td1} msg] $msg]
551 
    exec chmod 755 [file join [file dirname ~] [file tail ~] td1 td2]
552 
    file delete -force ~/td1
553 
    set msg
554 
} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
555 
test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
556 
    cleanup /tmp
557 
    file mkdir td1/td2/td3
558 
    file mkdir /tmp/td1
559 
    createfile /tmp/td1/tf1
560 
    list [catch {file rename -force td1 /tmp} msg] $msg
561 
} {1 {error renaming "td1" to "/tmp/td1": file already exists}}
562 
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} {
563 
    cleanup /tmp
564 
    file mkdir td1/td2/td3
565 
    exec chmod 000 td1/td2/td3
566 
    set msg [list [catch {file rename td1 /tmp} msg] $msg]
567 
    exec chmod 755 td1/td2/td3
568 
    set msg
569 
} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
570 
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} {unixOnly xdev} {
571 
    cleanup /tmp
572 
    file mkdir td1/td2/td3
573 
    file rename td1 /tmp
574 
    glob td* /tmp/td1/t*
575 
} {/tmp/td1/td2}
576 
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} {unixOnly} {
577 
    cleanup
578 
    file mkdir foo/bar
579 
    file attr foo -perm 040555
580 
    set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
581 
    set a1 {1 {can't unlink "foo/bar": permission denied}}
582 
    set result [expr {$msg == $a1}]
583 
    catch {file delete /tmp/bar}
584 
    catch {file attr foo -perm 040777}
585 
    catch {file delete -force foo}
586 
    set result
587 
} {1}
588 
test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} {unixOnly xdev} {
589 
    catch {cleanup /tmp}
590 
    file mkdir /tmp/td1
591 
    createfile /tmp/td1/tf1
592 
    file rename /tmp/td1/tf1 tf1
593 
    list [file exists /tmp/td1/tf1] [file exists tf1]
594 
} {0 1}
595 
test fCmd-6.32 {CopyRenameOneFile: copy} {
596 
    cleanup
597 
    list [catch {file copy tf1 tf2} msg] $msg
598 
} {1 {error copying "tf1": no such file or directory}}
599 
catch {cleanup /tmp}
600 
 
601 
test fCmd-7.1 {FileForceOption: none} {
602 
    cleanup
603 
    file mkdir [file join tf1 tf2]
604 
    list [catch {file delete tf1} msg] $msg
605 
} {1 {error deleting "tf1": directory not empty}}
606 
test fCmd-7.2 {FileForceOption: -force} {
607 
    cleanup
608 
    file mkdir [file join tf1 tf2]
609 
    file delete -force tf1
610 
} {}
611 
test fCmd-7.3 {FileForceOption: --} {
612 
    createfile -tf1
613 
    file delete -- -tf1
614 
} {}
615 
test fCmd-7.4 {FileForceOption: bad option} {
616 
    createfile -tf1
617 
    set msg [list [catch {file delete -tf1} msg] $msg]
618 
    file delete -- -tf1
619 
    set msg
620 
} {1 {bad option "-tf1": should be -force or --}}
621 
test fCmd-7.5 {FileForceOption: multiple times through loop} {
622 
    createfile --
623 
    createfile -force
624 
    file delete -force -force -- -- -force
625 
    list [catch {glob -- -- -force} msg] $msg
626 
} {1 {no files matched glob patterns "-- -force"}}
627 
 
628 
test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} {unixOnly} {
629 
    file mkdir td1
630 
    file attr td1 -perm 040000
631 
    set result [list [catch {file rename ~$user td1} msg] $msg]
632 
    file delete -force td1
633 
    set result
634 
} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
635 
 
636 
test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly} {
637 
    cleanup
638 
    file mkdir td1
639 
    file mkdir td2
640 
    file attr td2 -perm 040000
641 
    set result [list [catch {file rename td1 td2/} msg] $msg]
642 
    file delete -force td2
643 
    file delete -force td1
644 
    set result
645 
} {1 {error renaming "td1" to "td2/td1": permission denied}}
646 
test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {
647 
    cleanup
648 
    list [catch {file rename tf1 tf2} msg] $msg
649 
} {1 {error renaming "tf1": no such file or directory}}
650 
test fCmd-9.3 {file rename: comprehensive: file to new name} {
651 
    cleanup
652 
    createfile tf1
653 
    createfile tf2
654 
    testchmod 444 tf2
655 
    file rename tf1 tf3
656 
    file rename tf2 tf4
657 
    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
658 
} {{tf3 tf4} 1 0}
659 
test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc} {
660 
    cleanup
661 
    file mkdir td1 td2
662 
    testchmod 555 td2
663 
    file rename td1 td3
664 
    file rename td2 td4
665 
    list [lsort [glob td*]] [file writable td3] [file writable td4]
666 
} {{td3 td4} 1 0}
667 
test fCmd-9.5 {file rename: comprehensive: file to self} {
668 
    cleanup
669 
    createfile tf1 tf1
670 
    createfile tf2 tf2
671 
    testchmod 444 tf2
672 
    file rename -force tf1 tf1
673 
    file rename -force tf2 tf2
674 
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
675 
} {tf1 tf2 1 0}
676 
test fCmd-9.6 {file rename: comprehensive: dir to self} {unixOrPc} {
677 
    cleanup
678 
    file mkdir td1
679 
    file mkdir td2
680 
    testchmod 555 td2
681 
    file rename -force td1 .
682 
    file rename -force td2 .
683 
    list [lsort [glob td*]] [file writable td1] [file writable td2]
684 
} {{td1 td2} 1 0}
685 
test fCmd-9.7 {file rename: comprehensive: file to existing file} {
686 
    cleanup
687 
    createfile tf1
688 
    createfile tf2
689 
    createfile tfs1
690 
    createfile tfs2
691 
    createfile tfs3
692 
    createfile tfs4
693 
    createfile tfd1
694 
    createfile tfd2
695 
    createfile tfd3
696 
    createfile tfd4
697 
    testchmod 444 tfs3
698 
    testchmod 444 tfs4
699 
    testchmod 444 tfd2
700 
    testchmod 444 tfd4
701 
    set msg [list [catch {file rename tf1 tf2} msg] $msg]
702 
    file rename -force tfs1 tfd1
703 
    file rename -force tfs2 tfd2
704 
    file rename -force tfs3 tfd3
705 
    file rename -force tfs4 tfd4
706 
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
707 
} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
708 
test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {
709 
    # Under unix, you can rename a read-only directory, but you can't
710 
    # move it into another directory.
711 
 
712 
    cleanup
713 
    file mkdir td1
714 
    file mkdir [file join td2 td1]
715 
    file mkdir tds1
716 
    file mkdir tds2
717 
    file mkdir tds3
718 
    file mkdir tds4
719 
    file mkdir [file join tdd1 tds1]
720 
    file mkdir [file join tdd2 tds2]
721 
    file mkdir [file join tdd3 tds3]
722 
    file mkdir [file join tdd4 tds4]
723 
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
724 
        testchmod 555 tds3
725 
        testchmod 555 tds4
726 
    }
727 
    if {$tcl_platform(platform) != "macintosh"} {
728 
        testchmod 555 [file join tdd2 tds2]
729 
        testchmod 555 [file join tdd4 tds4]
730 
    }
731 
    set msg [list [catch {file rename td1 td2} msg] $msg]
732 
    file rename -force tds1 tdd1
733 
    file rename -force tds2 tdd2
734 
    file rename -force tds3 tdd3
735 
    file rename -force tds4 tdd4
736 
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
737 
        set w3 [file writable [file join tdd3 tds3]]
738 
        set w4 [file writable [file join tdd4 tds4]]
739 
    } else {
740 
        set w3 0
741 
        set w4 0
742 
    }
743 
    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
744 
    [file writable [file join tdd2 tds2]] $w3 $w4
745 
} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
746 
test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {
747 
    cleanup
748 
    file mkdir tds1
749 
    file mkdir tds2
750 
    file mkdir [file join tdd1 tds1 xxx]
751 
    file mkdir [file join tdd2 tds2 xxx]
752 
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
753 
        testchmod 555 tds2
754 
    }
755 
    set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
756 
    set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
757 
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
758 
        set w2 [file writable tds2]
759 
    } else {
760 
        set w2 0
761 
    }
762 
    list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
763 
} [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
764 
test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {
765 
    cleanup
766 
    createfile tf1
767 
    createfile tf2
768 
    file mkdir td1
769 
    testchmod 444 tf2
770 
    file rename tf1 [file join td1 tf3]
771 
    file rename tf2 [file join td1 tf4]
772 
    list [catch {glob tf*}] [lsort [glob [file join td1 t*]]] \
773 
    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
774 
} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
775 
test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {
776 
    cleanup
777 
    file mkdir td1
778 
    file mkdir td2
779 
    file mkdir td3
780 
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
781 
        testchmod 555 td2
782 
    }
783 
    file rename td1 [file join td3 td3]
784 
    file rename td2 [file join td3 td4]
785 
    if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
786 
        set w4 [file writable [file join td3 td4]]
787 
    } else {
788 
        set w4 0
789 
    }
790 
    list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
791 
    [file writable [file join td3 td3]] $w4
792 
} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
793 
test fCmd-9.12 {file rename: comprehensive: target exists} {
794 
    cleanup
795 
    file mkdir [file join td1 td2] [file join td2 td1]
796 
    if {$tcl_platform(platform) != "macintosh"} {
797 
        testchmod 555 [file join td2 td1]
798 
    }
799 
    file mkdir [file join td3 td4] [file join td4 td3]
800 
    file rename -force td3 td4
801 
    set msg [list [file exists td3] [file exists [file join td4 td3 td4]] \
802 
    [catch {file rename td1 td2} msg] $msg]
803 
    if {$tcl_platform(platform) != "macintosh"} {
804 
        testchmod 755 [file join td2 td1]
805 
    }
806 
    set msg
807 
} [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
808 
test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {
809 
    cleanup
810 
    file mkdir [file join td1 td2] [file join td2 td1 td4]
811 
    list [catch {file rename -force td1 td2} msg] $msg
812 
} [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
813 
test fCmd-9.14 {file rename: comprehensive: dir into self} {
814 
    cleanup
815 
    file mkdir td1
816 
    list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
817 
} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
818 
test fCmd-9.15 {file rename: comprehensive: source and target incompatible} {
819 
    cleanup
820 
    file mkdir td1
821 
    createfile tf1
822 
    list [catch {file rename -force td1 tf1} msg] $msg
823 
} {1 {can't overwrite file "tf1" with directory "td1"}}
824 
test fCmd-9.16 {file rename: comprehensive: source and target incompatible} {
825 
    cleanup
826 
    file mkdir td1/tf1
827 
    createfile tf1
828 
    list [catch {file rename -force tf1 td1} msg] $msg
829 
} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
830 
 
831 
test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {
832 
    cleanup
833 
    list [catch {file copy tf1 tf2} msg] $msg
834 
} {1 {error copying "tf1": no such file or directory}}
835 
test fCmd-10.2 {file copy: comprehensive: file to new name} {
836 
    cleanup
837 
    createfile tf1 tf1
838 
    createfile tf2 tf2
839 
    testchmod 444 tf2
840 
    file copy tf1 tf3
841 
    file copy tf2 tf4
842 
    list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
843 
} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
844 
test fCmd-10.3 {file copy: comprehensive: dir to new name} {unixOrPc} {
845 
    cleanup
846 
    file mkdir [file join td1 tdx]
847 
    file mkdir [file join td2 tdy]
848 
    testchmod 555 td2
849 
    file copy td1 td3
850 
    file copy td2 td4
851 
    set msg [list [lsort [glob td*]] [glob [file join td3 t*]] \
852 
            [glob [file join td4 t*]] [file writable td3] [file writable td4]]
853 
    if {$tcl_platform(platform) != "macintosh"} {
854 
        testchmod 755 td2
855 
        testchmod 755 td4
856 
    }
857 
    set msg
858 
} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
859 
test fCmd-10.4 {file copy: comprehensive: file to existing file} {
860 
    cleanup
861 
    createfile tf1
862 
    createfile tf2
863 
    createfile tfs1
864 
    createfile tfs2
865 
    createfile tfs3
866 
    createfile tfs4
867 
    createfile tfd1
868 
    createfile tfd2
869 
    createfile tfd3
870 
    createfile tfd4
871 
    testchmod 444 tfs3
872 
    testchmod 444 tfs4
873 
    testchmod 444 tfd2
874 
    testchmod 444 tfd4
875 
    set msg [list [catch {file copy tf1 tf2} msg] $msg]
876 
    file copy -force tfs1 tfd1
877 
    file copy -force tfs2 tfd2
878 
    file copy -force tfs3 tfd3
879 
    file copy -force tfs4 tfd4
880 
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
881 
} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
882 
test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {
883 
    cleanup
884 
    file mkdir td1
885 
    file mkdir [file join td2 td1]
886 
    file mkdir tds1
887 
    file mkdir tds2
888 
    file mkdir tds3
889 
    file mkdir tds4
890 
    file mkdir [file join tdd1 tds1]
891 
    file mkdir [file join tdd2 tds2]
892 
    file mkdir [file join tdd3 tds3]
893 
    file mkdir [file join tdd4 tds4]
894 
    if {$tcl_platform(platform) != "macintosh"} {
895 
        testchmod 555 tds3
896 
        testchmod 555 tds4
897 
        testchmod 555 [file join tdd2 tds2]
898 
        testchmod 555 [file join tdd4 tds4]
899 
    }
900 
    set a1 [list [catch {file copy td1 td2} msg] $msg]
901 
    set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
902 
    set a3 [catch {file copy -force tds2 tdd2}]
903 
    set a4 [catch {file copy -force tds3 tdd3}]
904 
    set a5 [catch {file copy -force tds4 tdd4}]
905 
    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
906 
} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
907 
test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} {unixOrPc} {
908 
    cleanup
909 
    file mkdir tds1
910 
    file mkdir tds2
911 
    file mkdir [file join tdd1 tds1 xxx]
912 
    file mkdir [file join tdd2 tds2 xxx]
913 
    testchmod 555 tds2
914 
    set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
915 
    set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
916 
    list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
917 
} [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
918 
test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {
919 
    cleanup
920 
    createfile tf1
921 
    createfile tf2
922 
    file mkdir td1
923 
    testchmod 444 tf2
924 
    file copy tf1 [file join td1 tf3]
925 
    file copy tf2 [file join td1 tf4]
926 
    list [lsort [glob tf*]] [lsort [glob [file join td1 t*]]] \
927 
    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
928 
} [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
929 
test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} {unixOrPc} {
930 
    cleanup
931 
    file mkdir td1
932 
    file mkdir td2
933 
    file mkdir td3
934 
    testchmod 555 td2
935 
    file copy td1 [file join td3 td3]
936 
    file copy td2 [file join td3 td4]
937 
    list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
938 
    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
939 
} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
940 
test fCmd-10.9 {file copy: comprehensive: source and target incompatible} {
941 
    cleanup
942 
    file mkdir td1
943 
    createfile tf1
944 
    list [catch {file copy -force td1 tf1} msg] $msg
945 
} {1 {can't overwrite file "tf1" with directory "td1"}}
946 
test fCmd-10.10 {file copy: comprehensive: source and target incompatible} {
947 
    cleanup
948 
    file mkdir [file join td1 tf1]
949 
    createfile tf1
950 
    list [catch {file copy -force tf1 td1} msg] $msg
951 
} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
952 
cleanup
953 
 
954 
# old tests
955 
 
956 
test fCmd-11.1 {TclFileRenameCmd: -- option } {
957 
    catch {file delete -force -- -tfa1}
958 
    set s [createfile -tfa1]
959 
    file rename -- -tfa1 tfa2
960 
    set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]
961 
    file delete tfa2
962 
    set result
963 
} {1}
964 
 
965 
test fCmd-11.2 {TclFileRenameCmd: bad option } {
966 
    catch {file delete -force -- tfa1}
967 
    set s [createfile tfa1]
968 
    set r1 [catch {file rename -x tfa1 tfa2}]
969 
    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
970 
    file delete tfa1
971 
    set result
972 
} {1}
973 
 
974 
test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
975 
    catch {file rename -- }
976 
} {1}
977 
 
978 
test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {
979 
     global env
980 
     set temp $env(HOME)
981 
     unset env(HOME)
982 
     set result [catch {file rename tfa ~/foobar }]
983 
     set env(HOME) $temp
984 
     set result
985 
 } {1}
986 
 
987 
test fCmd-11.5 {TclFileRenameCmd: more than one source and target is not a directory} {
988 
    catch {file delete -force -- tfa1 tfa2 tfa3}
989 
    createfile tfa1
990 
    createfile tfa2
991 
    createfile tfa3
992 
    set result [catch {file rename tfa1 tfa2 tfa3}]
993 
    file delete tfa1 tfa2 tfa3
994 
    set result
995 
} {1}
996 
 
997 
test fCmd-11.6 {TclFileRenameCmd: : single file into directory  } {
998 
    catch {file delete -force -- tfa1 tfad}
999 
    set s [createfile tfa1]
1000 
    file mkdir tfad
1001 
    file rename tfa1 tfad
1002 
    set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]
1003 
    file delete -force tfad
1004 
    set result
1005 
} {1}
1006 
 
1007 
test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory  } {
1008 
    catch {file delete -force -- tfa1 tfa2 tfad}
1009 
    set s1 [createfile tfa1 ]
1010 
    set s2 [createfile tfa2 ]
1011 
    file mkdir tfad
1012 
    file rename tfa1 tfa2 tfad
1013 
    set r1 [checkcontent tfad/tfa1 $s1]
1014 
    set r2 [checkcontent tfad/tfa2 $s2]
1015 
 
1016 
    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
1017 
 
1018 
    file delete -force tfad
1019 
    set result
1020 
} {1}
1021 
 
1022 
test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory } {
1023 
    catch {file delete -force -- tfa tfad}
1024 
    set s [createfile tfa ]
1025 
    file mkdir tfad
1026 
    file mkdir tfad/tfa
1027 
    set r1 [catch {file rename tfa tfad}]
1028 
    set r2 [checkcontent tfa $s]
1029 
    set r3 [file isdir tfad]
1030 
    set result [expr $r1 && $r2 && $r3 ]
1031 
    file delete -force tfa tfad
1032 
    set result
1033 
} {1}
1034 
 
1035 
#
1036 
# Coverage tests for renamefile() ;
1037 
#
1038 
test fCmd-12.1 {renamefile: source filename translation failing} {
1039 
    global env
1040 
    set temp $env(HOME)
1041 
    unset env(HOME)
1042 
    set result [catch {file rename ~/tfa1 tfa2}]
1043 
    set env(HOME) $temp
1044 
    set result
1045 
} {1}
1046 
 
1047 
test fCmd-12.2 {renamefile: src filename translation failing} {
1048 
    global env
1049 
    set temp $env(HOME)
1050 
    unset env(HOME)
1051 
    set s [createfile tfa1]
1052 
    file mkdir tfad
1053 
    set result [catch {file rename tfa1 ~/tfa2 tfad}]
1054 
    set env(HOME) $temp
1055 
    file delete -force tfad
1056 
    set result
1057 
} {1}
1058 
 
1059 
test fCmd-12.3 {renamefile: stat failing on source} {
1060 
    catch {file delete -force -- tfa1 tfa2}
1061 
    set r1 [catch {file rename tfa1 tfa2}]
1062 
    expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
1063 
} {1}
1064 
 
1065 
test fCmd-12.4 {renamefile: error renaming file to directory } {
1066 
    catch {file delete -force -- tfa tfad}
1067 
    set s1 [createfile tfa ]
1068 
    file mkdir tfad
1069 
    file mkdir tfad/tfa
1070 
    set r1 [catch {file rename tfa tfad}]
1071 
    set r2 [checkcontent tfa $s1]
1072 
    set r3 [file isdir tfad/tfa]
1073 
    set result [expr $r1 && $r2 && $r3]
1074 
    file delete -force tfa tfad
1075 
    set result
1076 
} {1}
1077 
 
1078 
test fCmd-12.5 {renamefile: error renaming directory to file } {
1079 
    catch {file delete -force -- tfa tfad}
1080 
    file mkdir tfa
1081 
    file mkdir tfad
1082 
    set s [createfile tfad/tfa]
1083 
    set r1 [catch {file rename tfa tfad}]
1084 
    set r2 [checkcontent tfad/tfa $s]
1085 
    set r3 [file isdir tfad]
1086 
    set r4 [file isdir tfa]
1087 
    set result [expr $r1 && $r2 && $r3 && $r4 ]
1088 
    file delete -force tfa tfad
1089 
    set result
1090 
} {1}
1091 
 
1092 
test fCmd-12.6 {renamefile: TclRenameFile succeeding } {
1093 
    catch {file delete -force -- tfa1 tfa2}
1094 
    set s [createfile tfa1]
1095 
    file rename tfa1 tfa2
1096 
    set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]
1097 
    file delete tfa2
1098 
    set result
1099 
} {1}
1100 
 
1101 
test fCmd-12.7 {renamefile: renaming directory into offspring} {
1102 
    catch {file delete -force -- tfad}
1103 
    file mkdir tfad
1104 
    file mkdir tfad/dir
1105 
    set result [catch {file rename tfad tfad/dir}]
1106 
    file delete -force tfad
1107 
    set result
1108 
} {1}
1109 
 
1110 
test fCmd-12.8 {renamefile: generic error } {unixOnly} {
1111 
    catch {file delete -force -- tfa}
1112 
    file mkdir tfa
1113 
    file mkdir tfa/dir
1114 
    exec chmod 555 tfa
1115 
    set result [catch {file rename tfa/dir tfa2}]
1116 
    exec chmod 777 tfa
1117 
    file delete -force tfa
1118 
    set result
1119 
} {1}
1120 
 
1121 
 
1122 
test fCmd-12.9 {renamefile: moving a file across volumes } {unixOnly} {
1123 
    catch {file delete -force -- tfa /tmp/tfa}
1124 
    set s [createfile tfa ]
1125 
    file rename tfa /tmp
1126 
    set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]
1127 
    file delete /tmp/tfa
1128 
    set result
1129 
} {1}
1130 
 
1131 
test fCmd-12.10 {renamefile: moving a directory across volumes } {unixOnly} {
1132 
    catch {file delete -force -- tfad /tmp/tfad}
1133 
    file mkdir tfad
1134 
    set s [createfile tfad/a ]
1135 
    file rename tfad /tmp
1136 
    set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]
1137 
    file delete -force /tmp/tfad
1138 
    set result
1139 
} {1}
1140 
 
1141 
#
1142 
# Coverage tests for TclCopyFilesCmd()
1143 
#
1144 
test fCmd-13.1 {TclCopyFilesCmd: -force option } {
1145 
    catch {file delete -force -- tfa1}
1146 
    set s [createfile tfa1]
1147 
    file copy -force  tfa1 tfa2
1148 
    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
1149 
    file delete tfa1 tfa2
1150 
    set result
1151 
} {1}
1152 
 
1153 
test fCmd-13.2 {TclCopyFilesCmd: -- option } {
1154 
    catch {file delete -force -- tfa1}
1155 
    set s [createfile -tfa1]
1156 
    file copy --  -tfa1 tfa2
1157 
    set result [expr [checkcontent tfa2 $s] &&  [checkcontent -tfa1 $s]]
1158 
    file delete -- -tfa1 tfa2
1159 
    set result
1160 
} {1}
1161 
 
1162 
test fCmd-13.3 {TclCopyFilesCmd: bad option } {
1163 
    catch {file delete -force -- tfa1}
1164 
    set s [createfile tfa1]
1165 
    set r1 [catch {file copy -x tfa1 tfa2}]
1166 
    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
1167 
    file delete tfa1
1168 
    set result
1169 
} {1}
1170 
 
1171 
test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {
1172 
    catch {file copy -- }
1173 
} {1}
1174 
 
1175 
test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
1176 
     global env
1177 
     set temp $env(HOME)
1178 
    unset env(HOME)
1179 
     set result [catch {file copy tfa ~/foobar }]
1180 
     set env(HOME) $temp
1181 
     set result
1182 
 } {1}
1183 
 
1184 
test fCmd-13.6 {TclCopyFilesCmd: more than one source and target is not a directory} {
1185 
    catch {file delete -force -- tfa1 tfa2 tfa3}
1186 
    createfile tfa1
1187 
    createfile tfa2
1188 
    createfile tfa3
1189 
    set result [catch {file copy tfa1 tfa2 tfa3}]
1190 
    file delete tfa1 tfa2 tfa3
1191 
    set result
1192 
} {1}
1193 
 
1194 
test fCmd-13.7 {TclCopyFilesCmd: : single file into directory  } {
1195 
    catch {file delete -force -- tfa1 tfad}
1196 
    set s [createfile tfa1]
1197 
    file mkdir tfad
1198 
    file copy tfa1 tfad
1199 
    set result [expr [checkcontent tfad/tfa1 $s] &&  [checkcontent tfa1 $s]]
1200 
    file delete -force tfad tfa1
1201 
    set result
1202 
} {1}
1203 
 
1204 
test fCmd-13.8 {TclCopyFilesCmd: : multiple files into directory  } {
1205 
    catch {file delete -force -- tfa1 tfa2 tfad}
1206 
    set s1 [createfile tfa1 ]
1207 
    set s2 [createfile tfa2 ]
1208 
    file mkdir tfad
1209 
    file copy tfa1 tfa2 tfad
1210 
    set r1 [checkcontent tfad/tfa1 $s1]
1211 
    set r2 [checkcontent tfad/tfa2 $s2]
1212 
    set r3 [checkcontent tfa1 $s1]
1213 
    set r4 [checkcontent tfa2 $s2]
1214 
    set result [expr $r1 && $r2 && $r3 && $r4 ]
1215 
 
1216 
    file delete -force tfad tfa1 tfa2
1217 
    set result
1218 
} {1}
1219 
 
1220 
test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory } {
1221 
    catch {file delete -force -- tfa tfad}
1222 
    set s [createfile tfa ]
1223 
    file mkdir tfad
1224 
    file mkdir tfad/tfa
1225 
    set r1 [catch {file copy tfa tfad}]
1226 
    set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
1227 
    set r3 [file isdir tfad]
1228 
    set result [expr $r1 && $r2 && $r3 ]
1229 
    file delete -force tfa tfad
1230 
    set result
1231 
} {1}
1232 
 
1233 
#
1234 
# Coverage tests for copyfile()
1235 
#
1236 
test fCmd-14.1 {copyfile: source filename translation failing} {
1237 
    global env
1238 
    set temp $env(HOME)
1239 
    unset env(HOME)
1240 
    set result [catch {file copy ~/tfa1 tfa2}]
1241 
    set env(HOME) $temp
1242 
    set result
1243 
} {1}
1244 
 
1245 
test fCmd-14.2 {copyfile: dst filename translation failing} {
1246 
    global env
1247 
    set temp $env(HOME)
1248 
    unset env(HOME)
1249 
    set s [createfile tfa1]
1250 
    file mkdir tfad
1251 
    set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
1252 
    set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
1253 
    set env(HOME) $temp
1254 
    file delete -force tfa1 tfad
1255 
    set result
1256 
} {1}
1257 
 
1258 
test fCmd-14.3 {copyfile: stat failing on source} {
1259 
    catch {file delete -force -- tfa1 tfa2}
1260 
    set r1 [catch {file copy tfa1 tfa2}]
1261 
    expr $r1 && ![file exists tfa1] && ![file exists tfa2]
1262 
} {1}
1263 
 
1264 
test fCmd-14.4 {copyfile: error copying file to directory } {
1265 
    catch {file delete -force -- tfa tfad}
1266 
    set s1 [createfile tfa ]
1267 
    file mkdir tfad
1268 
    file mkdir tfad/tfa
1269 
    set r1 [catch {file copy tfa tfad}]
1270 
    set r2 [checkcontent tfa $s1]
1271 
    set r3 [file isdir tfad]
1272 
    set r4 [file isdir tfad/tfa]
1273 
    set result [expr $r1 && $r2 && $r3 && $r4 ]
1274 
    file delete -force tfa tfad
1275 
    set result
1276 
} {1}
1277 
 
1278 
 test fCmd-14.5 {copyfile: error copying directory to file } {
1279 
     catch {file delete -force -- tfa tfad}
1280 
     file mkdir tfa
1281 
     file mkdir tfad
1282 
     set s [createfile tfad/tfa]
1283 
     set r1 [catch {file copy tfa tfad}]
1284 
     set r2 [checkcontent tfad/tfa $s]
1285 
     set r3 [file isdir tfad]
1286 
     set r4 [file isdir tfa]
1287 
     set result [expr $r1 && $r2 && $r3 && $r4 ]
1288 
     file delete -force tfa tfad
1289 
     set result
1290 
} {1}
1291 
 
1292 
test fCmd-14.6 {copyfile: copy file succeeding } {
1293 
    catch {file delete -force -- tfa tfa2}
1294 
    set s [createfile tfa]
1295 
    file copy tfa tfa2
1296 
    set result [expr  [checkcontent tfa $s] && [checkcontent tfa2 $s]]
1297 
    file delete tfa tfa2
1298 
    set result
1299 
} {1}
1300 
 
1301 
test fCmd-14.7 {copyfile: copy directory succeeding } {
1302 
    catch {file delete -force -- tfa tfa2}
1303 
    file mkdir tfa
1304 
    set s [createfile tfa/file]
1305 
    file copy tfa tfa2
1306 
    set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
1307 
    file delete -force tfa tfa2
1308 
    set result
1309 
} {1}
1310 
 
1311 
test fCmd-14.8 {copyfile: copy directory failing } {unixOnly} {
1312 
    catch {file delete -force -- tfa}
1313 
    file mkdir tfa/dir/a/b/c
1314 
    exec chmod 000 tfa/dir
1315 
    set r1 [catch {file copy tfa tfa2}]
1316 
    exec chmod 777 tfa/dir
1317 
    set result $r1
1318 
    file delete -force tfa tfa2
1319 
    set result
1320 
} {1}
1321 
 
1322 
#
1323 
# Coverage tests for TclMkdirCmd()
1324 
#
1325 
test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {
1326 
    global env
1327 
    set temp $env(HOME)
1328 
    unset env(HOME)
1329 
    set result [catch {file mkdir ~/tfa}]
1330 
    set env(HOME) $temp
1331 
    set result
1332 
} {1}
1333 
#
1334 
# Can Tcl_SplitPath return argc == 0? If so them we need a
1335 
# test for that code.
1336 
#
1337 
test fCmd-15.2 {TclMakeDirsCmd - one directory } {
1338 
    catch {file delete -force -- tfa}
1339 
    file mkdir tfa
1340 
    set result [file isdirectory tfa]
1341 
    file delete tfa
1342 
    set result
1343 
} {1}
1344 
 
1345 
test fCmd-15.3 {TclMakeDirsCmd: - two directories } {
1346 
    catch {file delete -force -- tfa1 tfa2}
1347 
    file mkdir tfa1 tfa2
1348 
    set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
1349 
    file delete tfa1 tfa2
1350 
    set result
1351 
} {1}
1352 
 
1353 
test fCmd-15.4 {TclMakeDirsCmd - stat failing } {unixOnly} {
1354 
    catch {file delete -force -- tfa}
1355 
    file mkdir tfa
1356 
    createfile tfa/file
1357 
    exec chmod 000 tfa
1358 
    set result [catch {file mkdir tfa/file}]
1359 
    exec chmod 777 tfa
1360 
    file delete -force tfa
1361 
    set result
1362 
} {1}
1363 
 
1364 
test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep } {
1365 
    catch {file delete -force -- tfa}
1366 
    file mkdir tfa/a/b/c
1367 
    set result [file isdir tfa/a/b/c]
1368 
    file delete -force tfa
1369 
    set result
1370 
} {1}
1371 
 
1372 
 
1373 
test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file } {
1374 
    catch {file delete -force -- tfa}
1375 
    set s [createfile tfa]
1376 
    set r1 [catch {file mkdir tfa}]
1377 
    set r2 [file isdir tfa]
1378 
    set r3 [file exists tfa]
1379 
    set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
1380 
    file delete tfa
1381 
    set result
1382 
} {1}
1383 
 
1384 
test fCmd-15.7 {TclMakeDirsCmd - making several directories } {
1385 
    catch {file delete -force -- tfa1 tfa2}
1386 
    file mkdir tfa1 tfa2/a/b/c
1387 
    set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
1388 
    file delete -force tfa1 tfa2
1389 
    set result
1390 
} {1}
1391 
 
1392 
test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {
1393 
    file mkdir tfa
1394 
    file mkdir tfa
1395 
    set result [file isdir tfa]
1396 
    file delete tfa
1397 
    set result
1398 
} {1}
1399 
 
1400 
 
1401 
# Coverage tests for TclDeleteFilesCommand()
1402 
test fCmd-16.1 { test the -- argument } {
1403 
    catch {file delete -force -- tfa}
1404 
    createfile tfa
1405 
    file delete -- tfa
1406 
    file exists tfa
1407 
} {0}
1408 
 
1409 
test fCmd-16.2 { test the -force and -- arguments } {
1410 
    catch {file delete -force -- tfa}
1411 
    createfile tfa
1412 
    file delete -force -- tfa
1413 
    file exists tfa
1414 
} {0}
1415 
 
1416 
test fCmd-16.3 { test bad option } {
1417 
    catch {file delete -force -- tfa}
1418 
    createfile tfa
1419 
    set result [catch {file delete -dog tfa}]
1420 
    file delete tfa
1421 
    set result
1422 
} {1}
1423 
 
1424 
test fCmd-16.4 { test not enough args } {
1425 
    catch {file delete}
1426 
} {1}
1427 
 
1428 
test fCmd-16.5 { test not enough args with options } {
1429 
    catch {file delete --}
1430 
} {1}
1431 
 
1432 
test fCmd-16.6 {delete: source filename translation failing} {
1433 
    global env
1434 
    set temp $env(HOME)
1435 
    unset env(HOME)
1436 
    set result [catch {file delete ~/tfa}]
1437 
    set env(HOME) $temp
1438 
    set result
1439 
} {1}
1440 
 
1441 
test fCmd-16.7 {remove a non-empty directory without -force } {
1442 
    catch {file delete -force -- tfa}
1443 
    file mkdir tfa
1444 
    createfile tfa/a
1445 
    set result [catch  {file delete tfa }]
1446 
    file delete -force tfa
1447 
    set result
1448 
} {1}
1449 
 
1450 
test fCmd-16.8 {remove a normal file } {
1451 
    catch {file delete -force -- tfa}
1452 
    file mkdir tfa
1453 
    createfile tfa/a
1454 
    set result [catch  {file delete tfa }]
1455 
    file delete -force tfa
1456 
    set result
1457 
} {1}
1458 
 
1459 
test fCmd-16.9 {error while deleting file } {unixOnly} {
1460 
    catch {file delete -force -- tfa}
1461 
    file mkdir tfa
1462 
    createfile tfa/a
1463 
    exec chmod 555 tfa
1464 
    set result [catch  {file delete tfa/a }]
1465 
    #######
1466 
    #######  If any directory in a tree that is being removed does not
1467 
    #######  have write permission, the process will fail!
1468 
    #######  This is also the case with "rm -rf"
1469 
    #######
1470 
    exec chmod 777 tfa
1471 
    file delete -force tfa
1472 
    set result
1473 
} {1}
1474 
 
1475 
test fCmd-16.10 {deleting multiple files } {
1476 
    catch {file delete -force -- tfa1 tfa2}
1477 
    createfile tfa1
1478 
    createfile tfa2
1479 
    file delete tfa1 tfa2
1480 
    expr ![file exists tfa1] && ![file exists tfa2]
1481 
} {1}
1482 
 
1483 
test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {
1484 
    catch {file delete -force -- tfa}
1485 
    file delete tfa
1486 
    set result 1
1487 
} {1}
1488 
 
1489 
# More coverage tests for mkpath()
1490 
 test fCmd-17.1 {mkdir stat failing on target but not ENOENT } {unixOnly} {
1491 
     catch {file delete -force -- tfa1}
1492 
     file mkdir tfa1
1493 
     exec chmod 555 tfa1
1494 
     set result [catch {file mkdir tfa1/tfa2}]
1495 
     exec chmod 777 tfa1
1496 
     file delete -force tfa1
1497 
     set result
1498 
} {1}
1499 
 
1500 
test fCmd-17.2 {mkdir several levels deep - relative } {
1501 
    catch {file delete -force -- tfa}
1502 
    file mkdir tfa/a/b
1503 
    set result [file isdir tfa/a/b ]
1504 
    file delete tfa/a/b tfa/a tfa
1505 
    set result
1506 
} {1}
1507 
 
1508 
test fCmd-17.3 {mkdir several levels deep - absolute } {
1509 
    catch {file delete -force -- tfa}
1510 
    set f [file join [pwd] tfa a ]
1511 
    file mkdir $f
1512 
    set result [file isdir $f ]
1513 
    file delete $f [file join [pwd] tfa]
1514 
    set result
1515 
} {1}
1516 
 
1517 
#
1518 
# Functionality tests for TclFileRenameCmd()
1519 
#
1520 
 
1521 
test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} {
1522 
    catch {file delete -force -- tfad}
1523 
    file mkdir tfad/dir
1524 
    cd tfad/dir
1525 
    set s [createfile foo ]
1526 
    file rename  foo bar
1527 
    file rename bar ./foo
1528 
    file rename ./foo bar
1529 
    file rename ./bar ./foo
1530 
    file rename foo ../dir/bar
1531 
    file rename ../dir/bar ./foo
1532 
    file rename ../../tfad/dir/foo ../../tfad/dir/bar
1533 
    file rename [file join [pwd] bar] foo
1534 
    file rename foo [file join [pwd] bar]
1535 
    set result [expr [checkcontent bar $s] && ![file exists foo]]
1536 
    cd ../..
1537 
    file delete -force tfad
1538 
    set result
1539 
} {1}
1540 
 
1541 
test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant } {
1542 
    catch {file delete -force -- tfa1 tfa2}
1543 
    file mkdir tfa1
1544 
    file rename tfa1 tfa2
1545 
    set result [expr [file exists tfa2] && ![file exists tfa1]]
1546 
    file delete tfa2
1547 
    set result
1548 
} {1}
1549 
 
1550 
test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory  } {
1551 
    catch {file delete -force -- tfa1 tfad1 tfad2}
1552 
    set s [createfile tfa1 ]
1553 
    file mkdir tfad1 tfad2
1554 
    file rename tfa1 tfad1 tfad2
1555 
    set r1 [checkcontent  tfad2/tfa1 $s]
1556 
    set r2 [file isdir tfad2/tfad1]
1557 
    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
1558 
    file delete tfad2/tfa1
1559 
    file delete -force tfad2
1560 
    set result
1561 
} {1}
1562 
 
1563 
test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir } {
1564 
    catch {file delete -force -- tfa tfad}
1565 
    set s [createfile tfa ]
1566 
    file mkdir tfad
1567 
    set r1 [catch {file rename tfad tfa}]
1568 
    set r2 [checkcontent tfa $s]
1569 
    set r3 [file isdir tfad]
1570 
    set result [expr $r1 && $r2 && $r3 ]
1571 
    file delete tfa tfad
1572 
    set result
1573 
} {1}
1574 
 
1575 
test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir } {
1576 
    catch {file delete -force -- tfa tfad}
1577 
    set s [createfile tfa ]
1578 
    file mkdir tfad/tfa
1579 
    set r1 [catch {file rename tfa tfad}]
1580 
    set r2 [checkcontent tfa $s]
1581 
    set r3 [file isdir tfad/tfa]
1582 
    set result [expr $r1 && $r2 && $r3 ]
1583 
    file delete -force  tfa tfad
1584 
    set result
1585 
} {1}
1586 
 
1587 
#
1588 
# On Windows there is no easy way to determine if two files are the same
1589 
#
1590 
test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix}  {
1591 
    catch {file delete -force -- tfa}
1592 
    set s [createfile tfa]
1593 
    set r1 [catch {file rename tfa tfa}]
1594 
    set result [expr $r1 && [checkcontent tfa $s]]
1595 
    file delete tfa
1596 
    set result
1597 
} {1}
1598 
 
1599 
test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} {
1600 
    catch {file delete -force -- tfa tfad}
1601 
    file mkdir tfa tfad/tfa
1602 
    set r1 [catch {file rename tfa tfad}]
1603 
    set result [expr $r1 && [file isdir tfa]]
1604 
    file delete -force tfa tfad
1605 
    set result
1606 
} {1}
1607 
 
1608 
test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} {
1609 
    catch {file delete -force -- tfa tfad}
1610 
    file mkdir tfa tfad/tfa
1611 
    file rename -force tfa tfad
1612 
    set result [expr ![file isdir tfa]]
1613 
    file delete -force tfad
1614 
    set result
1615 
} {1}
1616 
 
1617 
test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} {
1618 
    catch {file delete -force -- tfa tfad}
1619 
    file mkdir tfa tfad/tfa/file
1620 
    set r1 [catch {file rename tfa tfad}]
1621 
    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
1622 
    file delete -force tfa tfad
1623 
    set result
1624 
} {1}
1625 
 
1626 
test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} {
1627 
    catch {file delete -force -- tfa tfad}
1628 
    file mkdir tfa tfad/tfa/file
1629 
    set r1 [catch {file rename -force tfa tfad}]
1630 
    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
1631 
    file delete -force tfa tfad
1632 
    set result
1633 
} {1}
1634 
 
1635 
test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {
1636 
    catch {file delete -force -- tfa1}
1637 
    set r1 [catch {file rename tfa1 tfa2}]
1638 
    set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
1639 
} {1}
1640 
 
1641 
test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} {unixOnly} {
1642 
    catch {file delete -force -- tfa1 tfa2 tfa3}
1643 
 
1644 
    set s [createfile tfa1]
1645 
    exec ln -s tfa1 tfa2
1646 
    file rename tfa2 tfa3
1647 
    set t [file type tfa3]
1648 
    set result [expr { $t == "link" }]
1649 
    file delete tfa1 tfa3
1650 
    set result
1651 
} {1}
1652 
 
1653 
test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} {unixOnly} {
1654 
    catch {file delete -force -- tfa1 tfa2 tfa3}
1655 
 
1656 
    file mkdir tfa1
1657 
    exec ln -s tfa1 tfa2
1658 
    file rename tfa2 tfa3
1659 
    set t [file type tfa3]
1660 
    set result [expr { $t == "link" }]
1661 
    file delete tfa1 tfa3
1662 
    set result
1663 
} {1}
1664 
 
1665 
test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} {unixOnly} {
1666 
    catch {file delete -force -- tfa1 tfa2 tfa3}
1667 
 
1668 
    file mkdir tfa1/a/b/c/d
1669 
    file mkdir tfa2
1670 
    set f [file join [pwd] tfa1/a/b]
1671 
    set f2 [file join [pwd] {tfa2/b alias}]
1672 
    exec ln -s $f $f2
1673 
    file rename {tfa2/b alias/c} tfa3
1674 
    set r1 [file isdir tfa3]
1675 
    set r2 [file exists tfa1/a/b/c]
1676 
    set result [expr $r1 && !$r2]
1677 
    file delete -force tfa1 tfa2 tfa3
1678 
    set result
1679 
} {1}
1680 
 
1681 
test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} {unixOnly} {
1682 
    catch {file delete -force -- tfa1 tfa2 tfalink}
1683 
 
1684 
    file mkdir tfa1
1685 
    set s [createfile tfa2]
1686 
    exec ln -s tfa1 tfalink
1687 
 
1688 
    file rename tfa2 tfalink
1689 
    set result [checkcontent tfa1/tfa2 $s ]
1690 
    file delete -force tfa1 tfalink
1691 
    set result
1692 
} {1}
1693 
 
1694 
test fCmd-18.16 {TclFileRenameCmd : rename a dangling symlink} {unixOnly} {
1695 
    catch {file delete -force -- tfa1 tfalink}
1696 
 
1697 
    file mkdir tfa1
1698 
    exec ln -s tfa1 tfalink
1699 
    file delete tfa1
1700 
    file rename tfalink tfa2
1701 
    set result [expr [string compare [file type tfa2] "link"] == 0]
1702 
    file delete tfa2
1703 
    set result
1704 
} {1}
1705 
 
1706 
 
1707 
#
1708 
# Coverage tests for TclUnixRmdir
1709 
#
1710 
test fCmd-19.1 { remove empty directory } {
1711 
    catch {file delete -force -- tfa}
1712 
    file mkdir tfa
1713 
    file delete tfa
1714 
    file exists tfa
1715 
} {0}
1716 
 
1717 
test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly} {
1718 
    catch {file delete -force -- tfa}
1719 
    file mkdir tfa
1720 
    file mkdir tfa/a
1721 
    exec chmod 555 tfa
1722 
    set result [catch {file delete tfa/a}]
1723 
    exec chmod 777 tfa
1724 
    file delete -force tfa
1725 
    set result
1726 
} {1}
1727 
 
1728 
test fCmd-19.3 { recursive remove } {
1729 
    catch {file delete -force -- tfa}
1730 
    file mkdir tfa
1731 
    file mkdir tfa/a
1732 
    file delete -force tfa
1733 
    file exists tfa
1734 
} {0}
1735 
 
1736 
#
1737 
# TclUnixDeleteFile and TraversalDelete are covered by tests from the
1738 
# TclDeleteFilesCmd suite
1739 
#
1740 
#
1741 
 
1742 
#
1743 
# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
1744 
#
1745 
 
1746 
test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } {unixOnly} {
1747 
    catch {file delete -force -- tfa}
1748 
    file mkdir tfa
1749 
    file mkdir tfa/a
1750 
    exec chmod 000 tfa/a
1751 
    set result [catch {file delete -force tfa}]
1752 
    exec chmod 777 tfa/a
1753 
    file delete -force tfa
1754 
    set result
1755 
} {1}
1756 
 
1757 
 
1758 
#
1759 
# Feature testing for TclCopyFilesCmd
1760 
#
1761 
test fCmd-21.1 {copy : single file to nonexistant } {
1762 
    catch {file delete -force -- tfa1 tfa2}
1763 
    set s [createfile tfa1]
1764 
    file copy tfa1 tfa2
1765 
    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
1766 
    file delete tfa1 tfa2
1767 
    set result
1768 
} {1}
1769 
 
1770 
test fCmd-21.2 {copy : single dir to nonexistant } {
1771 
    catch {file delete -force -- tfa1 tfa2}
1772 
    file mkdir tfa1
1773 
    file copy tfa1 tfa2
1774 
    set result [expr [file isdir tfa2] && [file isdir tfa1]]
1775 
    file delete tfa1 tfa2
1776 
    set result
1777 
} {1}
1778 
 
1779 
test fCmd-21.3 {copy : single file into directory  } {
1780 
    catch {file delete -force -- tfa1 tfad}
1781 
    set s [createfile tfa1]
1782 
    file mkdir tfad
1783 
    file copy tfa1 tfad
1784 
    set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
1785 
    file delete -force tfa1 tfad
1786 
    set result
1787 
} {1}
1788 
 
1789 
test fCmd-21.4 {copy : more than one source and target is not a directory} {
1790 
    catch {file delete -force -- tfa1 tfa2 tfa3}
1791 
    createfile tfa1
1792 
    createfile tfa2
1793 
    createfile tfa3
1794 
    set result [catch {file copy tfa1 tfa2 tfa3}]
1795 
    file delete tfa1 tfa2 tfa3
1796 
    set result
1797 
} {1}
1798 
 
1799 
test fCmd-21.5 {copy : multiple files into directory  } {
1800 
    catch {file delete -force -- tfa1 tfa2 tfad}
1801 
    set s1 [createfile tfa1 ]
1802 
    set s2 [createfile tfa2 ]
1803 
    file mkdir tfad
1804 
    file copy tfa1 tfa2 tfad
1805 
    set r1 [checkcontent tfad/tfa1 $s1]
1806 
    set r2 [checkcontent tfad/tfa2 $s2]
1807 
    set r3 [checkcontent tfa1 $s1]
1808 
    set r4 [checkcontent tfa2 $s2]
1809 
    set result [expr $r1 && $r2 && $r3 && $r4]
1810 
    file delete -force tfa1 tfa2 tfad
1811 
    set result
1812 
} {1}
1813 
 
1814 
test fCmd-21.6 {copy : mixed dirs and files into directory  } {notFileSharing} {
1815 
    catch {file delete -force -- tfa1 tfad1 tfad2}
1816 
    set s [createfile tfa1 ]
1817 
    file mkdir tfad1 tfad2
1818 
    file copy tfa1 tfad1 tfad2
1819 
    set r1 [checkcontent [file join tfad2 tfa1] $s]
1820 
    set r2 [file isdir [file join tfad2 tfad1]]
1821 
    set r3 [checkcontent tfa1 $s]
1822 
    set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
1823 
    file delete -force tfa1 tfad1 tfad2
1824 
    set result
1825 
} {1}
1826 
 
1827 
test fCmd-21.7 {TclCopyFilesCmd : copy a dangling link } {unixOnly} {
1828 
    file mkdir tfad1
1829 
    exec ln -s tfad1 tfalink
1830 
    file delete tfad1
1831 
    file copy tfalink tfalink2
1832 
    set result [string match [file type tfalink2] link]
1833 
    file delete tfalink tfalink2
1834 
    set result
1835 
} {1}
1836 
 
1837 
test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly} {
1838 
    file mkdir tfad1
1839 
    exec ln -s tfad1 tfalink
1840 
    file copy tfalink tfalink2
1841 
    set r1 [file type tfalink]
1842 
    set r2 [file type tfalink2]
1843 
    set r3 [file isdir tfad1]
1844 
    set result [expr {("$r1" == "link" ) && ("$r2" == "link" ) && $r3}]
1845 
    file delete tfad1 tfalink tfalink2
1846 
    set result
1847 
} {1}
1848 
 
1849 
test fCmd-21.9 {TclCopyFilesCmd : copy dir with a link in it } {unixOnly} {
1850 
    file mkdir tfad1
1851 
    exec ln -s "[pwd]/tfad1" tfad1/tfalink
1852 
    file copy tfad1 tfad2
1853 
    set result [string match [file type tfad2/tfalink] link]
1854 
    file delete -force tfad1 tfad2
1855 
    set result
1856 
} {1}
1857 
 
1858 
test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} {
1859 
    catch {file delete -force -- tfa tfad}
1860 
    file mkdir tfa [file join tfad tfa]
1861 
    set r1 [catch {file copy tfa tfad}]
1862 
    set result [expr $r1 && [file isdir tfa]]
1863 
    file delete -force tfa tfad
1864 
    set result
1865 
} {1}
1866 
 
1867 
test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {
1868 
    catch {file delete -force -- tfa tfad}
1869 
    file mkdir tfa [file join tfad tfa file]
1870 
    set r1 [catch {file copy tfa tfad}]
1871 
    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
1872 
    file delete -force tfa tfad
1873 
    set result
1874 
} {1}
1875 
 
1876 
test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} {
1877 
    catch {file delete -force -- tfa tfad}
1878 
    file mkdir tfa [file join tfad tfa file]
1879 
    set r1 [catch {file copy -force tfa tfad}]
1880 
    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
1881 
    file delete -force tfa tfad
1882 
    set result
1883 
} {1}
1884 
 
1885 
#
1886 
# Coverage testing for TclpRenameFile
1887 
#
1888 
test fCmd-22.1 { TclpRenameFile : rename and overwrite in a single dir } {
1889 
    catch {file delete -force -- tfa1 tfa2}
1890 
    set s [createfile tfa1]
1891 
    set s2 [createfile tfa2 q]
1892 
 
1893 
    set r1 [catch {rename tfa1 tfa2}]
1894 
    file rename -force tfa1 tfa2
1895 
    set result [expr $r1 && [checkcontent tfa2 $s]]
1896 
    file delete [glob tfa1 tfa2]
1897 
    set result
1898 
} {1}
1899 
 
1900 
test fCmd-22.2 { TclpRenameFile : attempt to overwrite itself } {macOrUnix} {
1901 
    catch {file delete -force -- tfa1}
1902 
    set s [createfile tfa1]
1903 
    file rename -force tfa1 tfa1
1904 
    set result [checkcontent tfa1 $s]
1905 
    file delete tfa1
1906 
    set result
1907 
} {1}
1908 
 
1909 
test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {
1910 
    catch {file delete -force -- d1 tfad}
1911 
    file mkdir d1 [file join tfad d1]
1912 
    set r1 [catch {file rename d1 tfad}]
1913 
    set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
1914 
    file delete -force d1 tfad
1915 
    set result
1916 
} {1}
1917 
 
1918 
test fCmd-22.4 { TclpRenameFile : rename dir to dir several levels deep } {
1919 
    catch {file delete -force -- d1 tfad}
1920 
    file mkdir d1 [file join tfad a b c]
1921 
    file rename d1 [file join tfad a b c d1]
1922 
    set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
1923 
    file delete -force [glob d1 tfad]
1924 
    set result
1925 
} {1}
1926 
 
1927 
 
1928 
#
1929 
# TclMacCopyFile needs to be redone.
1930 
#
1931 
test fCmd-22.5 { TclMacCopyFile : copy and overwrite in a single dir } {
1932 
    catch {file delete -force -- tfa1 tfa2}
1933 
    set s [createfile tfa1]
1934 
    set s2 [createfile tfa2 q]
1935 
 
1936 
    set r1 [catch {file copy tfa1 tfa2}]
1937 
    file copy -force tfa1 tfa2
1938 
    set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
1939 
    file delete tfa1 tfa2
1940 
    set result
1941 
} {1}
1942 
 
1943 
#
1944 
# TclMacMkdir - basic cases are covered elsewhere.
1945 
# Error cases are not covered.
1946 
#
1947 
 
1948 
#
1949 
# TclMacRmdir
1950 
# Error cases are not covered.
1951 
#
1952 
 
1953 
test fCmd-23.1 { TclMacRmdir : trying to remove a nonempty directory } {
1954 
    catch {file delete -force -- tfad}
1955 
 
1956 
    file mkdir [file join tfad dir]
1957 
 
1958 
    set result [catch {file delete tfad}]
1959 
    file delete -force tfad
1960 
    set result
1961 
} {1}
1962 
 
1963 
#
1964 
# TclMacDeleteFile
1965 
# Error cases are not covered.
1966 
#
1967 
test fCmd-24.1 { TclMacDeleteFile : deleting a normal file } {
1968 
    catch {file delete -force -- tfa1}
1969 
 
1970 
    createfile tfa1
1971 
    file delete tfa1
1972 
    file exists tfa1
1973 
} {0}
1974 
 
1975 
#
1976 
# TclMacCopyDirectory
1977 
# Error cases are not covered.
1978 
#
1979 
test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} {notFileSharing} {
1980 
    catch {file delete -force -- tfad1 tfad2}
1981 
 
1982 
    file mkdir [file join tfad1 a b c]
1983 
    file copy tfad1 tfad2
1984 
    set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
1985 
    file delete -force tfad1 tfad2
1986 
    set result
1987 
} {1}
1988 
 
1989 
test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} {notFileSharing} {
1990 
    catch {file delete -force -- tfad1 tfad2}
1991 
 
1992 
    file mkdir tfad1
1993 
    file copy tfad1 tfad2
1994 
    set result [expr [file isdir tfad1] && [file isdir tfad2]]
1995 
    file delete tfad1 tfad2
1996 
    set result
1997 
} {1}
1998 
 
1999 
test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} {notFileSharing} {
2000 
    catch {file delete -force -- tfad1 tfad2}
2001 
 
2002 
    file mkdir [file join tfad1 x y z]
2003 
    file mkdir [file join tfad2 dir]
2004 
    file copy tfad1 [file join tfad2 dir]
2005 
    set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
2006 
    file delete -force tfad1 tfad2
2007 
    set result
2008 
} {1}
2009 
 
2010 
#
2011 
# Functionality tests for TclDeleteFilesCmd
2012 
#
2013 
 
2014 
test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly} {
2015 
    catch {file delete -force -- tfad1 tfad2}
2016 
 
2017 
    file mkdir tfad1
2018 
    exec ln -s tfad1 tfalink
2019 
    file delete tfalink
2020 
 
2021 
    set r1 [file isdir tfad1]
2022 
    set r2 [file exists tfalink]
2023 
 
2024 
    set result [expr $r1 && !$r2]
2025 
    file delete tfad1
2026 
    set result
2027 
} {1}
2028 
 
2029 
test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly} {
2030 
    catch {file delete -force -- tfad1 tfad2}
2031 
 
2032 
    file mkdir tfad1
2033 
    file mkdir tfad2
2034 
    exec ln -s tfad1 [file join tfad2 link]
2035 
    file delete -force tfad2
2036 
 
2037 
    set r1 [file isdir tfad1]
2038 
    set r2 [file exists tfad2]
2039 
 
2040 
    set result [expr $r1 && !$r2]
2041 
    file delete tfad1
2042 
    set result
2043 
} {1}
2044 
 
2045 
test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly} {
2046 
    catch {file delete -force -- tfad1 tfad2}
2047 
 
2048 
    file mkdir tfad1
2049 
    exec ln -s tfad1 tfad2
2050 
    file delete tfad1
2051 
    file delete tfad2
2052 
 
2053 
    set r1 [file exists tfad1]
2054 
    set r2 [file exists tfad2]
2055 
 
2056 
    set result [expr !$r1 && !$r2]
2057 
    set result
2058 
} {1}
2059 
 
2060 
test fCmd-27.1 {TclFileAttrsCmd - wrong # args} {
2061 
    list [catch {file attributes a b c d} msg] $msg
2062 
} {1 {wrong # args: must be "file attributes name ?option? ?value? ?option value? ..."}}
2063 
test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {
2064 
    testsetplatform unix
2065 
    list [catch {file attributes ~_bad_user} msg] $msg [testsetplatform $platform]
2066 
} {1 {user "_bad_user" doesn't exist} {}}
2067 
test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
2068 
    catch {file delete -force -- foo.tmp}
2069 
    createfile foo.tmp
2070 
    list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]
2071 
} {0 1 {}}
2072 
test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
2073 
    catch {file delete -force -- foo.tmp}
2074 
    createfile foo.tmp
2075 
    set attrs [file attributes foo.tmp]
2076 
    list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]
2077 
} {0 {}}
2078 
 
2079 
set testConfig(tclGroup) 0
2080 
if {($tcl_platform(platform) == "macintosh") \
2081 
        || ($tcl_platform(platform) == "windows")} {
2082 
    set testConfig(tclGroup) 1
2083 
} elseif {[catch {exec {groups}} groupList] == 0} {
2084 
    if {[lsearch $groupList tcl] != -1} {
2085 
        set testConfig(tclGroup) 1
2086 
    }
2087 
}
2088 
 
2089 
test fCmd-27.5 {TclFileAttrsCmd - setting one option} {tclGroup} {
2090 
    catch {file delete -force -- foo.tmp}
2091 
    createfile foo.tmp
2092 
    set attrs [file attributes foo.tmp]
2093 
    list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
2094 
} {0 {} {}}
2095 
test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {tclGroup} {
2096 
    catch {file delete -force -- foo.tmp}
2097 
    createfile foo.tmp
2098 
    set attrs [file attributes foo.tmp]
2099 
    list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
2100 
} {0 {} {}}
2101 
 
2102 
cleanup

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.