PageRenderTime 196ms CodeModel.GetById 36ms app.highlight 145ms RepoModel.GetById 0ms app.codeStats 1ms

/brlcad/branches/dmtogl/src/other/tcl/tests/fCmd.test

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