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