tcl/tests/fCmd.test

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