Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/fCmd.test @ 47

Last change on this file since 47 was 25, checked in by landauf, 17 years ago

added tcl to libs

File size: 83.2 KB
Line 
1# This file tests the tclFCmd.c file.
2#
3# This file contains a collection of tests for one or more of the Tcl built-in
4# commands. Sourcing this file into Tcl runs the tests and generates output
5# for errors. No output means no errors were found.
6#
7# Copyright (c) 1996-1997 Sun Microsystems, Inc.
8# Copyright (c) 1999 by Scriptics Corporation.
9#
10# See the file "license.terms" for information on usage and redistribution of
11# this file, and for a DISCLAIMER OF ALL WARRANTIES.
12#
13# RCS: @(#) $Id: fCmd.test,v 1.60 2008/03/28 11:18:48 dkf Exp $
14#
15
16if {[lsearch [namespace children] ::tcltest] == -1} {
17    package require tcltest 2
18    namespace import -force ::tcltest::*
19}
20
21testConstraint testsetplatform [llength [info commands testsetplatform]]
22testConstraint testchmod [llength [info commands testchmod]]
23# Don't know how to determine this constraint correctly
24testConstraint notNetworkFilesystem 0
25testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
26testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
27
28# Find a group that exists on this Unix system, or else skip tests that
29# require Unix groups.
30testConstraint foundGroup [expr {![testConstraint unix]}]
31if {[testConstraint unix]} {
32    catch {
33        set groupList [exec groups]
34        set group [lindex $groupList 0]
35        testConstraint foundGroup 1
36    }
37}
38
39testConstraint darwin9 [expr {[testConstraint unix] &&
40        $tcl_platform(os) eq "Darwin" &&
41        int([string range $tcl_platform(osVersion) 0 \
42        [string first . $tcl_platform(osVersion)]]) >= 9}]
43testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
44
45testConstraint fileSharing 0
46testConstraint notFileSharing 1
47testConstraint linkFile 1
48testConstraint linkDirectory 1
49
50# Several tests require need to match results against the unix username
51set user {}
52if {[testConstraint unix]} {
53    catch {
54        set user [exec whoami]
55    }
56    if {$user eq ""} {
57        catch {
58            regexp {^[^(]*\(([^)]*)\)} [exec id] -> user
59        }
60    }
61    if {$user eq ""} {
62        set user "root"
63    }
64}
65
66proc createfile {file {string a}} {
67    set f [open $file w]
68    puts -nonewline $f $string
69    close $f
70    return $string
71}
72
73#
74# checkcontent --
75#
76#  Ensures that file "file" contains only the string "matchString" returns 0
77#  if the file does not exist, or has a different content
78#
79proc checkcontent {file matchString} {
80    if {[catch {
81        set f [open $file]
82        set fileString [read $f]
83        close $f
84    }]} {
85        return 0
86    }
87    return [string match $matchString $fileString]
88}
89
90proc openup {path} {
91    testchmod 777 $path
92    if {[file isdirectory $path]} {
93        catch {
94            foreach p [glob -directory $path *] {
95                openup $p
96            }
97        }
98    }
99}
100
101proc cleanup {args} {
102    set wd [list .]
103    foreach p [concat $wd $args] {
104        set x ""
105        catch {
106            set x [glob -directory $p tf* td*]
107        }
108        foreach file $x {
109            if {
110                [catch {file delete -force -- $file}]
111                && [testConstraint testchmod]
112            } then {
113                catch {openup $file}
114                catch {file delete -force -- $file}
115            }
116        }
117    }
118}
119
120proc contents {file} {
121    set f [open $file]
122    set r [read $f]
123    close $f
124    return $r
125}
126
127cd [temporaryDirectory]
128
129proc dev dir {
130    file stat $dir stat
131    return $stat(dev)
132}
133testConstraint xdev [expr {[testConstraint unix] && ([dev .] != [dev /tmp])}]
134
135set root [lindex [file split [pwd]] 0]
136
137# A really long file name
138# length of long is 1216 chars, which should be greater than any static buffer
139# or allowable filename.
140
141set long "abcdefghihjllmnopqrstuvwxyz01234567890"
142append long $long
143append long $long
144append long $long
145append long $long
146append long $long
147
148test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
149    cleanup
150    createfile tf1
151    file rename tf1 tf2
152    glob tf*
153} {tf2}
154
155test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
156    cleanup
157    createfile tf1
158    file copy tf1 tf2
159    lsort [glob tf*]
160} {tf1 tf2}
161
162test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
163    file rename -xyz
164} -returnCodes error -result {bad option "-xyz": should be -force or --}
165test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body {
166    file rename xyz
167} -returnCodes error -result {wrong # args: should be "file rename ?options? source ?source ...? target"}
168test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
169    file rename xyz ~_totally_bogus_user
170} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
171test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup {
172    cleanup
173} -constraints {notRoot} -returnCodes error -body {
174    file copy tf1 ~
175} -result {error copying "tf1": no such file or directory}
176test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} -setup {
177    cleanup
178} -constraints {notRoot} -returnCodes error -body {
179    file rename tf1 tf2 tf3
180} -result {error renaming: target "tf3" is not a directory}
181test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} -setup {
182    cleanup
183} -constraints {notRoot} -returnCodes error -body {
184    createfile tf3
185    file rename tf1 tf2 tf3
186} -result {error renaming: target "tf3" is not a directory}
187test fCmd-3.7 {FileCopyRename: target exists & is directory} -setup {
188    cleanup
189} -constraints {notRoot} -body {
190    file mkdir td1
191    createfile tf1 tf1
192    file rename tf1 td1
193    contents [file join td1 tf1]
194} -result {tf1}
195test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} -setup {
196    cleanup
197} -constraints {notRoot} -returnCodes error -body {
198    file rename tf1 tf2 tf3
199} -result {error renaming: target "tf3" is not a directory}
200test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup {
201    cleanup
202} -constraints {notRoot} -returnCodes error -body {
203    file copy -force -- tf1 tf2 tf3
204} -result {error copying: target "tf3" is not a directory}
205test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
206    cleanup
207    createfile tf1 tf1
208    file rename tf1 tf2
209    contents tf2
210} {tf1}
211test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
212    cleanup
213    createfile tf1 tf1
214    file rename -force -force -- tf1 tf2
215    contents tf2
216} {tf1}
217test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
218    cleanup
219    createfile tf1 tf1
220    file mkdir td1
221    file rename tf1 td1
222    contents [file join td1 tf1]
223} {tf1}
224test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
225    cleanup
226    createfile tf1 tf1
227    createfile tf2 tf2
228    createfile tf3 tf3
229    createfile tf4 tf4
230    file mkdir td1
231    file rename tf1 tf2 tf3 tf4 td1
232    list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
233        [contents [file join td1 tf3]] [contents [file join td1 tf4]]
234} {tf1 tf2 tf3 tf4}
235test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
236    cleanup
237} -constraints {notRoot} -returnCodes error -body {
238    file mkdir td1
239    file rename ~_totally_bogus_user td1
240} -result {user "_totally_bogus_user" doesn't exist}
241test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup {
242    cleanup
243} -constraints {notRoot unixOrPc} -returnCodes error -body {
244    file mkdir td1
245    file rename / td1
246} -result {error renaming "/" to "td1": file already exists}
247test fCmd-3.16 {FileCopyRename: break on first error} -setup {
248    cleanup
249} -constraints {notRoot} -returnCodes error -body {
250    createfile tf1
251    createfile tf2
252    createfile tf3
253    createfile tf4
254    file mkdir td1
255    createfile [file join td1 tf3]
256    file rename tf1 tf2 tf3 tf4 td1
257} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}]
258
259test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
260    cleanup
261    file mkdir td1
262    glob td*
263} {td1}
264test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
265    cleanup
266    file mkdir td1 td2 td3
267    lsort [glob td*]
268} {td1 td2 td3}
269test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
270    cleanup
271    createfile tf1
272    catch {file mkdir td1 td2 tf1 td3 td4}
273    glob td1 td2 tf1 td3 td4
274} {td1 td2 tf1}
275test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup {
276    cleanup
277} -constraints {notRoot} -returnCodes error -body {
278    file mkdir ~_totally_bogus_user
279} -result {user "_totally_bogus_user" doesn't exist}
280test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setup {
281    cleanup
282} -constraints {notRoot} -returnCodes error -body {
283    file mkdir ""
284} -result {can't create directory "": no such file or directory}
285test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {
286    cleanup
287    file mkdir td1
288    glob td1
289} {td1}
290test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
291    cleanup
292    file mkdir [file join td1 td2 td3 td4]
293    glob td1 [file join td1 td2]
294} "td1 [file join td1 td2]"
295test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
296    cleanup
297    file mkdir td1
298    set x [file exists td1]
299    file mkdir td1
300    list $x [file exists td1]
301} {1 1}
302test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup {
303    cleanup
304} -constraints {notRoot} -returnCodes error -body {
305    createfile tf1
306    file mkdir tf1
307} -result [subst {can't create directory "[file join tf1]": file already exists}]
308test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
309    cleanup
310    file mkdir td1
311    set x [file exists td1]
312    file mkdir td1
313    list $x [file exists td1]
314} {1 1}
315test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
316    cleanup
317} -constraints {unix notRoot testchmod} -returnCodes error -body {
318    file mkdir td1/td2/td3
319    testchmod 000 td1/td2
320    file mkdir td1/td2/td3/td4
321} -cleanup {
322    testchmod 755 td1/td2
323    cleanup
324} -result {can't create directory "td1/td2/td3": permission denied}
325test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup {
326    cleanup
327} -constraints {notRoot} -body {
328    set x [file exists td1]
329    file mkdir td1
330    list $x [file exists td1]
331} -result {0 1}
332test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
333    cleanup
334    file delete -force foo
335} -constraints {unix notRoot} -body {
336    file mkdir foo
337    file attr foo -perm 040000
338    file mkdir foo/tf1
339} -returnCodes error -cleanup {
340    file delete -force foo
341} -result {can't create directory "foo/tf1": permission denied}
342test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
343    cleanup
344    file mkdir tf1
345    file exists tf1
346} {1}
347
348test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
349    file delete -xyz
350} -returnCodes error -result {bad option "-xyz": should be -force or --}
351test fCmd-5.2 {TclFileDeleteCmd: not enough args} -constraints {notRoot} -body {
352    file delete -force -force
353} -returnCodes error -result {wrong # args: should be "file delete ?options? file ?file ...?"}
354test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
355    cleanup
356    createfile tf1
357    createfile tf2
358    file mkdir td1
359    file delete tf2
360    glob tf* td*
361} {tf1 td1}
362test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
363    cleanup
364    createfile tf1
365    createfile tf2
366    file mkdir td1
367    set x [list [file exists tf1] [file exists tf2] [file exists td1]]
368    file delete tf1 td1 tf2
369    lappend x [file exists tf1] [file exists tf2] [file exists tf3]
370} {1 1 1 0 0 0}
371test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
372    cleanup
373    createfile tf1
374    createfile tf2
375    file mkdir td1
376    catch {file delete tf1 td1 $root tf2}
377    list [file exists tf1] [file exists tf2] [file exists td1]
378} {0 1 0}
379test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
380    file delete ~_totally_bogus_user
381} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
382test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
383    catch {file delete ~/tf1}
384    createfile ~/tf1
385    file delete ~/tf1
386} {}
387test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
388    cleanup
389    set x [file exists tf1]
390    file delete tf1
391    list $x [file exists tf1]
392} {0 0}
393test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
394    cleanup
395    file mkdir td1
396    file delete td1
397    file exists td1
398} {0}
399test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup {
400    cleanup
401} -constraints {notRoot} -returnCodes error -body {
402    file mkdir [file join td1 td2]
403    file delete td1
404} -result {error deleting "td1": directory not empty}
405test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup {
406    cleanup
407    set dir [pwd]
408} -constraints {notRoot} -body {
409    file mkdir [file join td1 td2]
410    cd [file join td1 td2]
411    set res [list [catch {file delete -force [file dirname [pwd]]} msg]]
412    cd $dir
413    lappend res [file exists td1] $msg
414} -cleanup {
415    cd $dir
416} -result {0 0 {}}
417test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unix} {
418    cleanup
419    file mkdir [file join td1 td2]
420    #exec chmod u-rwx [file join td1 td2]
421    file attributes [file join td1 td2] -permissions u+rwx
422    set res [list [catch {file delete -force td1} msg]]
423    lappend res [file exists td1] $msg
424} {0 0 {}}
425
426test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} {
427    # can't test this, because it's caught by FileCopyRename
428} {}
429test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot emptyTest} {
430    # can't test this, because it's caught by FileCopyRename
431} {}
432test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup {
433    cleanup
434} -constraints {notRoot} -returnCodes error -body {
435    file rename tf1 tf2
436} -result {error renaming "tf1": no such file or directory}
437test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
438    cleanup
439    createfile tf1
440    file rename tf1 tf2
441    glob tf*
442} {tf2}
443test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
444    cleanup
445    createfile tf1
446    file rename tf1 tf2
447    glob tf*
448} {tf2}
449test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
450    cleanup
451} -constraints {unix notRoot testchmod} -body {
452    file mkdir td1
453    testchmod 000 td1
454    createfile tf1
455    file rename tf1 td1
456} -returnCodes error -cleanup {
457    testchmod 755 td1
458} -result {error renaming "tf1" to "td1/tf1": permission denied}
459test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup {
460    cleanup
461} -constraints {win 95} -returnCodes error -body {
462    createfile tf1
463    file rename tf1 $long
464} -result [subst {error renaming "tf1" to "$long": file name too long}]
465test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unix notRoot} {
466    cleanup
467    createfile tf1
468    file rename tf1 tf2
469    glob tf*
470} {tf2}
471test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup {
472    cleanup
473} -constraints {notRoot} -returnCodes error -body {
474    createfile tf1
475    createfile tf2
476    file rename tf1 tf2
477} -result {error renaming "tf1" to "tf2": file already exists}
478test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup {
479    cleanup
480} -constraints {notRoot} -returnCodes error -body {
481    createfile tf1
482    createfile tf2
483    file rename tf1 tf2
484} -result {error renaming "tf1" to "tf2": file already exists}
485test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
486    cleanup
487    createfile tf1
488    createfile tf2
489    file rename -force tf1 tf2
490    glob tf*
491} {tf2}
492test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup {
493    cleanup
494} -constraints {notRoot} -returnCodes error -body {
495    file mkdir td1
496    file mkdir td2
497    createfile [file join td2 td1]
498    file rename -force td1 td2
499} -result [subst {can't overwrite file "[file join td2 td1]" with directory "td1"}]
500test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} -setup {
501    cleanup
502} -constraints {notRoot} -returnCodes error -body {
503    createfile tf1
504    file mkdir [file join td1 tf1]
505    file rename -force tf1 td1
506} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
507test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} -setup {
508    cleanup
509} -constraints {notRoot notNetworkFilesystem} -body {
510    file mkdir [file join td1 td2]
511    file mkdir td2
512    createfile [file join td2 tf1]
513    file rename -force td2 td1
514    file exists [file join td1 td2 tf1]
515} -result 1
516test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup {
517    cleanup
518} -constraints {notRoot} -body {
519    file mkdir [file join td1 td2]
520    createfile [file join td1 td2 tf1]
521    file mkdir td2
522    file rename -force td2 td1
523} -returnCodes error -match glob -result \
524    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
525test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup {
526    cleanup
527} -constraints {notRoot} -returnCodes error -body {
528    file rename -force $root tf1
529} -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}]
530test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
531    cleanup
532} -constraints {notRoot} -body {
533    file mkdir [file join td1 td2]
534    createfile [file join td1 td2 tf1]
535    file mkdir td2
536    file rename -force td2 td1
537} -returnCodes error -match glob -result \
538    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
539test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unix notRoot} {
540    cleanup /tmp
541    createfile tf1
542    file rename tf1 /tmp
543    glob -nocomplain tf* /tmp/tf1
544} {/tmp/tf1}
545test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
546    catch {file delete -force c:/tcl8975@ d:/tcl8975@}
547} -body {
548    file mkdir c:/tcl8975@
549    if {[catch {file rename c:/tcl8975@ d:/}]} {
550        return d:/tcl8975@
551    }
552    glob c:/tcl8975@ d:/tcl8975@
553} -cleanup {
554    file delete -force c:/tcl8975@
555    catch {file delete -force d:/tcl8975@}
556} -result {d:/tcl8975@}
557test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
558        {unix notRoot} {
559    cleanup /tmp
560    file mkdir td1
561    file rename td1 /tmp
562    glob -nocomplain td* /tmp/td*
563} {/tmp/td1}
564test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
565        {unix notRoot} {
566    cleanup /tmp
567    createfile tf1
568    file rename tf1 /tmp
569    glob -nocomplain tf* /tmp/tf*
570} {/tmp/tf1}
571test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
572    cleanup /tmp
573} -constraints {unix notRoot xdev} -body {
574    file mkdir td1/td2/td3
575    file attributes td1 -permissions 0000
576    file rename td1 /tmp
577} -returnCodes error -cleanup {
578    file attributes td1 -permissions 0755
579} -result {error renaming "td1": permission denied}
580test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
581    cleanup
582} -constraints {unix notRoot} -body {
583    file mkdir ~/td1/td2
584    set td1name [file join [file dirname ~] [file tail ~] td1]
585    file attributes $td1name -permissions 0000
586    file copy ~/td1 td1
587} -returnCodes error -cleanup {
588    file attributes $td1name -permissions 0755
589    file delete -force ~/td1
590} -result {error copying "~/td1": permission denied}
591test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup {
592    cleanup
593} -constraints {unix notRoot} -body {
594    file mkdir td2
595    file mkdir ~/td1
596    set td1name [file join [file dirname ~] [file tail ~] td1]
597    file attributes $td1name -permissions 0000
598    file copy td2 ~/td1
599} -returnCodes error -cleanup {
600    file attributes $td1name -permissions 0755
601    file delete -force ~/td1
602} -result {error copying "td2" to "~/td1/td2": permission denied}
603test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
604    cleanup
605} -constraints {unix notRoot} -body {
606    file mkdir ~/td1/td2
607    set td2name [file join [file dirname ~] [file tail ~] td1 td2]
608    file attributes $td2name -permissions 0000
609    file copy ~/td1 td1
610} -returnCodes error -cleanup {
611    file attributes $td2name -permissions 0755
612    file delete -force ~/td1
613} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied"
614test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
615    cleanup /tmp
616} -constraints {unix notRoot xdev} -returnCodes error -body {
617    file mkdir td1/td2/td3
618    file mkdir /tmp/td1
619    createfile /tmp/td1/tf1
620    file rename -force td1 /tmp
621} -result {error renaming "td1" to "/tmp/td1": file already exists}
622test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
623    cleanup /tmp
624} -constraints {unix notRoot xdev} -body {
625    file mkdir td1/td2/td3
626    file attributes td1/td2/td3 -permissions 0000
627    file rename td1 /tmp
628} -returnCodes error -cleanup {
629    file attributes td1/td2/td3 -permissions 0755
630} -result {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}
631test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
632    cleanup /tmp
633} -constraints {unix notRoot xdev} -body {
634    file mkdir td1/td2/td3
635    file rename td1 /tmp
636    glob td* /tmp/td1/t*
637} -result {/tmp/td1/td2}
638test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
639    cleanup
640} -constraints {unix notRoot} -body {
641    file mkdir foo/bar
642    file attr foo -perm 040555
643    file rename foo/bar /tmp
644} -returnCodes error -cleanup {
645    catch {file delete /tmp/bar}
646    catch {file attr foo -perm 040777}
647    catch {file delete -force foo}
648} -match glob -result {*: permission denied}
649test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
650    catch {cleanup /tmp}
651} -constraints {unix notRoot xdev} -body {
652    file mkdir /tmp/td1
653    createfile /tmp/td1/tf1
654    file rename /tmp/td1/tf1 tf1
655    list [file exists /tmp/td1/tf1] [file exists tf1]
656} -result {0 1}
657test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup {
658    cleanup
659} -returnCodes error -body {
660    file copy tf1 tf2
661} -result {error copying "tf1": no such file or directory}
662catch {cleanup /tmp}
663
664test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup {
665    cleanup
666} -returnCodes error -body {
667    file mkdir [file join tf1 tf2]
668    file delete tf1
669} -result {error deleting "tf1": directory not empty}
670test fCmd-7.2 {FileForceOption: -force} {notRoot} {
671    cleanup
672    file mkdir [file join tf1 tf2]
673    file delete -force tf1
674} {}
675test fCmd-7.3 {FileForceOption: --} {notRoot} {
676    createfile -tf1
677    file delete -- -tf1
678} {}
679test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
680    createfile -tf1
681} -body {
682    file delete -tf1
683} -returnCodes error -cleanup {
684    file delete -- -tf1
685} -result {bad option "-tf1": should be -force or --}
686test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
687    cleanup
688} -constraints {notRoot} -returnCodes error -body {
689    createfile --
690    createfile -force
691    file delete -force -force -- -- -force
692    glob -- -- -force
693} -result {no files matched glob patterns "-- -force"}
694
695test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
696    -constraints {unix notRoot knownBug} -body {
697    # Labelled knownBug because it is dangerous [Bug: 3881]
698    file mkdir td1
699    file attr td1 -perm 040000
700    file rename ~$user td1
701} -returnCodes error -cleanup {
702    file delete -force td1
703} -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied"
704test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
705        {unix notRoot} {
706    string equal [file tail ~$user] ~$user
707} 0
708test fCmd-8.3 {file copy and path translation: ensure correct error} -body {
709    file copy ~ [file join this file doesnt exist]
710} -returnCodes error -result [subst \
711        {error copying "~" to "[file join this file doesnt exist]": no such file or directory}]
712
713test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
714    cleanup
715} -constraints {unix notRoot} -body {
716    file mkdir td1
717    file mkdir td2
718    file attr td2 -perm 040000
719    file rename td1 td2/
720} -returnCodes error -cleanup {
721    file delete -force td2
722    file delete -force td1
723} -result {error renaming "td1" to "td2/td1": permission denied}
724test fCmd-9.2 {file rename: comprehensive: source doesn't exist} -setup {
725    cleanup
726} -constraints {notRoot} -returnCodes error -body {
727    file rename tf1 tf2
728} -result {error renaming "tf1": no such file or directory}
729test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
730    cleanup
731} -constraints {notRoot testchmod} -body {
732    createfile tf1
733    createfile tf2
734    testchmod 444 tf2
735    file rename tf1 tf3
736    file rename tf2 tf4
737    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
738} -result {{tf3 tf4} 1 0}
739test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup {
740    cleanup
741} -constraints {unixOrPc notRoot testchmod notDarwin9} -body {
742    file mkdir td1 td2
743    testchmod 555 td2
744    file rename td1 td3
745    file rename td2 td4
746    list [lsort [glob td*]] [file writable td3] [file writable td4]
747} -cleanup {
748    cleanup
749} -result {{td3 td4} 1 0}
750test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
751    cleanup
752    createfile tf1 tf1
753    createfile tf2 tf2
754    testchmod 444 tf2
755    file rename -force tf1 tf1
756    file rename -force tf2 tf2
757    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
758} {tf1 tf2 1 0}
759test fCmd-9.6 {file rename: comprehensive: dir to self} -setup {
760    cleanup
761} -constraints {notRoot unixOrPc testchmod} -body {
762    file mkdir td1
763    file mkdir td2
764    testchmod 555 td2
765    file rename -force td1 .
766    file rename -force td2 .
767    list [lsort [glob td*]] [file writable td1] [file writable td2]
768} -result {{td1 td2} 1 0}
769test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup {
770    cleanup
771} -constraints {notRoot testchmod} -body {
772    createfile tf1
773    createfile tf2
774    createfile tfs1
775    createfile tfs2
776    createfile tfs3
777    createfile tfs4
778    createfile tfd1
779    createfile tfd2
780    createfile tfd3
781    createfile tfd4
782    testchmod 444 tfs3
783    testchmod 444 tfs4
784    testchmod 444 tfd2
785    testchmod 444 tfd4
786    set msg [list [catch {file rename tf1 tf2} msg] $msg]
787    file rename -force tfs1 tfd1
788    file rename -force tfs2 tfd2
789    file rename -force tfs3 tfd3
790    file rename -force tfs4 tfd4
791    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
792} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
793test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
794    cleanup
795} -constraints {notRoot testchmod notNetworkFilesystem} -body {
796    # Under unix, you can rename a read-only directory, but you can't
797    # move it into another directory.
798
799    file mkdir td1
800    file mkdir [file join td2 td1]
801    file mkdir tds1
802    file mkdir tds2
803    file mkdir tds3
804    file mkdir tds4
805    file mkdir [file join tdd1 tds1]
806    file mkdir [file join tdd2 tds2]
807    file mkdir [file join tdd3 tds3]
808    file mkdir [file join tdd4 tds4]
809    if {![testConstraint unix]} {
810        testchmod 555 tds3
811        testchmod 555 tds4
812    }
813    testchmod 555 [file join tdd2 tds2]
814    testchmod 555 [file join tdd4 tds4]
815    set msg [list [catch {file rename td1 td2} msg] $msg]
816    file rename -force tds1 tdd1
817    file rename -force tds2 tdd2
818    file rename -force tds3 tdd3
819    file rename -force tds4 tdd4
820    if {[testConstraint unix]} {
821        set w3 0
822        set w4 0
823    } else {
824        set w3 [file writable [file join tdd3 tds3]]
825        set w4 [file writable [file join tdd4 tds4]]
826    }
827    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
828    [file writable [file join tdd2 tds2]] $w3 $w4
829} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
830# Test can hit EEXIST or EBUSY, depending on underlying filesystem
831test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
832    cleanup
833} -constraints {notRoot testchmod} -body {
834    file mkdir tds1
835    file mkdir tds2
836    file mkdir [file join tdd1 tds1 xxx]
837    file mkdir [file join tdd2 tds2 xxx]
838    if {![testConstraint unix]} {
839        testchmod 555 tds2
840    }
841    set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
842    set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
843    if {[testConstraint unix]} {
844        set w2 0
845    } else {
846        set w2 [file writable tds2]
847    }
848    list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
849} -match glob -result \
850    [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file *}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file *}} 1 0}]
851test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
852    cleanup
853    createfile tf1
854    createfile tf2
855    file mkdir td1
856    testchmod 444 tf2
857    file rename tf1 [file join td1 tf3]
858    file rename tf2 [file join td1 tf4]
859    list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
860    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
861} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
862test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {
863    cleanup
864    file mkdir td1
865    file mkdir td2
866    file mkdir td3
867    if {![testConstraint unix]} {
868        testchmod 555 td2
869    }
870    file rename td1 [file join td3 td3]
871    file rename td2 [file join td3 td4]
872    if {[testConstraint unix]} {
873        set w4 0
874    } else {
875        set w4 [file writable [file join td3 td4]]
876    }
877    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
878    [file writable [file join td3 td3]] $w4
879} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
880test fCmd-9.12 {file rename: comprehensive: target exists} -setup {
881    cleanup
882} -constraints {notRoot testchmod notNetworkFilesystem} -body {
883    file mkdir [file join td1 td2] [file join td2 td1]
884    testchmod 555 [file join td2 td1]
885    file mkdir [file join td3 td4] [file join td4 td3]
886    file rename -force td3 td4
887    list [file exists td3] [file exists [file join td4 td3 td4]] \
888        [catch {file rename td1 td2} msg] $msg
889} -cleanup {
890    testchmod 755 [file join td2 td1]
891} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
892# Test can hit EEXIST or EBUSY, depending on underlying filesystem
893test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
894    cleanup
895} -constraints {notRoot} -body {
896    file mkdir [file join td1 td2] [file join td2 td1 td4]
897    file rename -force td1 td2
898} -returnCodes error -match glob -result \
899    [subst {error renaming "td1" to "[file join td2 td1]": file *}]
900test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
901    cleanup
902    file mkdir td1
903    list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
904} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
905test fCmd-9.14.1 {file rename: comprehensive: dir into self} {notRoot} {
906    cleanup
907    file mkdir td1
908    file rename td1 td1x
909    file rename td1x td1
910    set msg "ok"
911} {ok}
912test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup {
913    cleanup
914    set dir [pwd]
915} -constraints {nonPortable notRoot} -body {
916    file mkdir td1
917    cd td1
918    file rename [file join .. td1] [file join .. td1x]
919} -returnCodes error -cleanup {
920    cd $dir
921} -result [subst {error renaming "[file join .. td1]" to "[file join .. td1x]": permission denied}]
922test fCmd-9.14.3 {file rename: comprehensive: dir into self} -setup {
923    cleanup
924    set dir [pwd]
925} -constraints {notRoot} -body {
926    file mkdir td1
927    cd td1
928    file rename [file join .. td1] [file join .. td1 foo]
929} -returnCodes error -cleanup {
930    cd $dir
931} -result [subst {error renaming "[file join .. td1]" to "[file join .. td1 foo]": trying to rename a volume or move a directory into itself}]
932test fCmd-9.15 {file rename: comprehensive: source and target incompatible} -setup {
933    cleanup
934} -constraints {notRoot} -returnCodes error -body {
935    file mkdir td1
936    createfile tf1
937    file rename -force td1 tf1
938} -cleanup {
939    cleanup
940} -result {can't overwrite file "tf1" with directory "td1"}
941test fCmd-9.16 {file rename: comprehensive: source and target incompatible} -setup {
942    cleanup
943} -constraints {notRoot} -returnCodes error -body {
944    file mkdir td1/tf1
945    createfile tf1
946    file rename -force tf1 td1
947} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
948
949test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup {
950    cleanup
951} -constraints {notRoot} -returnCodes error -body {
952    file copy tf1 tf2
953} -result {error copying "tf1": no such file or directory}
954test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
955    cleanup
956    createfile tf1 tf1
957    createfile tf2 tf2
958    testchmod 444 tf2
959    file copy tf1 tf3
960    file copy tf2 tf4
961    list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
962} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
963test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
964    cleanup
965} -constraints {notRoot unixOrPc 95or98 testchmod} -body {
966    file mkdir [file join td1 tdx]
967    file mkdir [file join td2 tdy]
968    testchmod 555 td2
969    file copy td1 td3
970    file copy td2 td4
971    list [lsort [glob td*]] [glob -directory td3 t*] \
972            [glob -directory td4 t*] [file writable td3] [file writable td4]
973} -cleanup {
974    testchmod 755 td2
975    testchmod 755 td4
976} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0]
977test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
978    cleanup
979} -constraints {notRoot win 2000orNewer testchmod} -body {
980    # On Windows with ACLs, copying a directory is defined like this
981    file mkdir [file join td1 tdx]
982    file mkdir [file join td2 tdy]
983    testchmod 555 td2
984    file copy td1 td3
985    file copy td2 td4
986    list [lsort [glob td*]] [glob -directory td3 t*] \
987            [glob -directory td4 t*] [file writable td3] [file writable td4]
988} -cleanup {
989    testchmod 755 td2
990    testchmod 755 td4
991} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1]
992test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup {
993    cleanup
994} -constraints {notRoot testchmod} -body {
995    createfile tf1
996    createfile tf2
997    createfile tfs1
998    createfile tfs2
999    createfile tfs3
1000    createfile tfs4
1001    createfile tfd1
1002    createfile tfd2
1003    createfile tfd3
1004    createfile tfd4
1005    testchmod 444 tfs3
1006    testchmod 444 tfs4
1007    testchmod 444 tfd2
1008    testchmod 444 tfd4
1009    set msg [list [catch {file copy tf1 tf2} msg] $msg]
1010    file copy -force tfs1 tfd1
1011    file copy -force tfs2 tfd2
1012    file copy -force tfs3 tfd3
1013    file copy -force tfs4 tfd4
1014    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
1015} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
1016test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
1017    cleanup
1018} -constraints {notRoot testchmod} -body {
1019    file mkdir td1
1020    file mkdir [file join td2 td1]
1021    file mkdir tds1
1022    file mkdir tds2
1023    file mkdir tds3
1024    file mkdir tds4
1025    file mkdir [file join tdd1 tds1]
1026    file mkdir [file join tdd2 tds2]
1027    file mkdir [file join tdd3 tds3]
1028    file mkdir [file join tdd4 tds4]
1029    testchmod 555 tds3
1030    testchmod 555 tds4
1031    testchmod 555 [file join tdd2 tds2]
1032    testchmod 555 [file join tdd4 tds4]
1033    set a1 [list [catch {file copy td1 td2} msg] $msg]
1034    set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
1035    set a3 [catch {file copy -force tds2 tdd2}]
1036    set a4 [catch {file copy -force tds3 tdd3}]
1037    set a5 [catch {file copy -force tds4 tdd4}]
1038    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
1039} -result [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}]
1040test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
1041    cleanup
1042} -constraints {notRoot unixOrPc testchmod} -body {
1043    file mkdir tds1
1044    file mkdir tds2
1045    file mkdir [file join tdd1 tds1 xxx]
1046    file mkdir [file join tdd2 tds2 xxx]
1047    testchmod 555 tds2
1048    set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
1049    set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
1050    list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
1051} -result [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}]
1052test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
1053    cleanup
1054} -constraints {notRoot testchmod} -body {
1055    createfile tf1
1056    createfile tf2
1057    file mkdir td1
1058    testchmod 444 tf2
1059    file copy tf1 [file join td1 tf3]
1060    file copy tf2 [file join td1 tf4]
1061    list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \
1062    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
1063} -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
1064test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
1065    cleanup
1066} -constraints {notRoot unixOrPc 95or98 testchmod} -body {
1067    file mkdir td1
1068    file mkdir td2
1069    file mkdir td3
1070    testchmod 555 td2
1071    file copy td1 [file join td3 td3]
1072    file copy td2 [file join td3 td4]
1073    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
1074    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
1075} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
1076test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup {
1077    cleanup
1078} -constraints {notRoot win 2000orNewer testchmod} -body {
1079    # On Windows with ACLs, copying a directory is defined like this
1080    file mkdir td1
1081    file mkdir td2
1082    file mkdir td3
1083    testchmod 555 td2
1084    file copy td1 [file join td3 td3]
1085    file copy td2 [file join td3 td4]
1086    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
1087    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
1088} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
1089test fCmd-10.9 {file copy: comprehensive: source and target incompatible} -setup {
1090    cleanup
1091} -constraints {notRoot} -returnCodes error -body {
1092    file mkdir td1
1093    createfile tf1
1094    file copy -force td1 tf1
1095} -result {can't overwrite file "tf1" with directory "td1"}
1096test fCmd-10.10 {file copy: comprehensive: source and target incompatible} -setup {
1097    cleanup
1098} -constraints {notRoot} -returnCodes error -body {
1099    file mkdir [file join td1 tf1]
1100    createfile tf1
1101    file copy -force tf1 td1
1102} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
1103test fCmd-10.11 {file copy: copy to empty file name} -setup {
1104    cleanup
1105} -returnCodes error -body {
1106    createfile tf1
1107    file copy tf1 ""
1108} -result {error copying "tf1" to "": no such file or directory}
1109test fCmd-10.12 {file rename: rename to empty file name} -setup {
1110    cleanup
1111} -returnCodes error -body {
1112    createfile tf1
1113    file rename tf1 ""
1114} -result {error renaming "tf1" to "": no such file or directory}
1115cleanup
1116
1117# old tests
1118
1119test fCmd-11.1 {TclFileRenameCmd: -- option } -constraints notRoot -setup {
1120    catch {file delete -force -- -tfa1}
1121} -body {
1122    set s [createfile -tfa1]
1123    file rename -- -tfa1 tfa2
1124    list [checkcontent tfa2 $s] [file exists -tfa1]
1125} -cleanup {
1126    file delete tfa2
1127} -result {1 0}
1128test fCmd-11.2 {TclFileRenameCmd: bad option } -constraints notRoot -setup {
1129    catch {file delete -force -- tfa1}
1130} -body {
1131    set s [createfile tfa1]
1132    list [catch {file rename -x tfa1 tfa2}] \
1133        [checkcontent tfa1 $s] [file exists tfa2]
1134} -cleanup {
1135    file delete tfa1
1136} -result {1 1 0}
1137test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
1138    catch {file rename -- }
1139} {1}
1140test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} -setup {
1141    set temp $::env(HOME)
1142} -constraints notRoot -body {
1143    global env
1144    unset env(HOME)
1145    catch { file rename tfa ~/foobar }
1146} -cleanup {
1147    set ::env(HOME) $temp
1148} -result 1
1149test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup {
1150    catch {file delete -force -- tfa1 tfa2 tfa3}
1151} -constraints {notRoot} -body {
1152    createfile tfa1
1153    createfile tfa2
1154    createfile tfa3
1155    catch {file rename tfa1 tfa2 tfa3}
1156} -cleanup {
1157    file delete tfa1 tfa2 tfa3
1158} -result {1}
1159test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup {
1160    catch {file delete -force -- tfa1 tfad}
1161} -constraints {notRoot} -body {
1162    set s [createfile tfa1]
1163    file mkdir tfad
1164    file rename tfa1 tfad
1165    list [checkcontent tfad/tfa1 $s] [file exists tfa1]
1166} -cleanup {
1167    file delete -force tfad
1168} -result {1 0}
1169test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} -setup {
1170    catch {file delete -force -- tfa1 tfa2 tfad}
1171} -constraints {notRoot} -body {
1172    set s1 [createfile tfa1]
1173    set s2 [createfile tfa2]
1174    file mkdir tfad
1175    file rename tfa1 tfa2 tfad
1176    list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
1177        [file exists tfa1] [file exists tfa2]
1178} -cleanup {
1179    file delete -force tfad
1180} -result {1 1 0 0}
1181test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} -setup {
1182    catch {file delete -force -- tfa tfad}
1183} -constraints {notRoot} -body {
1184    set s [createfile tfa]
1185    file mkdir tfad
1186    file mkdir tfad/tfa
1187    list [catch {file rename tfa tfad}] [checkcontent tfa $s] [file isdir tfad]
1188} -cleanup {
1189    file delete -force tfa tfad
1190} -result {1 1 1}
1191
1192#
1193# Coverage tests for renamefile() ;
1194#
1195test fCmd-12.1 {renamefile: source filename translation failing} -setup {
1196    set temp $::env(HOME)
1197} -constraints {notRoot} -body {
1198    global env
1199    unset env(HOME)
1200    catch {file rename ~/tfa1 tfa2}
1201} -cleanup {
1202    set ::env(HOME) $temp
1203} -result {1}
1204test fCmd-12.2 {renamefile: src filename translation failing} -setup {
1205    set temp $::env(HOME)
1206} -constraints {notRoot} -body {
1207    global env
1208    unset env(HOME)
1209    set s [createfile tfa1]
1210    file mkdir tfad
1211    catch {file rename tfa1 ~/tfa2 tfad}
1212} -cleanup {
1213    set ::env(HOME) $temp
1214    file delete -force tfad
1215} -result {1}
1216test fCmd-12.3 {renamefile: stat failing on source} -setup {
1217    catch {file delete -force -- tfa1 tfa2}
1218} -constraints {notRoot} -body {
1219    list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
1220} -result {1 0 0}
1221test fCmd-12.4 {renamefile: error renaming file to directory} -setup {
1222    catch {file delete -force -- tfa tfad}
1223} -constraints {notRoot} -body {
1224    set s1 [createfile tfa]
1225    file mkdir tfad
1226    file mkdir tfad/tfa
1227    list [catch {file rename tfa tfad}] [checkcontent tfa $s1] \
1228        [file isdir tfad/tfa]
1229} -cleanup {
1230    file delete -force tfa tfad
1231} -result {1 1 1}
1232test fCmd-12.5 {renamefile: error renaming directory to file} -setup {
1233    catch {file delete -force -- tfa tfad}
1234} -constraints {notRoot} -body {
1235    file mkdir tfa
1236    file mkdir tfad
1237    set s [createfile tfad/tfa]
1238    list [catch {file rename tfa tfad}] [checkcontent tfad/tfa $s] \
1239        [file isdir tfad] [file isdir tfa]
1240} -cleanup {
1241    file delete -force tfa tfad
1242} -result {1 1 1 1}
1243test fCmd-12.6 {renamefile: TclRenameFile succeeding} -setup {
1244    catch {file delete -force -- tfa1 tfa2}
1245} -constraints {notRoot} -body {
1246    set s [createfile tfa1]
1247    file rename tfa1 tfa2
1248    list [checkcontent tfa2 $s] [file exists tfa1]
1249} -cleanup {
1250    file delete tfa2
1251} -result {1 0}
1252test fCmd-12.7 {renamefile: renaming directory into offspring} -setup {
1253    catch {file delete -force -- tfad}
1254} -constraints {notRoot} -body {
1255    file mkdir tfad
1256    file mkdir tfad/dir
1257    catch {file rename tfad tfad/dir}
1258} -cleanup {
1259    file delete -force tfad
1260} -result {1}
1261test fCmd-12.8 {renamefile: generic error} -setup {
1262    catch {file delete -force -- tfa}
1263} -constraints {unix notRoot} -body {
1264    file mkdir tfa
1265    file mkdir tfa/dir
1266    file attributes tfa -permissions 0555
1267    catch {file rename tfa/dir tfa2}
1268} -cleanup {
1269    catch {file attributes tfa -permissions 0777}
1270    file delete -force tfa
1271} -result {1}
1272test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
1273    catch {file delete -force -- tfa /tmp/tfa}
1274} -constraints {unix notRoot} -body {
1275    set s [createfile tfa]
1276    file rename tfa /tmp
1277    list [checkcontent /tmp/tfa $s] [file exists tfa]
1278} -cleanup {
1279    file delete /tmp/tfa
1280} -result {1 0}
1281test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {
1282    catch {file delete -force -- tfad /tmp/tfad}
1283} -constraints {unix notRoot} -body {
1284    file mkdir tfad
1285    set s [createfile tfad/a]
1286    file rename tfad /tmp
1287    list [checkcontent /tmp/tfad/a $s] [file exists tfad]
1288} -cleanup {
1289    file delete -force /tmp/tfad
1290} -result {1 0}
1291
1292#
1293# Coverage tests for TclCopyFilesCmd()
1294#
1295test fCmd-13.1 {TclCopyFilesCmd: -force option} -constraints notRoot -setup {
1296    catch {file delete -force -- tfa1}
1297} -body {
1298    set s [createfile tfa1]
1299    file copy -force  tfa1 tfa2
1300    list [checkcontent tfa2 $s] [checkcontent tfa1 $s]
1301} -cleanup {
1302    file delete tfa1 tfa2
1303} -result {1 1}
1304test fCmd-13.2 {TclCopyFilesCmd: -- option} -constraints {notRoot} -setup {
1305    catch {file delete -force -- tfa1}
1306} -body {
1307    set s [createfile -tfa1]
1308    file copy --  -tfa1 tfa2
1309    list [checkcontent tfa2 $s] [checkcontent -tfa1 $s]
1310} -cleanup {
1311    file delete -- -tfa1 tfa2
1312} -result {1 1}
1313test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup {
1314    catch {file delete -force -- tfa1}
1315} -body {
1316    set s [createfile tfa1]
1317    list [catch {file copy -x tfa1 tfa2}] \
1318        [checkcontent tfa1 $s] [file exists tfa2]
1319} -cleanup {
1320    file delete tfa1
1321} -result {1 1 0}
1322test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
1323    catch {file copy -- }
1324} {1}
1325test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup {
1326    set temp $::env(HOME)
1327} -body {
1328    global env
1329    unset env(HOME)
1330    catch { file copy tfa ~/foobar }
1331} -cleanup {
1332    set ::env(HOME) $temp
1333} -result {1}
1334test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
1335    catch {file delete -force -- tfa1 tfa2 tfa3}
1336} -constraints {notRoot} -body {
1337    createfile tfa1
1338    createfile tfa2
1339    createfile tfa3
1340    catch {file copy tfa1 tfa2 tfa3}
1341} -cleanup {
1342    file delete tfa1 tfa2 tfa3
1343} -result {1}
1344test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
1345    catch {file delete -force -- tfa1 tfad}
1346} -constraints {notRoot} -body {
1347    set s [createfile tfa1]
1348    file mkdir tfad
1349    file copy tfa1 tfad
1350    list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]
1351} -cleanup {
1352    file delete -force tfad tfa1
1353} -result {1 1}
1354test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} -setup {
1355    catch {file delete -force -- tfa1 tfa2 tfad}
1356} -constraints {notRoot} -body {
1357    set s1 [createfile tfa1 ]
1358    set s2 [createfile tfa2 ]
1359    file mkdir tfad
1360    file copy tfa1 tfa2 tfad
1361    list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
1362        [checkcontent tfa1 $s1] [checkcontent tfa2 $s2]
1363} -cleanup {
1364    file delete -force tfad tfa1 tfa2
1365} -result {1 1 1 1}
1366test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} -setup {
1367    catch {file delete -force -- tfa tfad}
1368} -constraints {notRoot} -body {
1369    set s [createfile tfa]
1370    file mkdir tfad
1371    file mkdir tfad/tfa
1372    list [catch {file copy tfa tfad}] [checkcontent tfa $s] \
1373        [file isdir tfad/tfa] [file isdir tfad]
1374} -cleanup {
1375    file delete -force tfa tfad
1376} -result {1 1 1 1}
1377
1378#
1379# Coverage tests for copyfile()
1380#
1381test fCmd-14.1 {copyfile: source filename translation failing} -setup {
1382    set temp $::env(HOME)
1383} -constraints {notRoot} -body {
1384    global env
1385    unset env(HOME)
1386    catch {file copy ~/tfa1 tfa2}
1387} -cleanup {
1388    set ::env(HOME) $temp
1389} -result {1}
1390test fCmd-14.2 {copyfile: dst filename translation failing} -setup {
1391    set temp $::env(HOME)
1392} -constraints {notRoot} -body {
1393    global env
1394    unset env(HOME)
1395    set s [createfile tfa1]
1396    file mkdir tfad
1397    list [catch {file copy tfa1 ~/tfa2 tfad}] [checkcontent tfad/tfa1 $s]
1398} -cleanup {
1399    set ::env(HOME) $temp
1400    file delete -force tfa1 tfad
1401} -result {1 1}
1402test fCmd-14.3 {copyfile: stat failing on source} -setup {
1403    catch {file delete -force -- tfa1 tfa2}
1404} -constraints notRoot -body {
1405    list [catch {file copy tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
1406} -result {1 0 0}
1407test fCmd-14.4 {copyfile: error copying file to directory} -setup {
1408    catch {file delete -force -- tfa tfad}
1409} -constraints {notRoot} -body {
1410    set s1 [createfile tfa ]
1411    file mkdir tfad
1412    file mkdir tfad/tfa
1413    list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \
1414        [file isdir tfad] [file isdir tfad/tfa]
1415} -cleanup {
1416    file delete -force tfa tfad
1417} -result {1 1 1 1}
1418test fCmd-14.5 {copyfile: error copying directory to file} -setup {
1419    catch {file delete -force -- tfa tfad}
1420} -constraints {notRoot} -body {
1421    file mkdir tfa
1422    file mkdir tfad
1423    set s [createfile tfad/tfa]
1424    list [catch {file copy tfa tfad}] [checkcontent tfad/tfa $s] \
1425        [file isdir tfad] [file isdir tfa]
1426} -cleanup {
1427     file delete -force tfa tfad
1428} -result {1 1 1 1}
1429test fCmd-14.6 {copyfile: copy file succeeding} -constraints notRoot -setup {
1430    catch {file delete -force -- tfa tfa2}
1431} -body {
1432    set s [createfile tfa]
1433    file copy tfa tfa2
1434    list [checkcontent tfa $s] [checkcontent tfa2 $s]
1435} -cleanup {
1436    file delete tfa tfa2
1437} -result {1 1}
1438test fCmd-14.7 {copyfile: copy directory succeeding} -setup {
1439    catch {file delete -force -- tfa tfa2}
1440} -constraints {notRoot} -body {
1441    file mkdir tfa
1442    set s [createfile tfa/file]
1443    file copy tfa tfa2
1444    list [checkcontent tfa/file $s] [checkcontent tfa2/file $s]
1445} -cleanup {
1446    file delete -force tfa tfa2
1447} -result {1 1}
1448test fCmd-14.8 {copyfile: copy directory failing} -setup {
1449    catch {file delete -force -- tfa}
1450} -constraints {unix notRoot} -body {
1451    file mkdir tfa/dir/a/b/c
1452    file attributes tfa/dir -permissions 0000
1453    catch {file copy tfa tfa2}
1454} -cleanup {
1455    file attributes tfa/dir -permissions 0777
1456    file delete -force tfa tfa2
1457} -result {1}
1458
1459#
1460# Coverage tests for TclMkdirCmd()
1461#
1462test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
1463    set temp $::env(HOME)
1464} -constraints {notRoot} -body {
1465    global env
1466    unset env(HOME)
1467    catch {file mkdir ~/tfa}
1468} -cleanup {
1469    set ::env(HOME) $temp
1470} -result {1}
1471#
1472# Can Tcl_SplitPath return argc == 0? If so them we need a
1473# test for that code.
1474#
1475test fCmd-15.2 {TclMakeDirsCmd - one directory } -setup {
1476    catch {file delete -force -- tfa}
1477} -constraints {notRoot} -body {
1478    file mkdir tfa
1479    file isdirectory tfa
1480} -cleanup {
1481    file delete tfa
1482} -result {1}
1483test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup {
1484    catch {file delete -force -- tfa1 tfa2}
1485} -constraints {notRoot} -body {
1486    file mkdir tfa1 tfa2
1487    list [file isdirectory tfa1] [file isdirectory tfa2]
1488} -cleanup {
1489    file delete tfa1 tfa2
1490} -result {1 1}
1491test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
1492    catch {file delete -force -- tfa}
1493} -constraints {unix notRoot} -body {
1494    file mkdir tfa
1495    createfile tfa/file
1496    file attributes tfa -permissions 0000
1497    catch {file mkdir tfa/file}
1498} -cleanup {
1499    file attributes tfa -permissions 0777
1500    file delete -force tfa
1501} -result {1}
1502test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
1503    catch {file delete -force -- tfa}
1504} -constraints {notRoot} -body {
1505    file mkdir tfa/a/b/c
1506    file isdir tfa/a/b/c
1507} -cleanup {
1508    file delete -force tfa
1509} -result {1}
1510test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup {
1511    catch {file delete -force -- tfa}
1512} -constraints {notRoot} -body {
1513    set s [createfile tfa]
1514    list [catch {file mkdir tfa}] [file isdir tfa] [file exists tfa] \
1515        [checkcontent tfa $s]
1516} -cleanup {
1517    file delete tfa
1518} -result {1 0 1 1}
1519test fCmd-15.7 {TclMakeDirsCmd - making several directories} -setup {
1520    catch {file delete -force -- tfa1 tfa2}
1521} -constraints {notRoot} -body {
1522    file mkdir tfa1 tfa2/a/b/c
1523    list [file isdir tfa1] [file isdir tfa2/a/b/c]
1524} -cleanup {
1525    file delete -force tfa1 tfa2
1526} -result {1 1}
1527test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body {
1528    file mkdir tfa
1529    file mkdir tfa
1530    file isdir tfa
1531} -constraints {notRoot} -cleanup {
1532    file delete tfa
1533} -result {1}
1534
1535# Coverage tests for TclDeleteFilesCommand()
1536test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup {
1537    catch {file delete -force -- tfa}
1538} -body {
1539    createfile tfa
1540    file delete -- tfa
1541    file exists tfa
1542} -result 0
1543test fCmd-16.2 {test the -force and -- arguments} -constraints notRoot -setup {
1544    catch {file delete -force -- tfa}
1545} -body {
1546    createfile tfa
1547    file delete -force -- tfa
1548    file exists tfa
1549} -result 0
1550test fCmd-16.3 {test bad option} -constraints {notRoot} -setup {
1551    catch {file delete -force -- tfa}
1552} -body {
1553    createfile tfa
1554    catch {file delete -dog tfa}
1555} -cleanup {
1556    file delete tfa
1557} -result {1}
1558test fCmd-16.4 {test not enough args} -constraints {notRoot} -body {
1559    file delete
1560} -returnCodes error -match glob -result "wrong \# args: should be *"
1561test fCmd-16.5 {test not enough args with options} -constraints {notRoot} -body {
1562    file delete --
1563} -returnCodes error -match glob -result "wrong \# args: should be *"
1564test fCmd-16.6 {delete: source filename translation failing} -setup {
1565    set temp $::env(HOME)
1566} -constraints {notRoot} -body {
1567    global env
1568    unset env(HOME)
1569    catch {file delete ~/tfa}
1570} -cleanup {
1571    set ::env(HOME) $temp
1572} -result {1}
1573test fCmd-16.7 {remove a non-empty directory without -force} -setup {
1574    catch {file delete -force -- tfa}
1575} -constraints {notRoot} -body {
1576    file mkdir tfa
1577    createfile tfa/a
1578    catch {file delete tfa}
1579} -cleanup {
1580    file delete -force tfa
1581} -result {1}
1582test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
1583    catch {file delete -force -- tfa}
1584} -body {
1585    file mkdir tfa
1586    createfile tfa/a
1587    catch {file delete tfa}
1588} -cleanup {
1589    file delete -force tfa
1590} -result {1}
1591test fCmd-16.9 {error while deleting file} -setup {
1592    catch {file delete -force -- tfa}
1593} -constraints {unix notRoot} -body {
1594    file mkdir tfa
1595    createfile tfa/a
1596    file attributes tfa -permissions 0555
1597    catch {file delete tfa/a}
1598    #######
1599    #######  If any directory in a tree that is being removed does not have
1600    #######  write permission, the process will fail! This is also the case
1601    #######  with "rm -rf"
1602    #######
1603} -cleanup {
1604    file attributes tfa -permissions 0777
1605    file delete -force tfa
1606} -result {1}
1607test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
1608    catch {file delete -force -- tfa1 tfa2}
1609} -body {
1610    createfile tfa1
1611    createfile tfa2
1612    file delete tfa1 tfa2
1613    list [file exists tfa1] [file exists tfa2]
1614} -result {0 0}
1615test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup {
1616    catch {file delete -force -- tfa}
1617} -constraints {notRoot} -body {
1618    file delete tfa
1619} -result {}
1620
1621# More coverage tests for mkpath()
1622test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup {
1623     catch {file delete -force -- tfa1}
1624} -constraints {unix notRoot} -body {
1625     file mkdir tfa1
1626     file attributes tfa1 -permissions 0555
1627     catch {file mkdir tfa1/tfa2}
1628} -cleanup {
1629     file attributes tfa1 -permissions 0777
1630     file delete -force tfa1
1631} -result {1}
1632test fCmd-17.2 {mkdir several levels deep - relative} -setup {
1633    catch {file delete -force -- tfa}
1634} -constraints {notRoot} -body {
1635    file mkdir tfa/a/b
1636    file isdir tfa/a/b
1637} -cleanup {
1638    file delete tfa/a/b tfa/a tfa
1639} -result 1
1640test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
1641    catch {file delete -force -- tfa}
1642} -constraints {notRoot} -body {
1643    set f [file join [pwd] tfa a]
1644    file mkdir $f
1645    file isdir $f
1646} -cleanup {
1647    file delete $f [file join [pwd] tfa]
1648} -result {1}
1649
1650#
1651# Functionality tests for TclFileRenameCmd()
1652#
1653
1654test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
1655        -setup {
1656    catch {file delete -force -- tfad}
1657    set savedDir [pwd]
1658} -constraints {notRoot} -body {
1659    file mkdir tfad/dir
1660    cd tfad/dir
1661    set s [createfile foo ]
1662    file rename  foo bar
1663    file rename bar ./foo
1664    file rename ./foo bar
1665    file rename ./bar ./foo
1666    file rename foo ../dir/bar
1667    file rename ../dir/bar ./foo
1668    file rename ../../tfad/dir/foo ../../tfad/dir/bar
1669    file rename [file join [pwd] bar] foo
1670    file rename foo [file join [pwd] bar]
1671    list [checkcontent bar $s] [file exists foo]
1672} -cleanup {
1673    cd $savedDir
1674    file delete -force tfad
1675} -result {1 0}
1676test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} -setup {
1677    catch {file delete -force -- tfa1 tfa2}
1678} -constraints {notRoot} -body {
1679    file mkdir tfa1
1680    file rename tfa1 tfa2
1681    list [file exists tfa2] [file exists tfa1]
1682} -cleanup {
1683    file delete tfa2
1684} -result {1 0}
1685test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} -setup {
1686    catch {file delete -force -- tfa1 tfad1 tfad2}
1687} -constraints {notRoot} -body {
1688    set s [createfile tfa1]
1689    file mkdir tfad1 tfad2
1690    file rename tfa1 tfad1 tfad2
1691    list [checkcontent tfad2/tfa1 $s] [file isdir tfad2/tfad1] \
1692        [file exists tfa1] [file exists tfad1]
1693} -cleanup {
1694    file delete tfad2/tfa1
1695    file delete -force tfad2
1696} -result {1 1 0 0}
1697test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} -setup {
1698    catch {file delete -force -- tfa tfad}
1699} -constraints {notRoot} -body {
1700    set s [createfile tfa]
1701    file mkdir tfad
1702    list [catch {file rename tfad tfa}] [checkcontent tfa $s] [file isdir tfad]
1703} -cleanup {
1704    file delete tfa tfad
1705} -result {1 1 1}
1706test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} -setup {
1707    catch {file delete -force -- tfa tfad}
1708} -constraints {notRoot} -body {
1709    set s [createfile tfa]
1710    file mkdir tfad/tfa
1711    list [catch {file rename tfa tfad}] [checkcontent tfa $s] \
1712        [file isdir tfad/tfa]
1713} -cleanup {
1714    file delete -force tfa tfad
1715} -result {1 1 1}
1716#
1717# On Windows there is no easy way to determine if two files are the same
1718#
1719test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} -setup {
1720    catch {file delete -force -- tfa}
1721} -constraints {unix notRoot} -body {
1722    set s [createfile tfa]
1723    list [catch {file rename tfa tfa}] [checkcontent tfa $s]
1724} -cleanup {
1725    file delete tfa
1726} -result {1 1}
1727test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} -setup {
1728    catch {file delete -force -- tfa tfad}
1729} -constraints {notRoot} -body {
1730    file mkdir tfa tfad/tfa
1731    list [catch {file rename tfa tfad}] [file isdir tfa]
1732} -cleanup {
1733    file delete -force tfa tfad
1734} -result {1 1}
1735test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} -setup {
1736    catch {file delete -force -- tfa tfad}
1737} -constraints {notRoot notNetworkFilesystem} -body {
1738    file mkdir tfa tfad/tfa
1739    file rename -force tfa tfad
1740    file isdir tfa
1741} -cleanup {
1742    file delete -force tfad
1743} -result 0
1744test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} -setup {
1745    catch {file delete -force -- tfa tfad}
1746} -constraints {notRoot} -body {
1747    file mkdir tfa tfad/tfa/file
1748    list [catch {file rename tfa tfad}] [file isdir tfa] \
1749        [file isdir tfad/tfa/file]
1750} -cleanup {
1751    file delete -force tfa tfad
1752} -result {1 1 1}
1753test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} -setup {
1754    catch {file delete -force -- tfa tfad}
1755} -constraints {notRoot notNetworkFilesystem} -body {
1756    file mkdir tfa tfad/tfa/file
1757    list [catch {file rename -force tfa tfad}] [file isdir tfa] \
1758        [file isdir tfad/tfa/file]
1759} -cleanup {
1760    file delete -force tfa tfad
1761} -result {1 1 1}
1762test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} -setup {
1763    catch {file delete -force -- tfa1}
1764} -constraints {notRoot} -body {
1765    list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
1766} -result {1 0 0}
1767test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} -setup {
1768    catch {file delete -force -- tfa1 tfa2 tfa3}
1769} -constraints {unix notRoot} -body {
1770    set s [createfile tfa1]
1771    file link -symbolic tfa2 tfa1
1772    file rename tfa2 tfa3
1773    file type tfa3
1774} -cleanup {
1775    file delete tfa1 tfa3
1776} -result link
1777test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} -setup {
1778    catch {file delete -force -- tfa1 tfa2 tfa3}
1779} -constraints {unix notRoot} -body {
1780    file mkdir tfa1
1781    file link -symbolic tfa2 tfa1
1782    file rename tfa2 tfa3
1783    file type tfa3
1784} -cleanup {
1785    file delete tfa1 tfa3
1786} -result link
1787test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} -setup {
1788    catch {file delete -force -- tfa1 tfa2 tfa3}
1789} -constraints {unix notRoot} -body {
1790    file mkdir tfa1/a/b/c/d
1791    file mkdir tfa2
1792    set f [file join [pwd] tfa1/a/b]
1793    set f2 [file join [pwd] {tfa2/b alias}]
1794    file link -symbolic $f2 $f
1795    file rename {tfa2/b alias/c} tfa3
1796    list [file isdir tfa3] [file exists tfa1/a/b/c]
1797} -cleanup {
1798    file delete -force tfa1 tfa2 tfa3
1799} -result {1 0}
1800test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup {
1801    catch {file delete -force -- tfa1 tfa2 tfalink}
1802} -constraints {unix notRoot} -body {
1803    file mkdir tfa1
1804    set s [createfile tfa2]
1805    file link -symbolic tfalink tfa1
1806
1807    file rename tfa2 tfalink
1808    checkcontent tfa1/tfa2 $s
1809} -cleanup {
1810    file delete -force tfa1 tfalink
1811} -result {1}
1812test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup {
1813    catch {file delete -force -- tfa1 tfalink}
1814} -constraints {unix notRoot} -body {
1815    file mkdir tfa1
1816    file link -symbolic tfalink tfa1
1817    file delete tfa1
1818    file rename tfalink tfa2
1819    file type tfa2
1820} -cleanup {
1821    file delete tfa2
1822} -result link
1823
1824#
1825# Coverage tests for TclUnixRmdir
1826#
1827test fCmd-19.1 {remove empty directory} -constraints {notRoot} -setup {
1828    catch {file delete -force -- tfa}
1829} -body {
1830    file mkdir tfa
1831    file delete tfa
1832    file exists tfa
1833} -result {0}
1834test fCmd-19.2 {rmdir error besides EEXIST} -setup {
1835    catch {file delete -force -- tfa}
1836} -constraints {unix notRoot} -body {
1837    file mkdir tfa
1838    file mkdir tfa/a
1839    file attributes tfa -permissions 0555
1840    catch {file delete tfa/a}
1841} -cleanup {
1842    file attributes tfa -permissions 0777
1843    file delete -force tfa
1844} -result {1}
1845test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
1846    catch {file delete -force -- tfa}
1847} -body {
1848    file mkdir tfa
1849    file mkdir tfa/a
1850    file delete -force tfa
1851    file exists tfa
1852} -result {0}
1853
1854#
1855# TclUnixDeleteFile and TraversalDelete are covered by tests from the
1856# TclDeleteFilesCmd suite
1857#
1858#
1859
1860#
1861# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
1862#
1863
1864test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } -setup {
1865    catch {file delete -force -- tfa}
1866} -constraints {unix notRoot} -body {
1867    file mkdir tfa
1868    file mkdir tfa/a
1869    file attributes tfa/a -permissions 0000
1870    catch {file delete -force tfa}
1871} -cleanup {
1872    file attributes tfa/a -permissions 0777
1873    file delete -force tfa
1874} -result {1}
1875test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
1876    catch {file delete -force -- tfa}
1877} -constraints {unix notRoot} -body {
1878    file mkdir tfa
1879    for {set i 1} {$i <= 300} {incr i} {
1880        createfile tfa/testfile_$i
1881    }
1882    file delete -force tfa
1883} -cleanup {
1884    while {[catch {file delete -force tfa}]} {}
1885} -result {}
1886
1887#
1888# Feature testing for TclCopyFilesCmd
1889#
1890test fCmd-21.1 {copy : single file to nonexistant} -setup {
1891    catch {file delete -force -- tfa1 tfa2}
1892} -constraints {notRoot} -body {
1893    set s [createfile tfa1]
1894    file copy tfa1 tfa2
1895    list [checkcontent tfa2 $s] [checkcontent tfa1 $s]
1896} -cleanup {
1897    file delete tfa1 tfa2
1898} -result {1 1}
1899test fCmd-21.2 {copy : single dir to nonexistant} -setup {
1900    catch {file delete -force -- tfa1 tfa2}
1901} -constraints {notRoot} -body {
1902    file mkdir tfa1
1903    file copy tfa1 tfa2
1904    list [file isdir tfa2] [file isdir tfa1]
1905} -cleanup {
1906    file delete tfa1 tfa2
1907} -result {1 1}
1908test fCmd-21.3 {copy : single file into directory} -setup {
1909    catch {file delete -force -- tfa1 tfad}
1910} -constraints {notRoot} -body {
1911    set s [createfile tfa1]
1912    file mkdir tfad
1913    file copy tfa1 tfad
1914    list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]
1915} -cleanup {
1916    file delete -force tfa1 tfad
1917} -result {1 1}
1918test fCmd-21.4 {copy : more than one source and target is not a directory} -setup {
1919    catch {file delete -force -- tfa1 tfa2 tfa3}
1920} -constraints {notRoot} -body {
1921    createfile tfa1
1922    createfile tfa2
1923    createfile tfa3
1924    catch {file copy tfa1 tfa2 tfa3}
1925} -cleanup {
1926    file delete tfa1 tfa2 tfa3
1927} -result {1}
1928test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup {
1929    catch {file delete -force -- tfa1 tfa2 tfad}
1930} -body {
1931    set s1 [createfile tfa1]
1932    set s2 [createfile tfa2]
1933    file mkdir tfad
1934    file copy tfa1 tfa2 tfad
1935    list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
1936        [checkcontent tfa1 $s1] [checkcontent tfa2 $s2]
1937} -cleanup {
1938    file delete -force tfa1 tfa2 tfad
1939} -result {1 1 1 1}
1940test fCmd-21.6 {copy: mixed dirs and files into directory} -setup {
1941    catch {file delete -force -- tfa1 tfad1 tfad2}
1942} -constraints {notRoot notFileSharing} -body {
1943    set s [createfile tfa1]
1944    file mkdir tfad1 tfad2
1945    file copy tfa1 tfad1 tfad2
1946    list [checkcontent [file join tfad2 tfa1] $s] \
1947        [file isdir [file join tfad2 tfad1]] \
1948        [checkcontent tfa1 $s] [file isdir tfad1]
1949} -cleanup {
1950    file delete -force tfa1 tfad1 tfad2
1951} -result {1 1 1 1}
1952test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} -setup {
1953    catch {file delete -force tfad1 tfalink tfalink2}
1954} -constraints {unix notRoot dontCopyLinks} -body {
1955    file mkdir tfad1
1956    file link -symbolic tfalink tfad1
1957    file delete tfad1
1958    file copy tfalink tfalink2
1959} -returnCodes error -cleanup {
1960    file delete -force tfalink tfalink2
1961} -result {error copying "tfalink": the target of this link doesn't exist}
1962test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} -setup {
1963    catch {file delete -force tfad1 tfalink tfalink2}
1964} -constraints {unix notRoot} -body {
1965    file mkdir tfad1
1966    file link -symbolic tfalink tfad1
1967    file delete tfad1
1968    file copy tfalink tfalink2
1969    file type tfalink2
1970} -cleanup {
1971    file delete tfalink tfalink2
1972} -result link
1973test fCmd-21.8.1 {TclCopyFilesCmd: copy a link} -setup {
1974    catch {file delete -force tfad1 tfalink tfalink2}
1975} -constraints {unix notRoot dontCopyLinks} -body {
1976    file mkdir tfad1
1977    file link -symbolic tfalink tfad1
1978    file copy tfalink tfalink2
1979    list [file type tfalink] [file type tfalink2] [file isdir tfad1]
1980} -cleanup {
1981    file delete -force tfad1 tfalink tfalink2
1982} -result {link directory 1}
1983test fCmd-21.8.2 {TclCopyFilesCmd: copy a link} -setup {
1984    catch {file delete -force tfad1 tfalink tfalink2}
1985} -constraints {unix notRoot} -body {
1986    file mkdir tfad1
1987    file link -symbolic tfalink tfad1
1988    file copy tfalink tfalink2
1989    list [file type tfalink] [file type tfalink2] [file isdir tfad1]
1990} -cleanup {
1991    file delete -force tfad1 tfalink tfalink2
1992} -result {link link 1}
1993test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} -setup {
1994    catch {file delete -force tfad1 tfad2}
1995} -constraints {unix notRoot} -body {
1996    file mkdir tfad1
1997    file link -symbolic tfad1/tfalink "[pwd]/tfad1"
1998    file copy tfad1 tfad2
1999    file type tfad2/tfalink
2000} -cleanup {
2001    file delete -force tfad1 tfad2
2002} -result link
2003test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} -setup {
2004    catch {file delete -force -- tfa tfad}
2005} -constraints {notRoot} -body {
2006    file mkdir tfa [file join tfad tfa]
2007    list [catch {file copy tfa tfad}] [file isdir tfa]
2008} -cleanup {
2009    file delete -force tfa tfad
2010} -result {1 1}
2011test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} -setup {
2012    catch {file delete -force -- tfa tfad}
2013} -constraints {notRoot} -body {
2014    file mkdir tfa [file join tfad tfa file]
2015    list [catch {file copy tfa tfad}] [file isdir tfa] \
2016        [file isdir [file join tfad tfa file]]
2017} -cleanup {
2018    file delete -force tfa tfad
2019} -result {1 1 1}
2020test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} -setup {
2021    catch {file delete -force -- tfa tfad}
2022} -constraints {notRoot} -body {
2023    file mkdir tfa [file join tfad tfa file]
2024    list [catch {file copy -force tfa tfad}] [file isdir tfa] \
2025        [file isdir [file join tfad tfa file]]
2026} -cleanup {
2027    file delete -force tfa tfad
2028} -result {1 1 1}
2029
2030#
2031# Coverage testing for TclpRenameFile
2032#
2033test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} -setup {
2034    catch {file delete -force -- tfa1 tfa2}
2035} -constraints {notRoot} -body {
2036    set s [createfile tfa1]
2037    set s2 [createfile tfa2 q]
2038
2039    set result [catch {file rename tfa1 tfa2}]
2040    file rename -force tfa1 tfa2
2041    lappend result [checkcontent tfa2 $s]
2042} -cleanup {
2043    file delete [glob tfa1 tfa2]
2044} -result {1 1}
2045test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup {
2046    catch {file delete -force -- tfa1}
2047} -constraints {unix notRoot} -body {
2048    set s [createfile tfa1]
2049    file rename -force tfa1 tfa1
2050    checkcontent tfa1 $s
2051} -cleanup {
2052    file delete tfa1
2053} -result {1}
2054test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup {
2055    catch {file delete -force -- d1 tfad}
2056} -constraints {notRoot} -body {
2057    file mkdir d1 [file join tfad d1]
2058    list [catch {file rename d1 tfad}] [file isdir d1] \
2059        [file isdir [file join tfad d1]]
2060} -cleanup {
2061    file delete -force d1 tfad
2062} -result {1 1 1}
2063test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} -setup {
2064    catch {file delete -force -- d1 tfad}
2065} -constraints {notRoot} -body {
2066    file mkdir d1 [file join tfad a b c]
2067    file rename d1 [file join tfad a b c d1]
2068    list [file isdir d1] [file isdir [file join tfad a b c d1]]
2069} -cleanup {
2070    file delete -force [glob d1 tfad]
2071} -result {0 1}
2072#
2073# TclMacCopyFile needs to be redone.
2074#
2075test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup {
2076    catch {file delete -force -- tfa1 tfa2}
2077} -constraints {notRoot} -body {
2078    set s [createfile tfa1]
2079    set s2 [createfile tfa2 q]
2080
2081    set result [catch {file copy tfa1 tfa2}]
2082    file copy -force tfa1 tfa2
2083    lappend result [checkcontent tfa2 $s] [checkcontent tfa1 $s]
2084} -cleanup {
2085    file delete tfa1 tfa2
2086} -result {1 1 1}
2087
2088#
2089# TclMacMkdir - basic cases are covered elsewhere.
2090# Error cases are not covered.
2091#
2092
2093#
2094# TclMacRmdir
2095# Error cases are not covered.
2096#
2097
2098test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup {
2099    catch {file delete -force -- tfad}
2100} -constraints {notRoot} -body {
2101    file mkdir [file join tfad dir]
2102
2103    list [catch {file delete tfad}] [file delete -force tfad]
2104} -cleanup {
2105    catch {file delete -force tfad}
2106} -result {1 {}}
2107
2108#
2109# TclMacDeleteFile
2110# Error cases are not covered.
2111#
2112test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} -setup {
2113    catch {file delete -force -- tfa1}
2114} -constraints {notRoot} -body {
2115    createfile tfa1
2116    file delete tfa1
2117    file exists tfa1
2118} -cleanup {
2119    catch {file delete -force tfa1}
2120} -result {0}
2121
2122#
2123# TclMacCopyDirectory
2124# Error cases are not covered.
2125#
2126test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} -setup {
2127    catch {file delete -force -- tfad1 tfad2}
2128} -constraints {notRoot notFileSharing} -body {
2129    file mkdir [file join tfad1 a b c]
2130    file copy tfad1 tfad2
2131    list [file isdir [file join tfad1 a b c]] \
2132        [file isdir [file join tfad2 a b c]]
2133} -cleanup {
2134    file delete -force tfad1 tfad2
2135} -result {1 1}
2136test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} -setup {
2137    catch {file delete -force -- tfad1 tfad2}
2138} -constraints {notRoot notFileSharing} -body {
2139    file mkdir tfad1
2140    file copy tfad1 tfad2
2141    list [file isdir tfad1] [file isdir tfad2]
2142} -cleanup {
2143    file delete tfad1 tfad2
2144} -result {1 1}
2145test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup {
2146    catch {file delete -force -- tfad1 tfad2}
2147} -constraints {notRoot notFileSharing} -body {
2148    file mkdir [file join tfad1 x y z]
2149    file mkdir [file join tfad2 dir]
2150    file copy tfad1 [file join tfad2 dir]
2151    list [file isdir [file join tfad1 x y z]] \
2152        [file isdir [file join tfad2 dir tfad1 x y z]]
2153} -cleanup {
2154    file delete -force tfad1 tfad2
2155} -result {1 1}
2156
2157#
2158# Functionality tests for TclDeleteFilesCmd
2159#
2160
2161test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup {
2162    catch {file delete -force -- tfad1 tfad2}
2163} -constraints {unix notRoot} -body {
2164    file mkdir tfad1
2165    file link -symbolic tfalink tfad1
2166    file delete tfalink
2167
2168    list [file isdir tfad1] [file exists tfalink]
2169} -cleanup {
2170    file delete tfad1
2171    catch {file delete tfalink}
2172} -result {1 0}
2173test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} -setup {
2174    catch {file delete -force -- tfad1 tfad2}
2175} -constraints {unix notRoot} -body {
2176    file mkdir tfad1
2177    file mkdir tfad2
2178    file link -symbolic [file join tfad2 link] [file join .. tfad1]
2179    file delete -force tfad2
2180
2181    list [file isdir tfad1] [file exists tfad2]
2182} -cleanup {
2183    file delete tfad1
2184} -result {1 0}
2185test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} -setup {
2186    catch {file delete -force -- tfad1 tfad2}
2187} -constraints {unix notRoot} -body {
2188    file mkdir tfad1
2189    file link -symbolic tfad2 tfad1
2190    file delete tfad1
2191    file delete tfad2
2192
2193    list [file exists tfad1] [file exists tfad2]
2194} -result {0 0}
2195
2196test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup {
2197    set platform [testgetplatform]
2198} -constraints {testsetplatform} -body {
2199    testsetplatform unix
2200    file attributes ~_totally_bogus_user
2201} -returnCodes error -cleanup {
2202    testsetplatform $platform
2203} -result {user "_totally_bogus_user" doesn't exist}
2204test fCmd-27.3 {TclFileAttrsCmd - all attributes} -setup {
2205    catch {file delete -force -- foo.tmp}
2206} -body {
2207    createfile foo.tmp
2208    file attributes foo.tmp
2209    # Must be non-empty result
2210} -cleanup {
2211    file delete -force -- foo.tmp
2212} -match glob -result {?*}
2213test fCmd-27.4 {TclFileAttrsCmd - getting one option} -setup {
2214    catch {file delete -force -- foo.tmp}
2215} -body {
2216    createfile foo.tmp
2217    set attrs [file attributes foo.tmp]
2218    file attributes foo.tmp {*}[lindex $attrs 0]
2219    # Any successful result will do
2220} -cleanup {
2221    file delete -force -- foo.tmp
2222} -match glob -result *
2223test fCmd-27.5 {TclFileAttrsCmd - setting one option} -setup {
2224    catch {file delete -force -- foo.tmp}
2225} -constraints {foundGroup} -body {
2226    createfile foo.tmp
2227    set attrs [file attributes foo.tmp]
2228    file attributes foo.tmp {*}[lrange $attrs 0 1]
2229} -cleanup {
2230    file delete -force -- foo.tmp
2231} -result {}
2232test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup {
2233    catch {file delete -force -- foo.tmp}
2234} -constraints {foundGroup} -body {
2235    createfile foo.tmp
2236    set attrs [file attributes foo.tmp]
2237    file attributes foo.tmp {*}[lrange $attrs 0 3]
2238} -cleanup {
2239    file delete -force -- foo.tmp
2240} -result {}
2241
2242if {
2243    [testConstraint win] &&
2244    ([string index $tcl_platform(osVersion) 0] < 5
2245     || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
2246} then {
2247    testConstraint linkDirectory 0
2248    testConstraint linkFile 0
2249}
2250
2251test fCmd-28.1 {file link} -returnCodes error -body {
2252    file link
2253} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
2254test fCmd-28.2 {file link} -returnCodes error -body {
2255    file link a b c d
2256} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
2257test fCmd-28.3 {file link} -returnCodes error -body {
2258    file link abc b c
2259} -result {bad switch "abc": must be -symbolic or -hard}
2260test fCmd-28.4 {file link} -returnCodes error -body {
2261    file link -abc b c
2262} -result {bad switch "-abc": must be -symbolic or -hard}
2263cd [workingDirectory]
2264makeDirectory abc.dir
2265makeDirectory abc2.dir
2266makeFile contents abc.file
2267makeFile contents abc2.file
2268cd [temporaryDirectory]
2269test fCmd-28.5 {file link: source already exists} -setup {
2270    cd [temporaryDirectory]
2271} -constraints {linkDirectory} -body {
2272    file link abc.dir abc2.dir
2273} -returnCodes error -cleanup {
2274    cd [workingDirectory]
2275} -result {could not create new link "abc.dir": that path already exists}
2276test fCmd-28.6 {file link: unsupported operation} -setup {
2277    cd [temporaryDirectory]
2278} -constraints {linkDirectory win} -body {
2279    file link -hard abc.link abc.dir
2280} -returnCodes error -cleanup {
2281    cd [workingDirectory]
2282} -result {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}
2283test fCmd-28.7 {file link: source already exists} -setup {
2284    cd [temporaryDirectory]
2285} -constraints {linkFile} -body {
2286    file link abc.file abc2.file
2287} -returnCodes error -cleanup {
2288    cd [workingDirectory]
2289} -result {could not create new link "abc.file": that path already exists}
2290test fCmd-28.8 {file link} -constraints {linkFile win} -setup {
2291    cd [temporaryDirectory]
2292} -body {
2293    file link -symbolic abc.link abc.file
2294} -returnCodes error -cleanup {
2295    cd [workingDirectory]
2296} -result {could not create new link "abc.link" pointing to "abc.file": not a directory}
2297test fCmd-28.9 {file link: success with file} -constraints {linkFile} -setup {
2298    cd [temporaryDirectory]
2299    file delete -force abc.link
2300} -body {
2301    file link abc.link abc.file
2302} -cleanup {
2303    cd [workingDirectory]
2304} -result abc.file
2305test fCmd-28.9.1 {file link: success with file} -setup {
2306    cd [temporaryDirectory]
2307    file delete -force abc.link
2308} -constraints {linkFile win} -body {
2309    file stat abc.file arr
2310    set res $arr(nlink)
2311    lappend res [catch {file link abc.link abc.file} msg] $msg
2312    file stat abc.file arr
2313    lappend res $arr(nlink)
2314} -cleanup {
2315    cd [workingDirectory]
2316} -result {1 0 abc.file 2}
2317cd [temporaryDirectory]
2318catch {file delete -force abc.link}
2319cd [workingDirectory]
2320test fCmd-28.10 {file link: linking to nonexistent path} -setup {
2321    cd [temporaryDirectory]
2322    file delete -force abc.link
2323} -constraints {linkDirectory} -body {
2324    file link abc.link abc2.doesnt
2325} -returnCodes error -cleanup {
2326    cd [workingDirectory]
2327} -result {could not create new link "abc.link": target "abc2.doesnt" doesn't exist}
2328test fCmd-28.10.1 {file link: linking to nonexistent path} -setup {
2329    cd [temporaryDirectory]
2330    file delete -force abc.link
2331} -constraints {linkDirectory} -body {
2332    file link doesnt/abc.link abc.dir
2333} -returnCodes error -cleanup {
2334    cd [workingDirectory]
2335} -result {could not create new link "doesnt/abc.link": no such file or directory}
2336test fCmd-28.11 {file link: success with directory} -setup {
2337    cd [temporaryDirectory]
2338    file delete -force abc.link
2339} -constraints {linkDirectory} -body {
2340    file link abc.link abc.dir
2341} -cleanup {
2342    cd [workingDirectory]
2343} -result abc.dir
2344test fCmd-28.12 {file link: cd into a link} -setup {
2345    cd [temporaryDirectory]
2346    file delete -force abc.link
2347} -constraints {linkDirectory} -body {
2348    file link abc.link abc.dir
2349    set orig [pwd]
2350    cd abc.link
2351    set dir [pwd]
2352    cd ..
2353    set up [pwd]
2354    cd $orig
2355    # now '$up' should be either $orig or [file dirname abc.dir], depending on
2356    # whether 'cd' actually moves to the destination of a link, or simply
2357    # treats the link as a directory. (On windows the former, on unix the
2358    # latter, I believe)
2359    if {
2360        ([file normalize $up] ne [file normalize $orig]) &&
2361        ([file normalize $up] ne [file normalize [file dirname abc.dir]])
2362    } then {
2363        return "wrong directory with 'cd abc.link ; cd ..': \
2364                \"[file normalize $up]\" should be \"[file normalize $orig]\"\
2365                or \"[file normalize [file dirname abc.dir]]\""
2366    } else {
2367        return "ok"
2368    }
2369} -cleanup {
2370    cd [workingDirectory]
2371} -result ok
2372test fCmd-28.13 {file link} -constraints {linkDirectory} -setup {
2373    cd [temporaryDirectory]
2374} -body {
2375    # duplicate link throws error
2376    file link abc.link abc.dir
2377} -returnCodes error -cleanup {
2378    cd [workingDirectory]
2379} -result {could not create new link "abc.link": that path already exists}
2380test fCmd-28.14 {file link: deletes link not dir} -setup {
2381    cd [temporaryDirectory]
2382} -constraints {linkDirectory} -body {
2383    file delete -force abc.link
2384    list [file exists abc.link] [file exists abc.dir]
2385} -cleanup {
2386    cd [workingDirectory]
2387} -result {0 1}
2388test fCmd-28.15.1 {file link: copies link not dir} -setup {
2389    cd [temporaryDirectory]
2390    file delete -force abc.link
2391} -constraints {linkDirectory dontCopyLinks} -body {
2392    file link abc.link abc.dir
2393    file copy abc.link abc2.link
2394    # abc2.linkdir was a copy of a link to a dir, so it should end up as a
2395    # directory, not a link (links trace to endpoint).
2396    list [file type abc2.link] [file tail [file link abc.link]]
2397} -cleanup {
2398    cd [workingDirectory]
2399} -result {directory abc.dir}
2400test fCmd-28.15.2 {file link: copies link not dir} -setup {
2401    cd [temporaryDirectory]
2402    file delete -force abc.link
2403} -constraints {linkDirectory} -body {
2404    file link abc.link abc.dir
2405    file copy abc.link abc2.link
2406    list [file type abc2.link] [file tail [file link abc2.link]]
2407} -cleanup {
2408    cd [workingDirectory]
2409} -result {link abc.dir}
2410cd [temporaryDirectory]
2411file delete -force abc.link
2412file delete -force abc2.link
2413cd abc.dir
2414file delete -force abc.file
2415file delete -force abc2.file
2416cd ..
2417file copy abc.file abc.dir
2418file copy abc2.file abc.dir
2419cd [workingDirectory]
2420test fCmd-28.16 {file link: glob inside link} -setup {
2421    cd [temporaryDirectory]
2422    file delete -force abc.link
2423} -constraints {linkDirectory} -body {
2424    file link abc.link abc.dir
2425    lsort [glob -dir abc.link -tails *]
2426} -cleanup {
2427    cd [workingDirectory]
2428} -result {abc.file abc2.file}
2429test fCmd-28.17 {file link: glob -type l} -setup {
2430    cd [temporaryDirectory]
2431} -constraints {linkDirectory} -body {
2432    glob -dir [pwd] -type l -tails abc*
2433} -cleanup {
2434    cd [workingDirectory]
2435} -result {abc.link}
2436test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup {
2437    cd [temporaryDirectory]
2438} -body {
2439    lsort [glob -dir [pwd] -type d -tails abc*]
2440} -cleanup {
2441    cd [workingDirectory]
2442} -result [lsort [list abc.link abc.dir abc2.dir]]
2443test fCmd-28.19 {file link: relative paths} -setup {
2444    cd [temporaryDirectory]
2445} -constraints {win linkDirectory} -body {
2446    file mkdir d1/d2/d3
2447    file link d1/l2 d1/d2
2448} -cleanup {
2449    catch {file delete -force d1}
2450    cd [workingDirectory]
2451} -result d1/d2
2452test fCmd-28.20 {file link: relative paths} -setup {
2453    cd [temporaryDirectory]
2454} -constraints {unix linkDirectory} -body {
2455    file mkdir d1/d2/d3
2456    file link d1/l2 d1/d2
2457} -returnCodes error -cleanup {
2458    catch {file delete -force d1}
2459    cd [workingDirectory]
2460} -result {could not create new link "d1/l2": target "d1/d2" doesn't exist}
2461test fCmd-28.21 {file link: relative paths} -setup {
2462    cd [temporaryDirectory]
2463} -constraints {unix linkDirectory} -body {
2464    file mkdir d1/d2/d3
2465    file link d1/l2 d2
2466} -cleanup {
2467    catch {file delete -force d1}
2468    cd [workingDirectory]
2469} -result d2
2470test fCmd-28.22 {file link: relative paths} -setup {
2471    cd [temporaryDirectory]
2472} -constraints {unix linkDirectory} -body {
2473    file mkdir d1/d2/d3
2474    catch {file delete -force d1/l2}
2475    file link d1/l2 d2/d3
2476} -cleanup {
2477    catch {file delete -force d1}
2478    cd [workingDirectory]
2479} -result d2/d3
2480
2481test fCmd-29.1 {weird memory corruption fault} -body {
2482    open [file join ~a_totally_bogus_user_id/foo bar]
2483} -returnCodes error -match glob -result *
2484
2485cd [temporaryDirectory]
2486file delete -force abc.link
2487file delete -force d1/d2
2488file delete -force d1
2489cd [workingDirectory]
2490
2491removeFile abc2.file
2492removeFile abc.file
2493removeDirectory abc2.dir
2494removeDirectory abc.dir
2495
2496test fCmd-30.1 {file writable on 'My Documents'} -constraints {win 2000orNewer} -body {
2497    set mydocsname "~/My Documents"
2498    # Would be good to localise this name, since this test will only function
2499    # on english-speaking windows otherwise
2500    if {[file exists $mydocsname]} {
2501        return [file writable $mydocsname]
2502    }
2503    return 1
2504} -result {1}
2505test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win 2000orNewer knownBug} -body {
2506    # Apparently the OS has this file open with exclusive permissions Windows
2507    # doesn't provide any way to determine that fact without actually trying
2508    # to open the file (open NTUSER.dat r), which fails. Hence this isn't
2509    # really a knownBug in Tcl, but an OS limitation. But, perhaps in the
2510    # future that limitation will be lifted.
2511    if {[file exists "~/NTUSER.DAT"]} {
2512        return [file readable "~/NTUSER.DAT"]
2513    }
2514    return 0
2515} -result {0}
2516
2517# cleanup
2518cleanup
2519::tcltest::cleanupTests
2520return
Note: See TracBrowser for help on using the repository browser.