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