diff options
Diffstat (limited to 'tests/fCmd.test')
| -rw-r--r-- | tests/fCmd.test | 2500 |
1 files changed, 1300 insertions, 1200 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test index eff2f80..37867f3 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -1,38 +1,38 @@ # This file tests the tclFCmd.c file. # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } -tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]] -tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]] -tcltest::testConstraint notNetworkFilesystem 0 -testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}] -testConstraint 2000orNewer [expr {![testConstraint 95or98]}] +testConstraint testsetplatform [llength [info commands testsetplatform]] +testConstraint testchmod [llength [info commands testchmod]] testConstraint winVista 0 testConstraint win2000orXP 0 testConstraint winOlderThan2000 0 +# Don't know how to determine this constraint correctly +testConstraint notNetworkFilesystem 0 +testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}] +testConstraint 2000orNewer [expr {![testConstraint 95or98]}] -# Several tests require need to match results against the unix username -set user {} -if {$tcl_platform(platform) == "unix"} { - catch {set user [exec whoami]} - if {$user == ""} { - catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} - } - if {$user == ""} { - set user "root" +# Find a group that exists on this Unix system, or else skip tests that +# require Unix groups. +testConstraint foundGroup [expr {![testConstraint unix]}] +if {[testConstraint unix]} { + catch { + set groupList [exec groups] + set group [lindex $groupList 0] + testConstraint foundGroup 1 } } @@ -50,6 +50,33 @@ if {[testConstraint winOnly]} { } } +testConstraint darwin9 [expr {[testConstraint unix] && + $tcl_platform(os) eq "Darwin" && + int([string range $tcl_platform(osVersion) 0 \ + [string first . $tcl_platform(osVersion)]]) >= 9}] +testConstraint notDarwin9 [expr {![testConstraint darwin9]}] + +testConstraint fileSharing 0 +testConstraint notFileSharing 1 +testConstraint linkFile 1 +testConstraint linkDirectory 1 + +# Several tests require need to match results against the unix username +set user {} +if {[testConstraint unix]} { + catch { + set user [exec whoami] + } + if {$user eq ""} { + catch { + regexp {^[^(]*\(([^)]*)\)} [exec id] -> user + } + } + if {$user eq ""} { + set user "root" + } +} + proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string @@ -57,17 +84,17 @@ proc createfile {file {string a}} { return $string } -# +# # checkcontent -- # -# Ensures that file "file" contains only the string "matchString" -# returns 0 if the file does not exist, or has a different content +# Ensures that file "file" contains only the string "matchString" returns 0 +# if the file does not exist, or has a different content # proc checkcontent {file matchString} { if {[catch { set f [open $file] set fileString [read $f] - close $f + close $f }]} { return 0 } @@ -86,18 +113,17 @@ proc openup {path} { } proc cleanup {args} { - if {$::tcl_platform(platform) == "macintosh"} { - set wd [list :] - } else { - set wd [list .] - } + set wd [list .] foreach p [concat $wd $args] { set x "" catch { set x [glob -directory $p tf* td*] } foreach file $x { - if {[catch {file delete -force -- $file}]} { + if { + [catch {file delete -force -- $file}] + && [testConstraint testchmod] + } then { catch {openup $file} catch {file delete -force -- $file} } @@ -106,44 +132,25 @@ proc cleanup {args} { } proc contents {file} { - set f [open $file r] + set f [open $file] set r [read $f] close $f - set r + return $r } cd [temporaryDirectory] -set ::tcltest::testConstraints(fileSharing) 0 -set ::tcltest::testConstraints(notFileSharing) 1 - -if {$tcl_platform(platform) == "macintosh"} { - catch {file delete -force foo.dir} - file mkdir foo.dir - if {[catch {file attributes foo.dir -readonly 1}] == 0} { - set ::tcltest::testConstraints(fileSharing) 1 - set ::tcltest::testConstraints(notFileSharing) 0 - } - file delete -force foo.dir -} - -set ::tcltest::testConstraints(xdev) 0 - -if {$tcl_platform(platform) == "unix"} { - if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} { - set m1 [string range $m1 0 [expr [string first " " $m1]-1]] - set m2 [string range $m2 0 [expr [string first " " $m2]-1]] - if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} { - set ::tcltest::testConstraints(xdev) 1 - } - } +proc dev dir { + file stat $dir stat + return $stat(dev) } +testConstraint xdev [expr {[testConstraint unix] && ([dev .] != [dev /tmp])}] set root [lindex [file split [pwd]] 0] # A really long file name -# length of long is 1216 chars, which should be greater than any static -# buffer or allowable filename. +# length of long is 1216 chars, which should be greater than any static buffer +# or allowable filename. set long "abcdefghihjllmnopqrstuvwxyz01234567890" append long $long @@ -166,44 +173,49 @@ test fCmd-2.1 {TclFileCopyCmd} {notRoot} { lsort [glob tf*] } {tf1 tf2} -test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} { - list [catch {file rename -xyz} msg] $msg -} {1 {bad option "-xyz": should be -force or --}} -test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} { - list [catch {file rename xyz} msg] $msg -} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}} -test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} { - list [catch {file rename xyz ~_totally_bogus_user} msg] $msg -} {1 {user "_totally_bogus_user" doesn't exist}} -test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} { - cleanup - list [catch {file copy tf1 ~} msg] $msg -} {1 {error copying "tf1": no such file or directory}} -test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} { - cleanup - list [catch {file rename tf1 tf2 tf3} msg] $msg -} {1 {error renaming: target "tf3" is not a directory}} -test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \ - {notRoot} { - cleanup +test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body { + file rename -xyz +} -returnCodes error -result {bad option "-xyz": should be -force or --} +test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body { + file rename xyz +} -returnCodes error -result {wrong # args: should be "file rename ?options? source ?source ...? target"} +test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body { + file rename xyz ~_totally_bogus_user +} -returnCodes error -result {user "_totally_bogus_user" doesn't exist} +test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup { + cleanup +} -constraints {notRoot} -returnCodes error -body { + file copy tf1 ~ +} -result {error copying "tf1": no such file or directory} +test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} -setup { + cleanup +} -constraints {notRoot} -returnCodes error -body { + file rename tf1 tf2 tf3 +} -result {error renaming: target "tf3" is not a directory} +test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} -setup { + cleanup +} -constraints {notRoot} -returnCodes error -body { createfile tf3 - list [catch {file rename tf1 tf2 tf3} msg] $msg -} {1 {error renaming: target "tf3" is not a directory}} -test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} { + file rename tf1 tf2 tf3 +} -result {error renaming: target "tf3" is not a directory} +test fCmd-3.7 {FileCopyRename: target exists & is directory} -setup { cleanup +} -constraints {notRoot} -body { file mkdir td1 createfile tf1 tf1 file rename tf1 td1 contents [file join td1 tf1] -} {tf1} -test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} { +} -result {tf1} +test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} -setup { cleanup - list [catch {file rename tf1 tf2 tf3} msg] $msg -} {1 {error renaming: target "tf3" is not a directory}} -test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} { +} -constraints {notRoot} -returnCodes error -body { + file rename tf1 tf2 tf3 +} -result {error renaming: target "tf3" is not a directory} +test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup { cleanup - list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg -} {1 {error copying: target "tf3" is not a directory}} +} -constraints {notRoot} -returnCodes error -body { + file copy -force -- tf1 tf2 tf3 +} -result {error copying: target "tf3" is not a directory} test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} { cleanup createfile tf1 tf1 @@ -234,26 +246,29 @@ test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} { list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \ [contents [file join td1 tf3]] [contents [file join td1 tf4]] } {tf1 tf2 tf3 tf4} -test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} { +test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { file mkdir td1 - list [catch {file rename ~_totally_bogus_user td1} msg] $msg -} {1 {user "_totally_bogus_user" doesn't exist}} -test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} { + file rename ~_totally_bogus_user td1 +} -result {user "_totally_bogus_user" doesn't exist} +test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup { cleanup +} -constraints {notRoot unixOrPc} -returnCodes error -body { file mkdir td1 - list [catch {file rename / td1} msg] $msg -} {1 {error renaming "/" to "td1": file already exists}} -test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} { - cleanup - createfile tf1 - createfile tf2 - createfile tf3 - createfile tf4 + file rename / td1 +} -result {error renaming "/" to "td1": file already exists} +test fCmd-3.16 {FileCopyRename: break on first error} -setup { + cleanup +} -constraints {notRoot} -returnCodes error -body { + createfile tf1 + createfile tf2 + createfile tf3 + createfile tf4 file mkdir td1 createfile [file join td1 tf3] - list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg -} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}] + file rename tf1 tf2 tf3 tf4 td1 +} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}] test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} { cleanup @@ -271,15 +286,16 @@ test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} { catch {file mkdir td1 td2 tf1 td3 td4} glob td1 td2 tf1 td3 td4 } {td1 td2 tf1} -test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} { +test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup { cleanup - list [catch {file mkdir ~_totally_bogus_user} msg] $msg -} {1 {user "_totally_bogus_user" doesn't exist}} -test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \ - {notRoot} { +} -constraints {notRoot} -returnCodes error -body { + file mkdir ~_totally_bogus_user +} -result {user "_totally_bogus_user" doesn't exist} +test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setup { cleanup - list [catch {file mkdir ""} msg] $msg -} {1 {can't create directory "": no such file or directory}} +} -constraints {notRoot} -returnCodes error -body { + file mkdir "" +} -result {can't create directory "": no such file or directory} test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} { cleanup file mkdir td1 @@ -297,11 +313,12 @@ test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} file mkdir td1 list $x [file exists td1] } {1 1} -test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} { +test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { createfile tf1 - list [catch {file mkdir tf1} msg] $msg -} [subst {1 {can't create directory "[file join tf1]": file already exists}}] + file mkdir tf1 +} -result [subst {can't create directory "[file join tf1]": file already exists}] test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} { cleanup file mkdir td1 @@ -309,50 +326,45 @@ test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} { file mkdir td1 list $x [file exists td1] } {1 1} -test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \ - {unixOnly notRoot testchmod} { +test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup { cleanup +} -constraints {unix notRoot testchmod} -returnCodes error -body { file mkdir td1/td2/td3 testchmod 000 td1/td2 - set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg] + file mkdir td1/td2/td3/td4 +} -cleanup { testchmod 755 td1/td2 - set msg -} {1 {can't create directory "td1/td2/td3": permission denied}} -test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} { cleanup - list [catch {file mkdir nonexistentvolume:} msg] $msg -} {1 {can't create directory "nonexistentvolume:": invalid argument}} -test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} { +} -result {can't create directory "td1/td2/td3": permission denied} +test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup { cleanup +} -constraints {notRoot} -body { set x [file exists td1] file mkdir td1 list $x [file exists td1] -} {0 1} -test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \ - {unixOnly notRoot} { +} -result {0 1} +test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup { cleanup file delete -force foo +} -constraints {unix notRoot} -body { file mkdir foo file attr foo -perm 040000 - set result [list [catch {file mkdir foo/tf1} msg] $msg] + file mkdir foo/tf1 +} -returnCodes error -cleanup { file delete -force foo - set result -} {1 {can't create directory "foo/tf1": permission denied}} -test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} { - list [catch {file mkdir ${root}:} msg] $msg -} [subst {1 {can't create directory "${root}:": no such file or directory}}] +} -result {can't create directory "foo/tf1": permission denied} test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} { cleanup file mkdir tf1 file exists tf1 } {1} -test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} { - list [catch {file delete -xyz} msg] $msg -} {1 {bad option "-xyz": should be -force or --}} -test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} { - list [catch {file delete -force -force} msg] $msg -} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}} +test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body { + file delete -xyz +} -returnCodes error -result {bad option "-xyz": should be -force or --} +test fCmd-5.2 {TclFileDeleteCmd: not enough args} -constraints {notRoot} -body { + file delete -force -force +} -returnCodes error -result {wrong # args: should be "file delete ?options? file ?file ...?"} test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} { cleanup createfile tf1 @@ -378,9 +390,9 @@ test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} { catch {file delete tf1 td1 $root tf2} list [file exists tf1] [file exists tf2] [file exists td1] } {0 1 0} -test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} { - list [catch {file delete ~_totally_bogus_user} msg] $msg -} {1 {user "_totally_bogus_user" doesn't exist}} +test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body { + file delete ~_totally_bogus_user +} -returnCodes error -result {user "_totally_bogus_user" doesn't exist} test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} { catch {file delete ~/tf1} createfile ~/tf1 @@ -391,28 +403,32 @@ test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} set x [file exists tf1] file delete tf1 list $x [file exists tf1] -} {0 0} +} {0 0} test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} { cleanup file mkdir td1 file delete td1 file exists td1 } {0} -test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} { +test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { file mkdir [file join td1 td2] - list [catch {file delete td1} msg] $msg -} {1 {error deleting "td1": directory not empty}} -test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} {notRoot} { + file delete td1 +} -result {error deleting "td1": directory not empty} +test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup { cleanup set dir [pwd] +} -constraints {notRoot} -body { file mkdir [file join td1 td2] cd [file join td1 td2] set res [list [catch {file delete -force [file dirname [pwd]]} msg]] cd $dir lappend res [file exists td1] $msg -} {0 0 {}} -test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unixOnly} { +} -cleanup { + cd $dir +} -result {0 0 {}} +test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unix} { cleanup file mkdir [file join td1 td2] #exec chmod u-rwx [file join td1 td2] @@ -421,16 +437,17 @@ test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unixOnly} lappend res [file exists td1] $msg } {0 0 {}} -test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} { +test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} { # can't test this, because it's caught by FileCopyRename } {} -test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} { +test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot emptyTest} { # can't test this, because it's caught by FileCopyRename } {} -test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} { +test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup { cleanup - list [catch {file rename tf1 tf2} msg] $msg -} {1 {error renaming "tf1": no such file or directory}} +} -constraints {notRoot} -returnCodes error -body { + file rename tf1 tf2 +} -result {error renaming "tf1": no such file or directory} test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} { cleanup createfile tf1 @@ -443,43 +460,42 @@ test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} { file rename tf1 tf2 glob tf* } {tf2} -test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot testchmod} { +test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup { cleanup +} -constraints {unix notRoot testchmod} -body { file mkdir td1 testchmod 000 td1 createfile tf1 - set msg [list [catch {file rename tf1 td1} msg] $msg] + file rename tf1 td1 +} -returnCodes error -cleanup { testchmod 755 td1 - set msg -} {1 {error renaming "tf1" to "td1/tf1": permission denied}} -test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {pcOnly 95} { +} -result {error renaming "tf1" to "td1/tf1": permission denied} +test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup { cleanup +} -constraints {win 95} -returnCodes error -body { createfile tf1 - list [catch {file rename tf1 $long} msg] $msg -} [subst {1 {error renaming "tf1" to "$long": file name too long}}] -test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} { - cleanup - createfile tf1 - list [catch {file rename tf1 $long} msg] $msg -} [subst {1 {error renaming "tf1" to "$long": file name too long}}] -test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly notRoot} { + file rename tf1 $long +} -result [subst {error renaming "tf1" to "$long": file name too long}] +test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unix notRoot} { cleanup createfile tf1 file rename tf1 tf2 glob tf* } {tf2} -test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} { +test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { createfile tf1 createfile tf2 - list [catch {file rename tf1 tf2} msg] $msg -} {1 {error renaming "tf1" to "tf2": file already exists}} -test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} { + file rename tf1 tf2 +} -result {error renaming "tf1" to "tf2": file already exists} +test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { createfile tf1 createfile tf2 - list [catch {file rename tf1 tf2} msg] $msg -} {1 {error renaming "tf1" to "tf2": file already exists}} + file rename tf1 tf2 +} -result {error renaming "tf1" to "tf2": file already exists} test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} { cleanup createfile tf1 @@ -487,176 +503,184 @@ test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} { file rename -force tf1 tf2 glob tf* } {tf2} -test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} { +test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { file mkdir td1 file mkdir td2 createfile [file join td2 td1] - list [catch {file rename -force td1 td2} msg] $msg -} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}] -test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} { + file rename -force td1 td2 +} -result [subst {can't overwrite file "[file join td2 td1]" with directory "td1"}] +test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { createfile tf1 file mkdir [file join td1 tf1] - list [catch {file rename -force tf1 td1} msg] $msg -} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}] -test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot notNetworkFilesystem} { + file rename -force tf1 td1 +} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}] +test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} -setup { cleanup +} -constraints {notRoot notNetworkFilesystem} -body { file mkdir [file join td1 td2] file mkdir td2 createfile [file join td2 tf1] file rename -force td2 td1 file exists [file join td1 td2 tf1] -} {1} -test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {notRoot} { +} -result 1 +test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup { cleanup +} -constraints {notRoot} -body { file mkdir [file join td1 td2] createfile [file join td1 td2 tf1] file mkdir td2 - list [catch {file rename -force td2 td1} msg] $msg -} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}] - -test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} { + file rename -force td2 td1 +} -returnCodes error -match glob -result \ + [subst {error renaming "td2" to "[file join td1 td2]": file *}] +test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup { cleanup - list [catch {file rename -force $root tf1} msg] $msg -} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}] -test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {notRoot} { +} -constraints {notRoot} -returnCodes error -body { + file rename -force $root tf1 +} -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}] +test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup { cleanup +} -constraints {notRoot} -body { file mkdir [file join td1 td2] createfile [file join td1 td2 tf1] file mkdir td2 - list [catch {file rename -force td2 td1} msg] $msg -} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}] -test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} { + file rename -force td2 td1 +} -returnCodes error -match glob -result \ + [subst {error renaming "td2" to "[file join td1 td2]": file *}] +test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unix notRoot} { cleanup /tmp createfile tf1 file rename tf1 /tmp - glob tf* /tmp/tf1 + glob -nocomplain tf* /tmp/tf1 } {/tmp/tf1} -test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} { +test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { catch {file delete -force c:/tcl8975@ d:/tcl8975@} +} -body { file mkdir c:/tcl8975@ - if [catch {file rename c:/tcl8975@ d:/}] { - set msg d:/tcl8975@ - } else { - set msg [glob c:/tcl8975@ d:/tcl8975@] - file delete -force d:/tcl8975@ + if {[catch {file rename c:/tcl8975@ d:/}]} { + return d:/tcl8975@ } + glob c:/tcl8975@ d:/tcl8975@ +} -cleanup { file delete -force c:/tcl8975@ - set msg -} {d:/tcl8975@} + catch {file delete -force d:/tcl8975@} +} -result {d:/tcl8975@} test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \ - {unixOnly notRoot} { + {unix notRoot} { cleanup /tmp file mkdir td1 file rename td1 /tmp - glob td* /tmp/td* + glob -nocomplain td* /tmp/td* } {/tmp/td1} test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \ - {unixOnly notRoot} { + {unix notRoot} { cleanup /tmp createfile tf1 file rename tf1 /tmp - glob tf* /tmp/tf* + glob -nocomplain tf* /tmp/tf* } {/tmp/tf1} -test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \ - {unixOnly notRoot xdev} { +test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup /tmp +} -constraints {unix notRoot xdev} -body { file mkdir td1/td2/td3 file attributes td1 -permissions 0000 - set msg [list [catch {file rename td1 /tmp} msg] $msg] + file rename td1 /tmp +} -returnCodes error -cleanup { file attributes td1 -permissions 0755 - set msg -} {1 {error renaming "td1": permission denied}} -test fCmd-6.24 {CopyRenameOneFile: error uses original name} \ - {unixOnly notRoot} { +} -match regexp -result {^error renaming "td1"( to "/tmp/td1")?: permission denied$} +test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { cleanup +} -constraints {unix notRoot} -body { file mkdir ~/td1/td2 set td1name [file join [file dirname ~] [file tail ~] td1] file attributes $td1name -permissions 0000 - set msg [list [catch {file copy ~/td1 td1} msg] $msg] + file copy ~/td1 td1 +} -returnCodes error -cleanup { file attributes $td1name -permissions 0755 file delete -force ~/td1 - set msg -} {1 {error copying "~/td1": permission denied}} -test fCmd-6.25 {CopyRenameOneFile: error uses original name} \ - {unixOnly notRoot} { +} -result {error copying "~/td1": permission denied} +test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup { cleanup +} -constraints {unix notRoot} -body { file mkdir td2 file mkdir ~/td1 set td1name [file join [file dirname ~] [file tail ~] td1] file attributes $td1name -permissions 0000 - set msg [list [catch {file copy td2 ~/td1} msg] $msg] + file copy td2 ~/td1 +} -returnCodes error -cleanup { file attributes $td1name -permissions 0755 file delete -force ~/td1 - set msg -} {1 {error copying "td2" to "~/td1/td2": permission denied}} -test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \ - {unixOnly notRoot} { +} -result {error copying "td2" to "~/td1/td2": permission denied} +test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { cleanup +} -constraints {unix notRoot} -body { file mkdir ~/td1/td2 set td2name [file join [file dirname ~] [file tail ~] td1 td2] file attributes $td2name -permissions 0000 - set msg [list [catch {file copy ~/td1 td1} msg] $msg] + file copy ~/td1 td1 +} -returnCodes error -cleanup { file attributes $td2name -permissions 0755 file delete -force ~/td1 - set msg -} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}" -test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \ - {unixOnly notRoot xdev} { +} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" +test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup /tmp +} -constraints {unix notRoot xdev} -returnCodes error -body { file mkdir td1/td2/td3 file mkdir /tmp/td1 createfile /tmp/td1/tf1 - list [catch {file rename -force td1 /tmp} msg] $msg -} {1 {error renaming "td1" to "/tmp/td1": file already exists}} -test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \ - {unixOnly notRoot xdev} { + file rename -force td1 /tmp +} -result {error renaming "td1" to "/tmp/td1": file already exists} +test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup /tmp +} -constraints {unix notRoot xdev} -body { file mkdir td1/td2/td3 file attributes td1/td2/td3 -permissions 0000 - set msg [list [catch {file rename td1 /tmp} msg] $msg] + file rename td1 /tmp +} -returnCodes error -cleanup { file attributes td1/td2/td3 -permissions 0755 - set msg -} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}} -test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \ - {unixOnly notRoot xdev} { +} -result {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied} +test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { cleanup /tmp +} -constraints {unix notRoot xdev} -body { file mkdir td1/td2/td3 file rename td1 /tmp glob td* /tmp/td1/t* -} {/tmp/td1/td2} -test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \ - {unixOnly notRoot} { +} -result {/tmp/td1/td2} +test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup { cleanup +} -constraints {unix notRoot} -body { file mkdir foo/bar file attr foo -perm 040555 - set catchResult [catch {file rename foo/bar /tmp} msg] - set msg [lindex [split $msg :] end] + file rename foo/bar /tmp +} -returnCodes error -cleanup { catch {file delete /tmp/bar} catch {file attr foo -perm 040777} catch {file delete -force foo} - list $catchResult $msg -} {1 { permission denied}} -test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \ - {unixOnly notRoot xdev} { +} -match glob -result {*: permission denied} +test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup { catch {cleanup /tmp} +} -constraints {unix notRoot xdev} -body { file mkdir /tmp/td1 createfile /tmp/td1/tf1 file rename /tmp/td1/tf1 tf1 list [file exists /tmp/td1/tf1] [file exists tf1] -} {0 1} -test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} { +} -result {0 1} +test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup { cleanup - list [catch {file copy tf1 tf2} msg] $msg -} {1 {error copying "tf1": no such file or directory}} +} -returnCodes error -body { + file copy tf1 tf2 +} -result {error copying "tf1": no such file or directory} catch {cleanup /tmp} -test fCmd-7.1 {FileForceOption: none} {notRoot} { +test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup { cleanup +} -returnCodes error -body { file mkdir [file join tf1 tf2] - list [catch {file delete tf1} msg] $msg -} {1 {error deleting "tf1": directory not empty}} + file delete tf1 +} -result {error deleting "tf1": directory not empty} test fCmd-7.2 {FileForceOption: -force} {notRoot} { cleanup file mkdir [file join tf1 tf2] @@ -666,68 +690,88 @@ test fCmd-7.3 {FileForceOption: --} {notRoot} { createfile -tf1 file delete -- -tf1 } {} -test fCmd-7.4 {FileForceOption: bad option} {notRoot} { +test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup { createfile -tf1 - set msg [list [catch {file delete -tf1} msg] $msg] +} -body { + file delete -tf1 +} -returnCodes error -cleanup { file delete -- -tf1 - set msg -} {1 {bad option "-tf1": should be -force or --}} -test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} { +} -result {bad option "-tf1": should be -force or --} +test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { + cleanup +} -constraints {notRoot} -returnCodes error -body { createfile -- createfile -force file delete -force -force -- -- -force - list [catch {glob -- -- -force} msg] $msg -} {1 {no files matched glob patterns "-- -force"}} + glob -- -- -force +} -result {no files matched glob patterns "-- -force"} test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ - {unixOnly notRoot knownBug} { + -constraints {unix notRoot knownBug} -body { # Labelled knownBug because it is dangerous [Bug: 3881] file mkdir td1 file attr td1 -perm 040000 - set result [list [catch {file rename ~$user td1} msg] $msg] + file rename ~$user td1 +} -returnCodes error -cleanup { file delete -force td1 - set result -} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}" -test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} { +} -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied" +test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ + {unix notRoot} { string equal [file tail ~$user] ~$user } 0 -test fCmd-8.3 {file copy and path translation: ensure correct error} { - list [catch {file copy ~ [file join this file doesnt exist]} res] $res -} [list 1 \ - "error copying \"~\" to \"[file join this file doesnt exist]\":\ - no such file or directory"] +test fCmd-8.3 {file copy and path translation: ensure correct error} -body { + file copy ~ [file join this file doesnt exist] +} -returnCodes error -result [subst \ + {error copying "~" to "[file join this file doesnt exist]": no such file or directory}] -test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} { +test fCmd-9.1 {file rename: comprehensive: EACCES} -setup { cleanup +} -constraints {unix notRoot} -body { file mkdir td1 file mkdir td2 file attr td2 -perm 040000 - set result [list [catch {file rename td1 td2/} msg] $msg] + file rename td1 td2/ +} -returnCodes error -cleanup { file delete -force td2 file delete -force td1 - set result -} {1 {error renaming "td1" to "td2/td1": permission denied}} -test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} { +} -result {error renaming "td1" to "td2/td1": permission denied} +test fCmd-9.2 {file rename: comprehensive: source doesn't exist} -setup { cleanup - list [catch {file rename tf1 tf2} msg] $msg -} {1 {error renaming "tf1": no such file or directory}} -test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} { +} -constraints {notRoot} -returnCodes error -body { + file rename tf1 tf2 +} -result {error renaming "tf1": no such file or directory} +test fCmd-9.3 {file rename: comprehensive: file to new name} -setup { cleanup +} -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 testchmod 444 tf2 file rename tf1 tf3 file rename tf2 tf4 list [lsort [glob tf*]] [file writable tf3] [file writable tf4] -} {{tf3 tf4} 1 0} -test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod win2000orXP} { +} -result {{tf3 tf4} 1 0} +test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup { cleanup +} -constraints {testchmod win2000orXP} -body { file mkdir td1 td2 testchmod 555 td2 file rename td1 td3 file rename td2 td4 list [lsort [glob td*]] [file writable td3] [file writable td4] -} {{td3 td4} 1 0} +} -cleanup { + cleanup +} -result {{td3 td4} 1 0} +test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup { + cleanup +} -constraints {unix notRoot testchmod notDarwin9} -body { + file mkdir td1 td2 + testchmod 555 td2 + file rename td1 td3 + file rename td2 td4 + list [lsort [glob td*]] [file writable td3] [file writable td4] +} -cleanup { + cleanup +} -result {{td3 td4} 1 0} test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} { cleanup createfile tf1 tf1 @@ -736,18 +780,30 @@ test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} { file rename -force tf1 tf1 file rename -force tf2 tf2 list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2] -} {tf1 tf2 1 0} -test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod win2000orXP} { +} {tf1 tf2 1 0} +test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup { cleanup +} -constraints {testchmod win2000orXP} -body { file mkdir td1 file mkdir td2 testchmod 555 td2 file rename -force td1 . file rename -force td2 . list [lsort [glob td*]] [file writable td1] [file writable td2] -} {{td1 td2} 1 0} -test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} { +} -result {{td1 td2} 1 0} +test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup { cleanup +} -constraints {notRoot unix testchmod} -body { + file mkdir td1 + file mkdir td2 + testchmod 555 td2 + file rename -force td1 . + file rename -force td2 . + list [lsort [glob td*]] [file writable td1] [file writable td2] +} -result {{td1 td2} 1 0} +test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup { + cleanup +} -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 createfile tfs1 @@ -767,13 +823,14 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testc file rename -force tfs2 tfd2 file rename -force tfs3 tfd3 file rename -force tfs4 tfd4 - list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] -} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0} -test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod notNetworkFilesystem} { + list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] +} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0} +test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup { + cleanup +} -constraints {notRoot testchmod notNetworkFilesystem} -body { # Under unix, you can rename a read-only directory, but you can't # move it into another directory. - cleanup file mkdir td1 file mkdir [file join td2 td1] file mkdir tds1 @@ -784,47 +841,48 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod file mkdir [file join tdd2 tds2] file mkdir [file join tdd3 tds3] file mkdir [file join tdd4 tds4] - if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { + if {![testConstraint unix]} { testchmod 555 tds3 testchmod 555 tds4 } - if {$tcl_platform(platform) != "macintosh"} { - testchmod 555 [file join tdd2 tds2] - testchmod 555 [file join tdd4 tds4] - } + testchmod 555 [file join tdd2 tds2] + testchmod 555 [file join tdd4 tds4] set msg [list [catch {file rename td1 td2} msg] $msg] file rename -force tds1 tdd1 file rename -force tds2 tdd2 file rename -force tds3 tdd3 file rename -force tds4 tdd4 - if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { - set w3 [file writable [file join tdd3 tds3]] - set w4 [file writable [file join tdd4 tds4]] - } else { + if {[testConstraint unix]} { set w3 0 set w4 0 + } else { + set w3 [file writable [file join tdd3 tds3]] + set w4 [file writable [file join tdd4 tds4]] } list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \ [file writable [file join tdd2 tds2]] $w3 $w4 -} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}] -test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot testchmod} { +} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}] +# Test can hit EEXIST or EBUSY, depending on underlying filesystem +test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup { cleanup +} -constraints {notRoot testchmod} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] - if {!([testConstraint unix] || [testConstraint winVista]) && $tcl_platform(platform) != "macintosh"} { + if {!([testConstraint unix] || [testConstraint winVista])} { testchmod 555 tds2 } set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg] set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg] - if {!([testConstraint unix] || [testConstraint winVista]) && $tcl_platform(platform) != "macintosh"} { - set w2 [file writable tds2] - } else { + if {[testConstraint unix] || [testConstraint winVista]} { set w2 0 + } else { + set w2 [file writable tds2] } list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2 -} [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}] +} -match glob -result \ + [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}] test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} { cleanup createfile tf1 @@ -841,63 +899,93 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot te file mkdir td1 file mkdir td2 file mkdir td3 - if {!([testConstraint unix] || [testConstraint winVista]) && $tcl_platform(platform) != "macintosh"} { + if {!([testConstraint unix] || [testConstraint winVista])} { testchmod 555 td2 } file rename td1 [file join td3 td3] file rename td2 [file join td3 td4] - if {!([testConstraint unix] || [testConstraint winVista]) && $tcl_platform(platform) != "macintosh"} { - set w4 [file writable [file join td3 td4]] - } else { + if {[testConstraint unix] || [testConstraint winVista]} { set w4 0 + } else { + set w4 [file writable [file join td3 td4]] } list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] $w4 } [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] -test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod notNetworkFilesystem} { +test fCmd-9.12 {file rename: comprehensive: target exists} -setup { cleanup +} -constraints {notRoot testchmod notNetworkFilesystem} -body { file mkdir [file join td1 td2] [file join td2 td1] - if {$tcl_platform(platform) != "macintosh"} { - testchmod 555 [file join td2 td1] - } + testchmod 555 [file join td2 td1] file mkdir [file join td3 td4] [file join td4 td3] file rename -force td3 td4 - set msg [list [file exists td3] [file exists [file join td4 td3 td4]] \ - [catch {file rename td1 td2} msg] $msg] - if {$tcl_platform(platform) != "macintosh"} { - testchmod 755 [file join td2 td1] - } - set msg -} [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}] -test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {notRoot} { - cleanup + list [file exists td3] [file exists [file join td4 td3 td4]] \ + [catch {file rename td1 td2} msg] $msg +} -cleanup { + testchmod 755 [file join td2 td1] +} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}] +# Test can hit EEXIST or EBUSY, depending on underlying filesystem +test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup { + cleanup +} -constraints {notRoot} -body { file mkdir [file join td1 td2] [file join td2 td1 td4] - list [catch {file rename -force td1 td2} msg] $msg -} [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}] + file rename -force td1 td2 +} -returnCodes error -match glob -result \ + [subst {error renaming "td1" to "[file join td2 td1]": file *}] test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} { cleanup file mkdir td1 list [glob td*] [list [catch {file rename td1 td1} msg] $msg] } [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}] -test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \ - {notRoot} { +test fCmd-9.14.1 {file rename: comprehensive: dir into self} {notRoot} { cleanup file mkdir td1 + file rename td1 td1x + file rename td1x td1 + set msg "ok" +} {ok} +test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup { + cleanup + set dir [pwd] +} -constraints {nonPortable notRoot} -body { + file mkdir td1 + cd td1 + file rename [file join .. td1] [file join .. td1x] +} -returnCodes error -cleanup { + cd $dir +} -result [subst {error renaming "[file join .. td1]" to "[file join .. td1x]": permission denied}] +test fCmd-9.14.3 {file rename: comprehensive: dir into self} -setup { + cleanup + set dir [pwd] +} -constraints {notRoot} -body { + file mkdir td1 + cd td1 + file rename [file join .. td1] [file join .. td1 foo] +} -returnCodes error -cleanup { + cd $dir +} -result [subst {error renaming "[file join .. td1]" to "[file join .. td1 foo]": trying to rename a volume or move a directory into itself}] +test fCmd-9.15 {file rename: comprehensive: source and target incompatible} -setup { + cleanup +} -constraints {notRoot} -returnCodes error -body { + file mkdir td1 createfile tf1 - list [catch {file rename -force td1 tf1} msg] $msg -} {1 {can't overwrite file "tf1" with directory "td1"}} -test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \ - {notRoot} { + file rename -force td1 tf1 +} -cleanup { cleanup +} -result {can't overwrite file "tf1" with directory "td1"} +test fCmd-9.16 {file rename: comprehensive: source and target incompatible} -setup { + cleanup +} -constraints {notRoot} -returnCodes error -body { file mkdir td1/tf1 createfile tf1 - list [catch {file rename -force tf1 td1} msg] $msg -} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}] + file rename -force tf1 td1 +} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}] -test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} { +test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup { cleanup - list [catch {file copy tf1 tf2} msg] $msg -} {1 {error copying "tf1": no such file or directory}} +} -constraints {notRoot} -returnCodes error -body { + file copy tf1 tf2 +} -result {error copying "tf1": no such file or directory} test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} { cleanup createfile tf1 tf1 @@ -907,37 +995,38 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} file copy tf2 tf4 list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] } {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} -test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 95or98 testchmod} { +test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup { cleanup +} -constraints {notRoot unix testchmod} -body { file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 555 td2 file copy td1 td3 file copy td2 td4 - set msg [list [lsort [glob td*]] [glob -directory td3 t*] \ - [glob -directory td4 t*] [file writable td3] [file writable td4]] - if {$tcl_platform(platform) != "macintosh"} { - testchmod 755 td2 - testchmod 755 td4 - } - set msg -} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}] -test fCmd-10.3.1 {file copy: comprehensive: dir to new name} {notRoot pc 2000orNewer testchmod} { - # On Windows with ACLs, copying a directory is defined like this + list [lsort [glob td*]] [glob -directory td3 t*] \ + [glob -directory td4 t*] [file writable td3] [file writable td4] +} -cleanup { + testchmod 755 td2 + testchmod 755 td4 +} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0] +test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup { cleanup +} -constraints {notRoot win 2000orNewer testchmod} -body { + # On Windows with ACLs, copying a directory is defined like this file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 555 td2 file copy td1 td3 file copy td2 td4 - set msg [list [lsort [glob td*]] [glob -directory td3 t*] \ - [glob -directory td4 t*] [file writable td3] [file writable td4]] + list [lsort [glob td*]] [glob -directory td3 t*] \ + [glob -directory td4 t*] [file writable td3] [file writable td4] +} -cleanup { testchmod 755 td2 testchmod 755 td4 - set msg -} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1}] -test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} { +} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1] +test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup { cleanup +} -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 createfile tfs1 @@ -957,10 +1046,11 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testch file copy -force tfs2 tfd2 file copy -force tfs3 tfd3 file copy -force tfs4 tfd4 - list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] -} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0} -test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} { + list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] +} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0} +test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup { cleanup +} -constraints {notRoot testchmod} -body { file mkdir td1 file mkdir [file join td2 td1] file mkdir tds1 @@ -971,22 +1061,20 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} file mkdir [file join tdd2 tds2] file mkdir [file join tdd3 tds3] file mkdir [file join tdd4 tds4] - if {$tcl_platform(platform) != "macintosh"} { - testchmod 555 tds3 - testchmod 555 tds4 - testchmod 555 [file join tdd2 tds2] - testchmod 555 [file join tdd4 tds4] - } + testchmod 555 tds3 + testchmod 555 tds4 + testchmod 555 [file join tdd2 tds2] + testchmod 555 [file join tdd4 tds4] set a1 [list [catch {file copy td1 td2} msg] $msg] set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg] set a3 [catch {file copy -force tds2 tdd2}] set a4 [catch {file copy -force tds3 tdd3}] set a5 [catch {file copy -force tds4 tdd4}] - list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 -} [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}] -test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \ - {notRoot unixOrPc testchmod} { + list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 +} -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}] +test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { cleanup +} -constraints {notRoot unixOrPc testchmod} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] @@ -995,9 +1083,10 @@ test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \ set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg] set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg] list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2] -} [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}] -test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} { +} -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}] +test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup { cleanup +} -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 file mkdir td1 @@ -1006,10 +1095,10 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot t file copy tf2 [file join td1 tf4] list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] -} [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] -test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \ - {notRoot unixOrPc 95or98 testchmod} { +} -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] +test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup { cleanup +} -constraints {notRoot unix testchmod} -body { file mkdir td1 file mkdir td2 file mkdir td3 @@ -1018,11 +1107,11 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \ file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] [file writable [file join td3 td4]] -} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}] -test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} \ - {notRoot pc 2000orNewer testchmod} { - # On Windows with ACLs, copying a directory is defined like this +} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}] +test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup { cleanup +} -constraints {notRoot win 2000orNewer testchmod} -body { + # On Windows with ACLs, copying a directory is defined like this file mkdir td1 file mkdir td2 file mkdir td3 @@ -1031,605 +1120,577 @@ test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} \ file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ [file writable [file join td3 td3]] [file writable [file join td3 td4]] -} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}] -test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \ - {notRoot} { +} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}] +test fCmd-10.9 {file copy: comprehensive: source and target incompatible} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { file mkdir td1 createfile tf1 - list [catch {file copy -force td1 tf1} msg] $msg -} {1 {can't overwrite file "tf1" with directory "td1"}} -test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \ - {notRoot} { + file copy -force td1 tf1 +} -result {can't overwrite file "tf1" with directory "td1"} +test fCmd-10.10 {file copy: comprehensive: source and target incompatible} -setup { cleanup +} -constraints {notRoot} -returnCodes error -body { file mkdir [file join td1 tf1] createfile tf1 - list [catch {file copy -force tf1 td1} msg] $msg -} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}] -test fCmd-10.11 {file copy: copy to empty file name} { + file copy -force tf1 td1 +} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}] +test fCmd-10.11 {file copy: copy to empty file name} -setup { cleanup +} -returnCodes error -body { createfile tf1 - list [catch {file copy tf1 ""} msg] $msg -} {1 {error copying "tf1" to "": no such file or directory}} -test fCmd-10.12 {file rename: rename to empty file name} { + file copy tf1 "" +} -result {error copying "tf1" to "": no such file or directory} +test fCmd-10.12 {file rename: rename to empty file name} -setup { cleanup +} -returnCodes error -body { createfile tf1 - list [catch {file rename tf1 ""} msg] $msg -} {1 {error renaming "tf1" to "": no such file or directory}} -cleanup + file rename tf1 "" +} -result {error renaming "tf1" to "": no such file or directory} +cleanup -# old tests +# old tests -test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} { +test fCmd-11.1 {TclFileRenameCmd: -- option } -constraints notRoot -setup { catch {file delete -force -- -tfa1} +} -body { set s [createfile -tfa1] file rename -- -tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]] + list [checkcontent tfa2 $s] [file exists -tfa1] +} -cleanup { file delete tfa2 - set result -} {1} - -test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} { +} -result {1 0} +test fCmd-11.2 {TclFileRenameCmd: bad option } -constraints notRoot -setup { catch {file delete -force -- tfa1} +} -body { set s [createfile tfa1] - set r1 [catch {file rename -x tfa1 tfa2}] - set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]] + list [catch {file rename -x tfa1 tfa2}] \ + [checkcontent tfa1 $s] [file exists tfa2] +} -cleanup { file delete tfa1 - set result -} {1} - +} -result {1 1 0} test fCmd-11.3 {TclFileRenameCmd: bad \# args} { catch {file rename -- } } {1} - -test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} { - global env - set temp $env(HOME) - unset env(HOME) - set result [catch {file rename tfa ~/foobar }] - set env(HOME) $temp - set result - } {1} - -test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} { +test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} -setup { + set temp $::env(HOME) +} -constraints notRoot -body { + global env + unset env(HOME) + catch { file rename tfa ~/foobar } +} -cleanup { + set ::env(HOME) $temp +} -result 1 +test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} - createfile tfa1 - createfile tfa2 - createfile tfa3 - set result [catch {file rename tfa1 tfa2 tfa3}] +} -constraints {notRoot} -body { + createfile tfa1 + createfile tfa2 + createfile tfa3 + catch {file rename tfa1 tfa2 tfa3} +} -cleanup { file delete tfa1 tfa2 tfa3 - set result -} {1} - -test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} { +} -result {1} +test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup { catch {file delete -force -- tfa1 tfad} +} -constraints {notRoot} -body { set s [createfile tfa1] file mkdir tfad file rename tfa1 tfad - set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]] + list [checkcontent tfad/tfa1 $s] [file exists tfa1] +} -cleanup { file delete -force tfad - set result -} {1} - -test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} { +} -result {1 0} +test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} -setup { catch {file delete -force -- tfa1 tfa2 tfad} - set s1 [createfile tfa1 ] - set s2 [createfile tfa2 ] +} -constraints {notRoot} -body { + set s1 [createfile tfa1] + set s2 [createfile tfa2] file mkdir tfad file rename tfa1 tfa2 tfad - set r1 [checkcontent tfad/tfa1 $s1] - set r2 [checkcontent tfad/tfa2 $s2] - - set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]] - + list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \ + [file exists tfa1] [file exists tfa2] +} -cleanup { file delete -force tfad - set result -} {1} - -test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} { +} -result {1 1 0 0} +test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} -setup { catch {file delete -force -- tfa tfad} - set s [createfile tfa ] +} -constraints {notRoot} -body { + set s [createfile tfa] file mkdir tfad file mkdir tfad/tfa - set r1 [catch {file rename tfa tfad}] - set r2 [checkcontent tfa $s] - set r3 [file isdir tfad] - set result [expr $r1 && $r2 && $r3 ] + list [catch {file rename tfa tfad}] [checkcontent tfa $s] [file isdir tfad] +} -cleanup { file delete -force tfa tfad - set result -} {1} +} -result {1 1 1} # # Coverage tests for renamefile() ; # -test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} { +test fCmd-12.1 {renamefile: source filename translation failing} -setup { + set temp $::env(HOME) +} -constraints {notRoot} -body { global env - set temp $env(HOME) unset env(HOME) - set result [catch {file rename ~/tfa1 tfa2}] - set env(HOME) $temp - set result -} {1} - -test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} { + catch {file rename ~/tfa1 tfa2} +} -cleanup { + set ::env(HOME) $temp +} -result {1} +test fCmd-12.2 {renamefile: src filename translation failing} -setup { + set temp $::env(HOME) +} -constraints {notRoot} -body { global env - set temp $env(HOME) unset env(HOME) set s [createfile tfa1] file mkdir tfad - set result [catch {file rename tfa1 ~/tfa2 tfad}] - set env(HOME) $temp + catch {file rename tfa1 ~/tfa2 tfad} +} -cleanup { + set ::env(HOME) $temp file delete -force tfad - set result -} {1} - -test fCmd-12.3 {renamefile: stat failing on source} {notRoot} { +} -result {1} +test fCmd-12.3 {renamefile: stat failing on source} -setup { catch {file delete -force -- tfa1 tfa2} - set r1 [catch {file rename tfa1 tfa2}] - expr {$r1 && ![file exists tfa1] && ![file exists tfa2]} -} {1} - -test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} { +} -constraints {notRoot} -body { + list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2] +} -result {1 0 0} +test fCmd-12.4 {renamefile: error renaming file to directory} -setup { catch {file delete -force -- tfa tfad} - set s1 [createfile tfa ] +} -constraints {notRoot} -body { + set s1 [createfile tfa] file mkdir tfad file mkdir tfad/tfa - set r1 [catch {file rename tfa tfad}] - set r2 [checkcontent tfa $s1] - set r3 [file isdir tfad/tfa] - set result [expr $r1 && $r2 && $r3] + list [catch {file rename tfa tfad}] [checkcontent tfa $s1] \ + [file isdir tfad/tfa] +} -cleanup { file delete -force tfa tfad - set result -} {1} - -test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} { +} -result {1 1 1} +test fCmd-12.5 {renamefile: error renaming directory to file} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot} -body { file mkdir tfa file mkdir tfad set s [createfile tfad/tfa] - set r1 [catch {file rename tfa tfad}] - set r2 [checkcontent tfad/tfa $s] - set r3 [file isdir tfad] - set r4 [file isdir tfa] - set result [expr $r1 && $r2 && $r3 && $r4 ] + list [catch {file rename tfa tfad}] [checkcontent tfad/tfa $s] \ + [file isdir tfad] [file isdir tfa] +} -cleanup { file delete -force tfa tfad - set result -} {1} - -test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} { +} -result {1 1 1 1} +test fCmd-12.6 {renamefile: TclRenameFile succeeding} -setup { catch {file delete -force -- tfa1 tfa2} +} -constraints {notRoot} -body { set s [createfile tfa1] file rename tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]] + list [checkcontent tfa2 $s] [file exists tfa1] +} -cleanup { file delete tfa2 - set result -} {1} - -test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} { +} -result {1 0} +test fCmd-12.7 {renamefile: renaming directory into offspring} -setup { catch {file delete -force -- tfad} +} -constraints {notRoot} -body { file mkdir tfad file mkdir tfad/dir - set result [catch {file rename tfad tfad/dir}] - file delete -force tfad - set result -} {1} - -test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} { + catch {file rename tfad tfad/dir} +} -cleanup { + file delete -force tfad +} -result {1} +test fCmd-12.8 {renamefile: generic error} -setup { catch {file delete -force -- tfa} +} -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/dir file attributes tfa -permissions 0555 - set result [catch {file rename tfa/dir tfa2}] - file attributes tfa -permissions 0777 + catch {file rename tfa/dir tfa2} +} -cleanup { + catch {file attributes tfa -permissions 0777} file delete -force tfa - set result -} {1} - - -test fCmd-12.9 {renamefile: moving a file across volumes} {unixOnly notRoot} { +} -result {1} +test fCmd-12.9 {renamefile: moving a file across volumes} -setup { catch {file delete -force -- tfa /tmp/tfa} - set s [createfile tfa ] +} -constraints {unix notRoot} -body { + set s [createfile tfa] file rename tfa /tmp - set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]] + list [checkcontent /tmp/tfa $s] [file exists tfa] +} -cleanup { file delete /tmp/tfa - set result -} {1} - -test fCmd-12.10 {renamefile: moving a directory across volumes } \ - {unixOnly notRoot} { +} -result {1 0} +test fCmd-12.10 {renamefile: moving a directory across volumes} -setup { catch {file delete -force -- tfad /tmp/tfad} +} -constraints {unix notRoot} -body { file mkdir tfad - set s [createfile tfad/a ] + set s [createfile tfad/a] file rename tfad /tmp - set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]] + list [checkcontent /tmp/tfad/a $s] [file exists tfad] +} -cleanup { file delete -force /tmp/tfad - set result -} {1} +} -result {1 0} # # Coverage tests for TclCopyFilesCmd() # -test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} { +test fCmd-13.1 {TclCopyFilesCmd: -force option} -constraints notRoot -setup { catch {file delete -force -- tfa1} +} -body { set s [createfile tfa1] file copy -force tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] + list [checkcontent tfa2 $s] [checkcontent tfa1 $s] +} -cleanup { file delete tfa1 tfa2 - set result -} {1} - -test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} { +} -result {1 1} +test fCmd-13.2 {TclCopyFilesCmd: -- option} -constraints {notRoot} -setup { catch {file delete -force -- tfa1} +} -body { set s [createfile -tfa1] file copy -- -tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && [checkcontent -tfa1 $s]] + list [checkcontent tfa2 $s] [checkcontent -tfa1 $s] +} -cleanup { file delete -- -tfa1 tfa2 - set result -} {1} - -test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} { +} -result {1 1} +test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup { catch {file delete -force -- tfa1} +} -body { set s [createfile tfa1] - set r1 [catch {file copy -x tfa1 tfa2}] - set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]] + list [catch {file copy -x tfa1 tfa2}] \ + [checkcontent tfa1 $s] [file exists tfa2] +} -cleanup { file delete tfa1 - set result -} {1} - +} -result {1 1 0} test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} { catch {file copy -- } } {1} - -test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} { - global env - set temp $env(HOME) +test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup { + set temp $::env(HOME) +} -body { + global env unset env(HOME) - set result [catch {file copy tfa ~/foobar }] - set env(HOME) $temp - set result - } {1} - -test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} { + catch { file copy tfa ~/foobar } +} -cleanup { + set ::env(HOME) $temp +} -result {1} +test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} - createfile tfa1 - createfile tfa2 - createfile tfa3 - set result [catch {file copy tfa1 tfa2 tfa3}] +} -constraints {notRoot} -body { + createfile tfa1 + createfile tfa2 + createfile tfa3 + catch {file copy tfa1 tfa2 tfa3} +} -cleanup { file delete tfa1 tfa2 tfa3 - set result -} {1} - -test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} { +} -result {1} +test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup { catch {file delete -force -- tfa1 tfad} +} -constraints {notRoot} -body { set s [createfile tfa1] file mkdir tfad file copy tfa1 tfad - set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]] + list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s] +} -cleanup { file delete -force tfad tfa1 - set result -} {1} - -test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} { +} -result {1 1} +test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} -setup { catch {file delete -force -- tfa1 tfa2 tfad} +} -constraints {notRoot} -body { set s1 [createfile tfa1 ] set s2 [createfile tfa2 ] file mkdir tfad file copy tfa1 tfa2 tfad - set r1 [checkcontent tfad/tfa1 $s1] - set r2 [checkcontent tfad/tfa2 $s2] - set r3 [checkcontent tfa1 $s1] - set r4 [checkcontent tfa2 $s2] - set result [expr $r1 && $r2 && $r3 && $r4 ] - + list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \ + [checkcontent tfa1 $s1] [checkcontent tfa2 $s2] +} -cleanup { file delete -force tfad tfa1 tfa2 - set result -} {1} - -test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} { +} -result {1 1 1 1} +test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} -setup { catch {file delete -force -- tfa tfad} - set s [createfile tfa ] +} -constraints {notRoot} -body { + set s [createfile tfa] file mkdir tfad file mkdir tfad/tfa - set r1 [catch {file copy tfa tfad}] - set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]] - set r3 [file isdir tfad] - set result [expr $r1 && $r2 && $r3 ] + list [catch {file copy tfa tfad}] [checkcontent tfa $s] \ + [file isdir tfad/tfa] [file isdir tfad] +} -cleanup { file delete -force tfa tfad - set result -} {1} +} -result {1 1 1 1} # # Coverage tests for copyfile() -# -test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} { +# +test fCmd-14.1 {copyfile: source filename translation failing} -setup { + set temp $::env(HOME) +} -constraints {notRoot} -body { global env - set temp $env(HOME) unset env(HOME) - set result [catch {file copy ~/tfa1 tfa2}] - set env(HOME) $temp - set result -} {1} - -test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} { + catch {file copy ~/tfa1 tfa2} +} -cleanup { + set ::env(HOME) $temp +} -result {1} +test fCmd-14.2 {copyfile: dst filename translation failing} -setup { + set temp $::env(HOME) +} -constraints {notRoot} -body { global env - set temp $env(HOME) unset env(HOME) set s [createfile tfa1] file mkdir tfad - set r1 [catch {file copy tfa1 ~/tfa2 tfad}] - set result [expr $r1 && [checkcontent tfad/tfa1 $s]] - set env(HOME) $temp + list [catch {file copy tfa1 ~/tfa2 tfad}] [checkcontent tfad/tfa1 $s] +} -cleanup { + set ::env(HOME) $temp file delete -force tfa1 tfad - set result -} {1} - -test fCmd-14.3 {copyfile: stat failing on source} {notRoot} { +} -result {1 1} +test fCmd-14.3 {copyfile: stat failing on source} -setup { catch {file delete -force -- tfa1 tfa2} - set r1 [catch {file copy tfa1 tfa2}] - expr $r1 && ![file exists tfa1] && ![file exists tfa2] -} {1} - -test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} { +} -constraints notRoot -body { + list [catch {file copy tfa1 tfa2}] [file exists tfa1] [file exists tfa2] +} -result {1 0 0} +test fCmd-14.4 {copyfile: error copying file to directory} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot} -body { set s1 [createfile tfa ] file mkdir tfad file mkdir tfad/tfa - set r1 [catch {file copy tfa tfad}] - set r2 [checkcontent tfa $s1] - set r3 [file isdir tfad] - set r4 [file isdir tfad/tfa] - set result [expr $r1 && $r2 && $r3 && $r4 ] + list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \ + [file isdir tfad] [file isdir tfad/tfa] +} -cleanup { file delete -force tfa tfad - set result -} {1} - - test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} { - catch {file delete -force -- tfa tfad} - file mkdir tfa - file mkdir tfad - set s [createfile tfad/tfa] - set r1 [catch {file copy tfa tfad}] - set r2 [checkcontent tfad/tfa $s] - set r3 [file isdir tfad] - set r4 [file isdir tfa] - set result [expr $r1 && $r2 && $r3 && $r4 ] +} -result {1 1 1 1} +test fCmd-14.5 {copyfile: error copying directory to file} -setup { + catch {file delete -force -- tfa tfad} +} -constraints {notRoot} -body { + file mkdir tfa + file mkdir tfad + set s [createfile tfad/tfa] + list [catch {file copy tfa tfad}] [checkcontent tfad/tfa $s] \ + [file isdir tfad] [file isdir tfa] +} -cleanup { file delete -force tfa tfad - set result -} {1} - -test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} { +} -result {1 1 1 1} +test fCmd-14.6 {copyfile: copy file succeeding} -constraints notRoot -setup { catch {file delete -force -- tfa tfa2} +} -body { set s [createfile tfa] file copy tfa tfa2 - set result [expr [checkcontent tfa $s] && [checkcontent tfa2 $s]] + list [checkcontent tfa $s] [checkcontent tfa2 $s] +} -cleanup { file delete tfa tfa2 - set result -} {1} - -test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} { +} -result {1 1} +test fCmd-14.7 {copyfile: copy directory succeeding} -setup { catch {file delete -force -- tfa tfa2} +} -constraints {notRoot} -body { file mkdir tfa set s [createfile tfa/file] file copy tfa tfa2 - set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]] + list [checkcontent tfa/file $s] [checkcontent tfa2/file $s] +} -cleanup { file delete -force tfa tfa2 - set result -} {1} - -test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} { +} -result {1 1} +test fCmd-14.8 {copyfile: copy directory failing} -setup { catch {file delete -force -- tfa} +} -constraints {unix notRoot} -body { file mkdir tfa/dir/a/b/c file attributes tfa/dir -permissions 0000 - set r1 [catch {file copy tfa tfa2}] + catch {file copy tfa tfa2} +} -cleanup { file attributes tfa/dir -permissions 0777 - set result $r1 file delete -force tfa tfa2 - set result -} {1} +} -result {1} # # Coverage tests for TclMkdirCmd() # -test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} { +test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup { + set temp $::env(HOME) +} -constraints {notRoot} -body { global env - set temp $env(HOME) - unset env(HOME) - set result [catch {file mkdir ~/tfa}] - set env(HOME) $temp - set result -} {1} + unset env(HOME) + catch {file mkdir ~/tfa} +} -cleanup { + set ::env(HOME) $temp +} -result {1} # # Can Tcl_SplitPath return argc == 0? If so them we need a # test for that code. # -test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} { +test fCmd-15.2 {TclMakeDirsCmd - one directory } -setup { catch {file delete -force -- tfa} +} -constraints {notRoot} -body { file mkdir tfa - set result [file isdirectory tfa] + file isdirectory tfa +} -cleanup { file delete tfa - set result -} {1} - -test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} { +} -result {1} +test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup { catch {file delete -force -- tfa1 tfa2} +} -constraints {notRoot} -body { file mkdir tfa1 tfa2 - set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]] + list [file isdirectory tfa1] [file isdirectory tfa2] +} -cleanup { file delete tfa1 tfa2 - set result -} {1} - -test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} { +} -result {1 1} +test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup { catch {file delete -force -- tfa} +} -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/file file attributes tfa -permissions 0000 - set result [catch {file mkdir tfa/file}] + catch {file mkdir tfa/file} +} -cleanup { file attributes tfa -permissions 0777 file delete -force tfa - set result -} {1} - -test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \ - {notRoot} { +} -result {1} +test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup { catch {file delete -force -- tfa} +} -constraints {notRoot} -body { file mkdir tfa/a/b/c - set result [file isdir tfa/a/b/c] + file isdir tfa/a/b/c +} -cleanup { file delete -force tfa - set result -} {1} - - -test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} { +} -result {1} +test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup { catch {file delete -force -- tfa} +} -constraints {notRoot} -body { set s [createfile tfa] - set r1 [catch {file mkdir tfa}] - set r2 [file isdir tfa] - set r3 [file exists tfa] - set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]] + list [catch {file mkdir tfa}] [file isdir tfa] [file exists tfa] \ + [checkcontent tfa $s] +} -cleanup { file delete tfa - set result -} {1} - -test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} { +} -result {1 0 1 1} +test fCmd-15.7 {TclMakeDirsCmd - making several directories} -setup { catch {file delete -force -- tfa1 tfa2} +} -constraints {notRoot} -body { file mkdir tfa1 tfa2/a/b/c - set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]] + list [file isdir tfa1] [file isdir tfa2/a/b/c] +} -cleanup { file delete -force tfa1 tfa2 - set result -} {1} - -test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} { +} -result {1 1} +test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body { file mkdir tfa file mkdir tfa - set result [file isdir tfa] + file isdir tfa +} -constraints {notRoot} -cleanup { file delete tfa - set result -} {1} - +} -result {1} # Coverage tests for TclDeleteFilesCommand() -test fCmd-16.1 {test the -- argument} {notRoot} { +test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup { catch {file delete -force -- tfa} +} -body { createfile tfa file delete -- tfa file exists tfa -} {0} - -test fCmd-16.2 {test the -force and -- arguments} {notRoot} { +} -result 0 +test fCmd-16.2 {test the -force and -- arguments} -constraints notRoot -setup { catch {file delete -force -- tfa} +} -body { createfile tfa file delete -force -- tfa file exists tfa -} {0} - -test fCmd-16.3 {test bad option} {notRoot} { +} -result 0 +test fCmd-16.3 {test bad option} -constraints {notRoot} -setup { catch {file delete -force -- tfa} +} -body { createfile tfa - set result [catch {file delete -dog tfa}] + catch {file delete -dog tfa} +} -cleanup { file delete tfa - set result -} {1} - -test fCmd-16.4 {test not enough args} {notRoot} { - catch {file delete} -} {1} - -test fCmd-16.5 {test not enough args with options} {notRoot} { - catch {file delete --} -} {1} - -test fCmd-16.6 {delete: source filename translation failing} {notRoot} { +} -result {1} +test fCmd-16.4 {test not enough args} -constraints {notRoot} -body { + file delete +} -returnCodes error -match glob -result "wrong \# args: should be *" +test fCmd-16.5 {test not enough args with options} -constraints {notRoot} -body { + file delete -- +} -returnCodes error -match glob -result "wrong \# args: should be *" +test fCmd-16.6 {delete: source filename translation failing} -setup { + set temp $::env(HOME) +} -constraints {notRoot} -body { global env - set temp $env(HOME) unset env(HOME) - set result [catch {file delete ~/tfa}] - set env(HOME) $temp - set result -} {1} - -test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} { + catch {file delete ~/tfa} +} -cleanup { + set ::env(HOME) $temp +} -result {1} +test fCmd-16.7 {remove a non-empty directory without -force} -setup { catch {file delete -force -- tfa} +} -constraints {notRoot} -body { file mkdir tfa createfile tfa/a - set result [catch {file delete tfa }] + catch {file delete tfa} +} -cleanup { file delete -force tfa - set result -} {1} - -test fCmd-16.8 {remove a normal file } {notRoot} { +} -result {1} +test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup { catch {file delete -force -- tfa} +} -body { file mkdir tfa createfile tfa/a - set result [catch {file delete tfa }] + catch {file delete tfa} +} -cleanup { file delete -force tfa - set result -} {1} - -test fCmd-16.9 {error while deleting file } {unixOnly notRoot} { +} -result {1} +test fCmd-16.9 {error while deleting file} -setup { catch {file delete -force -- tfa} +} -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/a file attributes tfa -permissions 0555 - set result [catch {file delete tfa/a }] + catch {file delete tfa/a} ####### - ####### If any directory in a tree that is being removed does not - ####### have write permission, the process will fail! - ####### This is also the case with "rm -rf" + ####### If any directory in a tree that is being removed does not have + ####### write permission, the process will fail! This is also the case + ####### with "rm -rf" ####### +} -cleanup { file attributes tfa -permissions 0777 file delete -force tfa - set result -} {1} - -test fCmd-16.10 {deleting multiple files} {notRoot} { +} -result {1} +test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2} +} -body { createfile tfa1 createfile tfa2 file delete tfa1 tfa2 - expr ![file exists tfa1] && ![file exists tfa2] -} {1} - -test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} { + list [file exists tfa1] [file exists tfa2] +} -result {0 0} +test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup { catch {file delete -force -- tfa} +} -constraints {notRoot} -body { file delete tfa - set result 1 -} {1} +} -result {} # More coverage tests for mkpath() - test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} { +test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup { catch {file delete -force -- tfa1} +} -constraints {unix notRoot} -body { file mkdir tfa1 file attributes tfa1 -permissions 0555 - set result [catch {file mkdir tfa1/tfa2}] + catch {file mkdir tfa1/tfa2} +} -cleanup { file attributes tfa1 -permissions 0777 file delete -force tfa1 - set result -} {1} - -test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} { +} -result {1} +test fCmd-17.2 {mkdir several levels deep - relative} -setup { catch {file delete -force -- tfa} +} -constraints {notRoot} -body { file mkdir tfa/a/b - set result [file isdir tfa/a/b ] + file isdir tfa/a/b +} -cleanup { file delete tfa/a/b tfa/a tfa - set result -} {1} - -test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} { +} -result 1 +test fCmd-17.3 {mkdir several levels deep - absolute} -setup { catch {file delete -force -- tfa} - set f [file join [pwd] tfa a ] +} -constraints {notRoot} -body { + set f [file join [pwd] tfa a] file mkdir $f - set result [file isdir $f ] + file isdir $f +} -cleanup { file delete $f [file join [pwd] tfa] - set result -} {1} +} -result {1} # # Functionality tests for TclFileRenameCmd() # test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \ - {notRoot} { + -setup { catch {file delete -force -- tfad} + set savedDir [pwd] +} -constraints {notRoot} -body { file mkdir tfad/dir cd tfad/dir set s [createfile foo ] @@ -1642,217 +1703,191 @@ test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \ file rename ../../tfad/dir/foo ../../tfad/dir/bar file rename [file join [pwd] bar] foo file rename foo [file join [pwd] bar] - set result [expr [checkcontent bar $s] && ![file exists foo]] - cd ../.. + list [checkcontent bar $s] [file exists foo] +} -cleanup { + cd $savedDir file delete -force tfad - set result -} {1} - -test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} { +} -result {1 0} +test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} -setup { catch {file delete -force -- tfa1 tfa2} +} -constraints {notRoot} -body { file mkdir tfa1 file rename tfa1 tfa2 - set result [expr [file exists tfa2] && ![file exists tfa1]] + list [file exists tfa2] [file exists tfa1] +} -cleanup { file delete tfa2 - set result -} {1} - -test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} { +} -result {1 0} +test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} -setup { catch {file delete -force -- tfa1 tfad1 tfad2} - set s [createfile tfa1 ] +} -constraints {notRoot} -body { + set s [createfile tfa1] file mkdir tfad1 tfad2 file rename tfa1 tfad1 tfad2 - set r1 [checkcontent tfad2/tfa1 $s] - set r2 [file isdir tfad2/tfad1] - set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]] + list [checkcontent tfad2/tfa1 $s] [file isdir tfad2/tfad1] \ + [file exists tfa1] [file exists tfad1] +} -cleanup { file delete tfad2/tfa1 file delete -force tfad2 - set result -} {1} - -test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} { +} -result {1 1 0 0} +test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} -setup { catch {file delete -force -- tfa tfad} - set s [createfile tfa ] +} -constraints {notRoot} -body { + set s [createfile tfa] file mkdir tfad - set r1 [catch {file rename tfad tfa}] - set r2 [checkcontent tfa $s] - set r3 [file isdir tfad] - set result [expr $r1 && $r2 && $r3 ] + list [catch {file rename tfad tfa}] [checkcontent tfa $s] [file isdir tfad] +} -cleanup { file delete tfa tfad - set result -} {1} - -test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} { +} -result {1 1 1} +test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} -setup { catch {file delete -force -- tfa tfad} - set s [createfile tfa ] +} -constraints {notRoot} -body { + set s [createfile tfa] file mkdir tfad/tfa - set r1 [catch {file rename tfa tfad}] - set r2 [checkcontent tfa $s] - set r3 [file isdir tfad/tfa] - set result [expr $r1 && $r2 && $r3 ] - file delete -force tfa tfad - set result -} {1} - + list [catch {file rename tfa tfad}] [checkcontent tfa $s] \ + [file isdir tfad/tfa] +} -cleanup { + file delete -force tfa tfad +} -result {1 1 1} # # On Windows there is no easy way to determine if two files are the same # -test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} { +test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} -setup { catch {file delete -force -- tfa} +} -constraints {unix notRoot} -body { set s [createfile tfa] - set r1 [catch {file rename tfa tfa}] - set result [expr $r1 && [checkcontent tfa $s]] + list [catch {file rename tfa tfa}] [checkcontent tfa $s] +} -cleanup { file delete tfa - set result -} {1} - -test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \ - {notRoot} { +} -result {1 1} +test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot} -body { file mkdir tfa tfad/tfa - set r1 [catch {file rename tfa tfad}] - set result [expr $r1 && [file isdir tfa]] + list [catch {file rename tfa tfad}] [file isdir tfa] +} -cleanup { file delete -force tfa tfad - set result -} {1} - -test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \ - {notRoot notNetworkFilesystem} { +} -result {1 1} +test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot notNetworkFilesystem} -body { file mkdir tfa tfad/tfa file rename -force tfa tfad - set result [expr ![file isdir tfa]] + file isdir tfa +} -cleanup { file delete -force tfad - set result -} {1} - -test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \ - {notRoot} { +} -result 0 +test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot} -body { file mkdir tfa tfad/tfa/file - set r1 [catch {file rename tfa tfad}] - set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]] + list [catch {file rename tfa tfad}] [file isdir tfa] \ + [file isdir tfad/tfa/file] +} -cleanup { file delete -force tfa tfad - set result -} {1} - -test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \ - {notRoot notNetworkFilesystem} { +} -result {1 1 1} +test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot notNetworkFilesystem} -body { file mkdir tfa tfad/tfa/file - set r1 [catch {file rename -force tfa tfad}] - set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]] + list [catch {file rename -force tfa tfad}] [file isdir tfa] \ + [file isdir tfad/tfa/file] +} -cleanup { file delete -force tfa tfad - set result -} {1} - -test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} { +} -result {1 1 1} +test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} -setup { catch {file delete -force -- tfa1} - set r1 [catch {file rename tfa1 tfa2}] - set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]] -} {1} - -test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \ - {unixOnly notRoot} { +} -constraints {notRoot} -body { + list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2] +} -result {1 0 0} +test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} - +} -constraints {unix notRoot} -body { set s [createfile tfa1] file link -symbolic tfa2 tfa1 file rename tfa2 tfa3 - set t [file type tfa3] - set result [expr {$t eq "link"}] + file type tfa3 +} -cleanup { file delete tfa1 tfa3 - set result -} {1} - -test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \ - {unixOnly notRoot} { +} -result link +test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} - +} -constraints {unix notRoot} -body { file mkdir tfa1 file link -symbolic tfa2 tfa1 file rename tfa2 tfa3 - set t [file type tfa3] - set result [expr {$t eq "link"}] + file type tfa3 +} -cleanup { file delete tfa1 tfa3 - set result -} {1} - -test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \ - {unixOnly notRoot} { +} -result link +test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} - +} -constraints {unix notRoot} -body { file mkdir tfa1/a/b/c/d file mkdir tfa2 - set f [file join [pwd] tfa1/a/b] + set f [file join [pwd] tfa1/a/b] set f2 [file join [pwd] {tfa2/b alias}] file link -symbolic $f2 $f file rename {tfa2/b alias/c} tfa3 - set r1 [file isdir tfa3] - set r2 [file exists tfa1/a/b/c] - set result [expr $r1 && !$r2] + list [file isdir tfa3] [file exists tfa1/a/b/c] +} -cleanup { file delete -force tfa1 tfa2 tfa3 - set result -} {1} - -test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \ - {unixOnly notRoot} { +} -result {1 0} +test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup { catch {file delete -force -- tfa1 tfa2 tfalink} - +} -constraints {unix notRoot} -body { file mkdir tfa1 set s [createfile tfa2] file link -symbolic tfalink tfa1 file rename tfa2 tfalink - set result [checkcontent tfa1/tfa2 $s ] + checkcontent tfa1/tfa2 $s +} -cleanup { file delete -force tfa1 tfalink - set result -} {1} - -test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} { +} -result {1} +test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup { catch {file delete -force -- tfa1 tfalink} - +} -constraints {unix notRoot} -body { file mkdir tfa1 file link -symbolic tfalink tfa1 - file delete tfa1 + file delete tfa1 file rename tfalink tfa2 - set result [expr [string compare [file type tfa2] "link"] == 0] + file type tfa2 +} -cleanup { file delete tfa2 - set result -} {1} - +} -result link # # Coverage tests for TclUnixRmdir # -test fCmd-19.1 {remove empty directory} {notRoot} { +test fCmd-19.1 {remove empty directory} -constraints {notRoot} -setup { catch {file delete -force -- tfa} +} -body { file mkdir tfa file delete tfa file exists tfa -} {0} - -test fCmd-19.2 {rmdir error besides EEXIST} {unixOnly notRoot} { +} -result {0} +test fCmd-19.2 {rmdir error besides EEXIST} -setup { catch {file delete -force -- tfa} +} -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/a file attributes tfa -permissions 0555 - set result [catch {file delete tfa/a}] + catch {file delete tfa/a} +} -cleanup { file attributes tfa -permissions 0777 file delete -force tfa - set result -} {1} - -test fCmd-19.3 {recursive remove} {notRoot} { +} -result {1} +test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup { catch {file delete -force -- tfa} +} -body { file mkdir tfa file mkdir tfa/a file delete -force tfa file exists tfa -} {0} +} -result {0} # -# TclUnixDeleteFile and TraversalDelete are covered by tests from the +# TclUnixDeleteFile and TraversalDelete are covered by tests from the # TclDeleteFilesCmd suite # # @@ -1861,235 +1896,229 @@ test fCmd-19.3 {recursive remove} {notRoot} { # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd # -test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \ - {unixOnly notRoot} { +test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } -setup { catch {file delete -force -- tfa} +} -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/a file attributes tfa/a -permissions 0000 - set result [catch {file delete -force tfa}] + catch {file delete -force tfa} +} -cleanup { file attributes tfa/a -permissions 0777 file delete -force tfa - set result -} {1} - -test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \ - {unix notRoot} { +} -result {1} +test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup { catch {file delete -force -- tfa} +} -constraints {unix notRoot} -body { file mkdir tfa - for {set i 1} {$i <= 300} {incr i} {createfile tfa/testfile_$i} - set result [catch {file delete -force tfa} msg] + for {set i 1} {$i <= 300} {incr i} { + createfile tfa/testfile_$i + } + file delete -force tfa +} -cleanup { while {[catch {file delete -force tfa}]} {} - list $result $msg -} {0 {}} +} -result {} # # Feature testing for TclCopyFilesCmd -# -test fCmd-21.1 {copy : single file to nonexistant } {notRoot} { +# +test fCmd-21.1 {copy : single file to nonexistant} -setup { catch {file delete -force -- tfa1 tfa2} +} -constraints {notRoot} -body { set s [createfile tfa1] file copy tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] + list [checkcontent tfa2 $s] [checkcontent tfa1 $s] +} -cleanup { file delete tfa1 tfa2 - set result -} {1} - -test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} { +} -result {1 1} +test fCmd-21.2 {copy : single dir to nonexistant} -setup { catch {file delete -force -- tfa1 tfa2} +} -constraints {notRoot} -body { file mkdir tfa1 file copy tfa1 tfa2 - set result [expr [file isdir tfa2] && [file isdir tfa1]] + list [file isdir tfa2] [file isdir tfa1] +} -cleanup { file delete tfa1 tfa2 - set result -} {1} - -test fCmd-21.3 {copy : single file into directory } {notRoot} { +} -result {1 1} +test fCmd-21.3 {copy : single file into directory} -setup { catch {file delete -force -- tfa1 tfad} +} -constraints {notRoot} -body { set s [createfile tfa1] file mkdir tfad file copy tfa1 tfad - set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]] + list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s] +} -cleanup { file delete -force tfa1 tfad - set result -} {1} - -test fCmd-21.4 {copy : more than one source and target is not a directory} \ - {notRoot} { +} -result {1 1} +test fCmd-21.4 {copy : more than one source and target is not a directory} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} - createfile tfa1 - createfile tfa2 - createfile tfa3 - set result [catch {file copy tfa1 tfa2 tfa3}] +} -constraints {notRoot} -body { + createfile tfa1 + createfile tfa2 + createfile tfa3 + catch {file copy tfa1 tfa2 tfa3} +} -cleanup { file delete tfa1 tfa2 tfa3 - set result -} {1} - -test fCmd-21.5 {copy : multiple files into directory } {notRoot} { +} -result {1} +test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2 tfad} - set s1 [createfile tfa1 ] - set s2 [createfile tfa2 ] +} -body { + set s1 [createfile tfa1] + set s2 [createfile tfa2] file mkdir tfad file copy tfa1 tfa2 tfad - set r1 [checkcontent tfad/tfa1 $s1] - set r2 [checkcontent tfad/tfa2 $s2] - set r3 [checkcontent tfa1 $s1] - set r4 [checkcontent tfa2 $s2] - set result [expr $r1 && $r2 && $r3 && $r4] + list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \ + [checkcontent tfa1 $s1] [checkcontent tfa2 $s2] +} -cleanup { file delete -force tfa1 tfa2 tfad - set result -} {1} - -test fCmd-21.6 {copy: mixed dirs and files into directory} \ - {notRoot notFileSharing} { +} -result {1 1 1 1} +test fCmd-21.6 {copy: mixed dirs and files into directory} -setup { catch {file delete -force -- tfa1 tfad1 tfad2} - set s [createfile tfa1 ] +} -constraints {notRoot notFileSharing} -body { + set s [createfile tfa1] file mkdir tfad1 tfad2 file copy tfa1 tfad1 tfad2 - set r1 [checkcontent [file join tfad2 tfa1] $s] - set r2 [file isdir [file join tfad2 tfad1]] - set r3 [checkcontent tfa1 $s] - set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]] + list [checkcontent [file join tfad2 tfa1] $s] \ + [file isdir [file join tfad2 tfad1]] \ + [checkcontent tfa1 $s] [file isdir tfad1] +} -cleanup { file delete -force tfa1 tfad1 tfad2 - set result -} {1} - -test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot dontCopyLinks} { +} -result {1 1 1 1} +test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} -setup { + catch {file delete -force tfad1 tfalink tfalink2} +} -constraints {unix notRoot dontCopyLinks} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file delete tfad1 - set result [list [catch {file copy tfalink tfalink2} msg] $msg] - file delete -force tfalink tfalink2 - set result -} {1 {error copying "tfalink": the target of this link doesn't exist}} -test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} { + file copy tfalink tfalink2 +} -returnCodes error -cleanup { + file delete -force tfalink tfalink2 +} -result {error copying "tfalink": the target of this link doesn't exist} +test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} -setup { + catch {file delete -force tfad1 tfalink tfalink2} +} -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file delete tfad1 file copy tfalink tfalink2 - set result [string match [file type tfalink2] link] - file delete tfalink tfalink2 - set result -} {1} - -test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unixOnly notRoot dontCopyLinks} { + file type tfalink2 +} -cleanup { + file delete tfalink tfalink2 +} -result link +test fCmd-21.8.1 {TclCopyFilesCmd: copy a link} -setup { + catch {file delete -force tfad1 tfalink tfalink2} +} -constraints {unix notRoot dontCopyLinks} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file copy tfalink tfalink2 - set r1 [file type tfalink]; # link - set r2 [file type tfalink2]; # directory - set r3 [file isdir tfad1]; # 1 - set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}] + list [file type tfalink] [file type tfalink2] [file isdir tfad1] +} -cleanup { file delete -force tfad1 tfalink tfalink2 - set result -} {1} -test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unixOnly notRoot} { +} -result {link directory 1} +test fCmd-21.8.2 {TclCopyFilesCmd: copy a link} -setup { + catch {file delete -force tfad1 tfalink tfalink2} +} -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file copy tfalink tfalink2 - set r1 [file type tfalink]; # link - set r2 [file type tfalink2]; # link - set r3 [file isdir tfad1]; # 1 - set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}] + list [file type tfalink] [file type tfalink2] [file isdir tfad1] +} -cleanup { file delete -force tfad1 tfalink tfalink2 - set result -} {1} - -test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} { +} -result {link link 1} +test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} -setup { + catch {file delete -force tfad1 tfad2} +} -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfad1/tfalink "[pwd]/tfad1" file copy tfad1 tfad2 - set result [string match [file type tfad2/tfalink] link] + file type tfad2/tfalink +} -cleanup { file delete -force tfad1 tfad2 - set result -} {1} - -test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \ - {notRoot} { +} -result link +test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot} -body { file mkdir tfa [file join tfad tfa] - set r1 [catch {file copy tfa tfad}] - set result [expr $r1 && [file isdir tfa]] + list [catch {file copy tfa tfad}] [file isdir tfa] +} -cleanup { file delete -force tfa tfad - set result -} {1} - -test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} { +} -result {1 1} +test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot} -body { file mkdir tfa [file join tfad tfa file] - set r1 [catch {file copy tfa tfad}] - set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]] + list [catch {file copy tfa tfad}] [file isdir tfa] \ + [file isdir [file join tfad tfa file]] +} -cleanup { file delete -force tfa tfad - set result -} {1} - -test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \ - {notRoot} { +} -result {1 1 1} +test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} -setup { catch {file delete -force -- tfa tfad} +} -constraints {notRoot} -body { file mkdir tfa [file join tfad tfa file] - set r1 [catch {file copy -force tfa tfad}] - set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]] + list [catch {file copy -force tfa tfad}] [file isdir tfa] \ + [file isdir [file join tfad tfa file]] +} -cleanup { file delete -force tfa tfad - set result -} {1} +} -result {1 1 1} # # Coverage testing for TclpRenameFile # -test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} { +test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} -setup { catch {file delete -force -- tfa1 tfa2} +} -constraints {notRoot} -body { set s [createfile tfa1] set s2 [createfile tfa2 q] - - set r1 [catch {rename tfa1 tfa2}] + + set result [catch {file rename tfa1 tfa2}] file rename -force tfa1 tfa2 - set result [expr $r1 && [checkcontent tfa2 $s]] + lappend result [checkcontent tfa2 $s] +} -cleanup { file delete [glob tfa1 tfa2] - set result -} {1} - -test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} { +} -result {1 1} +test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup { catch {file delete -force -- tfa1} - set s [createfile tfa1] +} -constraints {unix notRoot} -body { + set s [createfile tfa1] file rename -force tfa1 tfa1 - set result [checkcontent tfa1 $s] - file delete tfa1 - set result -} {1} - -test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} { + checkcontent tfa1 $s +} -cleanup { + file delete tfa1 +} -result {1} +test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup { catch {file delete -force -- d1 tfad} +} -constraints {notRoot} -body { file mkdir d1 [file join tfad d1] - set r1 [catch {file rename d1 tfad}] - set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]] + list [catch {file rename d1 tfad}] [file isdir d1] \ + [file isdir [file join tfad d1]] +} -cleanup { file delete -force d1 tfad - set result -} {1} - -test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} { +} -result {1 1 1} +test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} -setup { catch {file delete -force -- d1 tfad} +} -constraints {notRoot} -body { file mkdir d1 [file join tfad a b c] file rename d1 [file join tfad a b c d1] - set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]] + list [file isdir d1] [file isdir [file join tfad a b c d1]] +} -cleanup { file delete -force [glob d1 tfad] - set result -} {1} - - +} -result {0 1} # # TclMacCopyFile needs to be redone. # -test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} { +test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup { catch {file delete -force -- tfa1 tfa2} +} -constraints {notRoot} -body { set s [createfile tfa1] set s2 [createfile tfa2 q] - set r1 [catch {file copy tfa1 tfa2}] + set result [catch {file copy tfa1 tfa2}] file copy -force tfa1 tfa2 - set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] + lappend result [checkcontent tfa2 $s] [checkcontent tfa1 $s] +} -cleanup { file delete tfa1 tfa2 - set result -} {1} +} -result {1 1 1} # # TclMacMkdir - basic cases are covered elsewhere. @@ -2101,252 +2130,256 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} { # Error cases are not covered. # -test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} { +test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup { catch {file delete -force -- tfad} - +} -constraints {notRoot} -body { file mkdir [file join tfad dir] - - set result [catch {file delete tfad}] - file delete -force tfad - set result -} {1} + + list [catch {file delete tfad}] [file delete -force tfad] +} -cleanup { + catch {file delete -force tfad} +} -result {1 {}} # -# TclMacDeleteFile +# TclMacDeleteFile # Error cases are not covered. # -test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} { +test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} -setup { catch {file delete -force -- tfa1} - +} -constraints {notRoot} -body { createfile tfa1 file delete tfa1 file exists tfa1 -} {0} +} -cleanup { + catch {file delete -force tfa1} +} -result {0} # # TclMacCopyDirectory # Error cases are not covered. # -test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} {notRoot notFileSharing} { +test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} -setup { catch {file delete -force -- tfad1 tfad2} - +} -constraints {notRoot notFileSharing} -body { file mkdir [file join tfad1 a b c] file copy tfad1 tfad2 - set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]] + list [file isdir [file join tfad1 a b c]] \ + [file isdir [file join tfad2 a b c]] +} -cleanup { file delete -force tfad1 tfad2 - set result -} {1} - -test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} { +} -result {1 1} +test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} -setup { catch {file delete -force -- tfad1 tfad2} - +} -constraints {notRoot notFileSharing} -body { file mkdir tfad1 file copy tfad1 tfad2 - set result [expr [file isdir tfad1] && [file isdir tfad2]] + list [file isdir tfad1] [file isdir tfad2] +} -cleanup { file delete tfad1 tfad2 - set result -} {1} - -test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} { +} -result {1 1} +test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup { catch {file delete -force -- tfad1 tfad2} - +} -constraints {notRoot notFileSharing} -body { file mkdir [file join tfad1 x y z] file mkdir [file join tfad2 dir] file copy tfad1 [file join tfad2 dir] - set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]] + list [file isdir [file join tfad1 x y z]] \ + [file isdir [file join tfad2 dir tfad1 x y z]] +} -cleanup { file delete -force tfad1 tfad2 - set result -} {1} +} -result {1 1} # # Functionality tests for TclDeleteFilesCmd # -test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unixOnly notRoot} { +test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup { catch {file delete -force -- tfad1 tfad2} - +} -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfalink tfad1 file delete tfalink - set r1 [file isdir tfad1] - set r2 [file exists tfalink] - - set result [expr $r1 && !$r2] + list [file isdir tfad1] [file exists tfalink] +} -cleanup { file delete tfad1 - set result -} {1} - -test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} { + catch {file delete tfalink} +} -result {1 0} +test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} -setup { catch {file delete -force -- tfad1 tfad2} - +} -constraints {unix notRoot} -body { file mkdir tfad1 file mkdir tfad2 - file link -symbolic [file join tfad2 link] tfad1 + file link -symbolic [file join tfad2 link] [file join .. tfad1] file delete -force tfad2 - set r1 [file isdir tfad1] - set r2 [file exists tfad2] - - set result [expr $r1 && !$r2] + list [file isdir tfad1] [file exists tfad2] +} -cleanup { file delete tfad1 - set result -} {1} - -test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unixOnly notRoot} { +} -result {1 0} +test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} -setup { catch {file delete -force -- tfad1 tfad2} - +} -constraints {unix notRoot} -body { file mkdir tfad1 file link -symbolic tfad2 tfad1 file delete tfad1 file delete tfad2 - set r1 [file exists tfad1] - set r2 [file exists tfad2] - - set result [expr !$r1 && !$r2] - set result -} {1} + list [file exists tfad1] [file exists tfad2] +} -result {0 0} -test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} { +test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup { set platform [testgetplatform] +} -constraints {testsetplatform} -body { testsetplatform unix - list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform] -} {1 {user "_totally_bogus_user" doesn't exist} {}} -test fCmd-27.3 {TclFileAttrsCmd - all attributes} { + file attributes ~_totally_bogus_user +} -returnCodes error -cleanup { + testsetplatform $platform +} -result {user "_totally_bogus_user" doesn't exist} +test fCmd-27.3 {TclFileAttrsCmd - all attributes} -setup { catch {file delete -force -- foo.tmp} +} -body { createfile foo.tmp - list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp] -} {0 1 {}} -test fCmd-27.4 {TclFileAttrsCmd - getting one option} { + file attributes foo.tmp + # Must be non-empty result +} -cleanup { + file delete -force -- foo.tmp +} -match glob -result {?*} +test fCmd-27.4 {TclFileAttrsCmd - getting one option} -setup { catch {file delete -force -- foo.tmp} +} -body { createfile foo.tmp set attrs [file attributes foo.tmp] - list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp] -} {0 {}} - -# Find a group that exists on this Unix system, or else skip tests that -# require Unix groups. -if {$tcl_platform(platform) == "unix"} { - ::tcltest::testConstraint foundGroup 0 - catch { - set groupList [exec groups] - set group [lindex $groupList 0] - ::tcltest::testConstraint foundGroup 1 - } -} else { - ::tcltest::testConstraint foundGroup 1 -} - -test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} { + file attributes foo.tmp {*}[lindex $attrs 0] + # Any successful result will do +} -cleanup { + file delete -force -- foo.tmp +} -match glob -result * +test fCmd-27.5 {TclFileAttrsCmd - setting one option} -setup { catch {file delete -force -- foo.tmp} +} -constraints {foundGroup} -body { createfile foo.tmp set attrs [file attributes foo.tmp] - list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp] -} {0 {} {}} -test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} { + file attributes foo.tmp {*}[lrange $attrs 0 1] +} -cleanup { + file delete -force -- foo.tmp +} -result {} +test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup { catch {file delete -force -- foo.tmp} +} -constraints {foundGroup} -body { createfile foo.tmp set attrs [file attributes foo.tmp] - list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp] -} {0 {} {}} - -if {[string equal $tcl_platform(platform) "windows"]} { - if {[string index $tcl_platform(osVersion) 0] >= 5 \ - && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} { - tcltest::testConstraint linkDirectory 1 - tcltest::testConstraint linkFile 1 - } else { - tcltest::testConstraint linkDirectory 0 - tcltest::testConstraint linkFile 0 - } -} else { - tcltest::testConstraint linkFile 1 - tcltest::testConstraint linkDirectory 1 + file attributes foo.tmp {*}[lrange $attrs 0 3] +} -cleanup { + file delete -force -- foo.tmp +} -result {} + +if { + [testConstraint win] && + ([string index $tcl_platform(osVersion) 0] < 5 + || [lindex [file system [temporaryDirectory]] 1] ne "NTFS") +} then { + testConstraint linkDirectory 0 + testConstraint linkFile 0 } -test fCmd-28.1 {file link} { - list [catch {file link} msg] $msg -} {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}} - -test fCmd-28.2 {file link} { - list [catch {file link a b c d} msg] $msg -} {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}} - -test fCmd-28.3 {file link} { - list [catch {file link abc b c} msg] $msg -} {1 {bad switch "abc": must be -symbolic or -hard}} - -test fCmd-28.4 {file link} { - list [catch {file link -abc b c} msg] $msg -} {1 {bad switch "-abc": must be -symbolic or -hard}} +test fCmd-28.1 {file link} -returnCodes error -body { + file link +} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"} +test fCmd-28.2 {file link} -returnCodes error -body { + file link a b c d +} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"} +test fCmd-28.3 {file link} -returnCodes error -body { + file link abc b c +} -result {bad switch "abc": must be -symbolic or -hard} +test fCmd-28.4 {file link} -returnCodes error -body { + file link -abc b c +} -result {bad switch "-abc": must be -symbolic or -hard} cd [workingDirectory] - makeDirectory abc.dir makeDirectory abc2.dir makeFile contents abc.file makeFile contents abc2.file - cd [temporaryDirectory] -test fCmd-28.5 {file link: source already exists} {linkDirectory} { +test fCmd-28.5 {file link: source already exists} -setup { cd [temporaryDirectory] - set res [list [catch {file link abc.dir abc2.dir} msg] $msg] +} -constraints {linkDirectory} -body { + file link abc.dir abc2.dir +} -returnCodes error -cleanup { cd [workingDirectory] - set res -} {1 {could not create new link "abc.dir": that path already exists}} - -test fCmd-28.6 {file link: unsupported operation} {linkDirectory macOrWin} { +} -result {could not create new link "abc.dir": that path already exists} +test fCmd-28.6 {file link: unsupported operation} -setup { cd [temporaryDirectory] - set res [list [catch {file link -hard abc.link abc.dir} msg] $msg] +} -constraints {linkDirectory win} -body { + file link -hard abc.link abc.dir +} -returnCodes error -cleanup { cd [workingDirectory] - set res -} {1 {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}} - -test fCmd-28.7 {file link: source already exists} {linkFile} { +} -result {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory} +test fCmd-28.7 {file link: source already exists} -setup { cd [temporaryDirectory] - set res [list [catch {file link abc.file abc2.file} msg] $msg] +} -constraints {linkFile} -body { + file link abc.file abc2.file +} -returnCodes error -cleanup { cd [workingDirectory] - set res -} {1 {could not create new link "abc.file": that path already exists}} - -test fCmd-28.8 {file link} {linkFile winOnly} { +} -result {could not create new link "abc.file": that path already exists} +test fCmd-28.8 {file link} -constraints {linkFile win} -setup { cd [temporaryDirectory] - set res [list [catch {file link -symbolic abc.link abc.file} msg] $msg] +} -body { + file link -symbolic abc.link abc.file +} -returnCodes error -cleanup { cd [workingDirectory] - set res -} {1 {could not create new link "abc.link" pointing to "abc.file": not a directory}} - -test fCmd-28.9 {file link: success with file} {linkFile} { +} -result {could not create new link "abc.link" pointing to "abc.file": not a directory} +test fCmd-28.9 {file link: success with file} -constraints {linkFile} -setup { cd [temporaryDirectory] file delete -force abc.link - set res [list [catch {file link abc.link abc.file} msg] $msg] +} -body { + file link abc.link abc.file +} -cleanup { cd [workingDirectory] - set res -} {0 abc.file} - +} -result abc.file +test fCmd-28.9.1 {file link: success with file} -setup { + cd [temporaryDirectory] + file delete -force abc.link +} -constraints {linkFile win} -body { + file stat abc.file arr + set res $arr(nlink) + lappend res [catch {file link abc.link abc.file} msg] $msg + file stat abc.file arr + lappend res $arr(nlink) +} -cleanup { + cd [workingDirectory] +} -result {1 0 abc.file 2} cd [temporaryDirectory] catch {file delete -force abc.link} cd [workingDirectory] - -test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} { +test fCmd-28.10 {file link: linking to nonexistent path} -setup { cd [temporaryDirectory] file delete -force abc.link - set res [list [catch {file link abc.link abc2.doesnt} msg] $msg] +} -constraints {linkDirectory} -body { + file link abc.link abc2.doesnt +} -returnCodes error -cleanup { cd [workingDirectory] - set res -} {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}} - -test fCmd-28.11 {file link: success with directory} {linkDirectory} { +} -result {could not create new link "abc.link": target "abc2.doesnt" doesn't exist} +test fCmd-28.10.1 {file link: linking to nonexistent path} -setup { cd [temporaryDirectory] file delete -force abc.link - set res [list [catch {file link abc.link abc.dir} msg] $msg] +} -constraints {linkDirectory} -body { + file link doesnt/abc.link abc.dir +} -returnCodes error -cleanup { cd [workingDirectory] - set res -} {0 abc.dir} - -test fCmd-28.12 {file link: cd into a link} {linkDirectory} { +} -result {could not create new link "doesnt/abc.link": no such file or directory} +test fCmd-28.11 {file link: success with directory} -setup { cd [temporaryDirectory] file delete -force abc.link +} -constraints {linkDirectory} -body { + file link abc.link abc.dir +} -cleanup { + cd [workingDirectory] +} -result abc.dir +test fCmd-28.12 {file link: cd into a link} -setup { + cd [temporaryDirectory] + file delete -force abc.link +} -constraints {linkDirectory} -body { file link abc.link abc.dir set orig [pwd] cd abc.link @@ -2354,94 +2387,140 @@ test fCmd-28.12 {file link: cd into a link} {linkDirectory} { cd .. set up [pwd] cd $orig - # now '$up' should be either $orig or [file dirname abc.dir], - # depending on whether 'cd' actually moves to the destination - # of a link, or simply treats the link as a directory. - # (on windows the former, on unix the latter, I believe) - if {([file normalize $up] != [file normalize $orig]) \ - && ([file normalize $up] != [file normalize [file dirname abc.dir]])} { - set res "wrong directory with 'cd $link ; cd ..'" + # now '$up' should be either $orig or [file dirname abc.dir], depending on + # whether 'cd' actually moves to the destination of a link, or simply + # treats the link as a directory. (On windows the former, on unix the + # latter, I believe) + if { + ([file normalize $up] ne [file normalize $orig]) && + ([file normalize $up] ne [file normalize [file dirname abc.dir]]) + } then { + return "wrong directory with 'cd abc.link ; cd ..': \ + \"[file normalize $up]\" should be \"[file normalize $orig]\"\ + or \"[file normalize [file dirname abc.dir]]\"" } else { - set res "ok" + return "ok" } +} -cleanup { cd [workingDirectory] - set res -} {ok} - -test fCmd-28.13 {file link} {linkDirectory} { - # duplicate link throws error +} -result ok +test fCmd-28.13 {file link} -constraints {linkDirectory} -setup { cd [temporaryDirectory] - set res [list [catch {file link abc.link abc.dir} msg] $msg] +} -body { + # duplicate link throws error + file link abc.link abc.dir +} -returnCodes error -cleanup { cd [workingDirectory] - set res -} {1 {could not create new link "abc.link": that path already exists}} - -test fCmd-28.14 {file link: deletes link not dir} {linkDirectory} { +} -result {could not create new link "abc.link": that path already exists} +test fCmd-28.14 {file link: deletes link not dir} -setup { cd [temporaryDirectory] +} -constraints {linkDirectory} -body { file delete -force abc.link - set res [list [file exists abc.link] [file exists abc.dir]] + list [file exists abc.link] [file exists abc.dir] +} -cleanup { cd [workingDirectory] - set res -} {0 1} - -test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} { +} -result {0 1} +test fCmd-28.15.1 {file link: copies link not dir} -setup { cd [temporaryDirectory] file delete -force abc.link +} -constraints {linkDirectory dontCopyLinks} -body { file link abc.link abc.dir file copy abc.link abc2.link - # abc2.linkdir was a copy of a link to a dir, so it should end up as - # a directory, not a link (links trace to endpoint). - set res [list [file type abc2.link] [file tail [file link abc.link]]] + # abc2.linkdir was a copy of a link to a dir, so it should end up as a + # directory, not a link (links trace to endpoint). + list [file type abc2.link] [file tail [file link abc.link]] +} -cleanup { cd [workingDirectory] - set res -} {directory abc.dir} -test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} { +} -result {directory abc.dir} +test fCmd-28.15.2 {file link: copies link not dir} -setup { cd [temporaryDirectory] file delete -force abc.link +} -constraints {linkDirectory} -body { file link abc.link abc.dir file copy abc.link abc2.link - set res [list [file type abc2.link] [file tail [file link abc2.link]]] + list [file type abc2.link] [file tail [file link abc2.link]] +} -cleanup { cd [workingDirectory] - set res -} {link abc.dir} - +} -result {link abc.dir} cd [temporaryDirectory] file delete -force abc.link file delete -force abc2.link - +cd abc.dir +file delete -force abc.file +file delete -force abc2.file +cd .. file copy abc.file abc.dir file copy abc2.file abc.dir cd [workingDirectory] - -test fCmd-28.16 {file link: glob inside link} {linkDirectory} { +test fCmd-28.16 {file link: glob inside link} -setup { cd [temporaryDirectory] file delete -force abc.link +} -constraints {linkDirectory} -body { file link abc.link abc.dir - set res [lsort [glob -dir abc.link -tails *]] + lsort [glob -dir abc.link -tails *] +} -cleanup { cd [workingDirectory] - set res -} [lsort [list abc.file abc2.file]] - -test fCmd-28.17 {file link: glob -type l} {linkDirectory} { +} -result {abc.file abc2.file} +test fCmd-28.17 {file link: glob -type l} -setup { cd [temporaryDirectory] - set res [glob -dir [pwd] -type l -tails abc*] +} -constraints {linkDirectory} -body { + glob -dir [pwd] -type l -tails abc* +} -cleanup { cd [workingDirectory] - set res -} {abc.link} - -test fCmd-28.18 {file link: glob -type d} {linkDirectory} { +} -result {abc.link} +test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup { + cd [temporaryDirectory] +} -body { + lsort [glob -dir [pwd] -type d -tails abc*] +} -cleanup { + cd [workingDirectory] +} -result [lsort [list abc.link abc.dir abc2.dir]] +test fCmd-28.19 {file link: relative paths} -setup { + cd [temporaryDirectory] +} -constraints {win linkDirectory} -body { + file mkdir d1/d2/d3 + file link d1/l2 d1/d2 +} -cleanup { + catch {file delete -force d1} + cd [workingDirectory] +} -result d1/d2 +test fCmd-28.20 {file link: relative paths} -setup { + cd [temporaryDirectory] +} -constraints {unix linkDirectory} -body { + file mkdir d1/d2/d3 + file link d1/l2 d1/d2 +} -returnCodes error -cleanup { + catch {file delete -force d1} + cd [workingDirectory] +} -result {could not create new link "d1/l2": target "d1/d2" doesn't exist} +test fCmd-28.21 {file link: relative paths} -setup { + cd [temporaryDirectory] +} -constraints {unix linkDirectory} -body { + file mkdir d1/d2/d3 + file link d1/l2 d2 +} -cleanup { + catch {file delete -force d1} + cd [workingDirectory] +} -result d2 +test fCmd-28.22 {file link: relative paths} -setup { cd [temporaryDirectory] - set res [lsort [glob -dir [pwd] -type d -tails abc*]] +} -constraints {unix linkDirectory} -body { + file mkdir d1/d2/d3 + catch {file delete -force d1/l2} + file link d1/l2 d2/d3 +} -cleanup { + catch {file delete -force d1} cd [workingDirectory] - set res -} [lsort [list abc.link abc.dir abc2.dir]] +} -result d2/d3 -test fCmd-29.1 {weird memory corruption fault} { - catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]} -} 1 +test fCmd-29.1 {weird memory corruption fault} -body { + open [file join ~a_totally_bogus_user_id/foo bar] +} -returnCodes error -match glob -result * cd [temporaryDirectory] file delete -force abc.link +file delete -force d1/d2 +file delete -force d1 cd [workingDirectory] removeFile abc2.file @@ -2449,6 +2528,27 @@ removeFile abc.file removeDirectory abc2.dir removeDirectory abc.dir +test fCmd-30.1 {file writable on 'My Documents'} -constraints {win 2000orNewer} -body { + set mydocsname "~/My Documents" + # Would be good to localise this name, since this test will only function + # on english-speaking windows otherwise + if {[file exists $mydocsname]} { + return [file writable $mydocsname] + } + return 1 +} -result {1} +test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win 2000orNewer knownBug} -body { + # Apparently the OS has this file open with exclusive permissions Windows + # doesn't provide any way to determine that fact without actually trying + # to open the file (open NTUSER.dat r), which fails. Hence this isn't + # really a knownBug in Tcl, but an OS limitation. But, perhaps in the + # future that limitation will be lifted. + if {[file exists "~/NTUSER.DAT"]} { + return [file readable "~/NTUSER.DAT"] + } + return 0 +} -result {0} + # cleanup cleanup ::tcltest::cleanupTests |