diff options
Diffstat (limited to 'tests/fCmd.test')
| -rw-r--r-- | tests/fCmd.test | 908 |
1 files changed, 361 insertions, 547 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test index 2469762..2860001 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -4,49 +4,28 @@ # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # -# Copyright © 1996-1997 Sun Microsystems, Inc. -# Copyright © 1999 Scriptics Corporation. +# 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. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 namespace import -force ::tcltest::* } -::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] - cd [temporaryDirectory] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testchmod [llength [info commands testchmod]] -testConstraint winLessThan10 0 +testConstraint winVista 0 +testConstraint win2000orXP 0 +testConstraint winOlderThan2000 0 # Don't know how to determine this constraint correctly testConstraint notNetworkFilesystem 0 -testConstraint reg 0 -if {[testConstraint win]} { - if {[catch { - # Is the registry extension already static to this shell? - try { - load {} Registry - set ::reglib {} - } on error {} { - # try the location given to use on the commandline to tcltest - ::tcltest::loadTestedCommands - load $::reglib Registry - } - testConstraint reg 1 - } regError]} { - catch {package require registry; testConstraint reg 1} - } -} - -testConstraint notInCIenv [expr {![info exists ::env(CI)] || !$::env(CI)}] - -# File permissions broken on wsl without some "exotic" wsl configuration -testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] +testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}] +testConstraint 2000orNewer [expr {![testConstraint 95or98]}] set tmpspace /tmp;# default value # Find a group that exists on this Unix system, or else skip tests that @@ -70,24 +49,31 @@ if {[testConstraint unix]} { } # Also used in winFCmd... -if {[testConstraint win] && $::tcl_platform(osVersion) < 10.0} { - testConstraint winLessThan10 1 +if {[testConstraint winOnly]} { + set major [string index $tcl_platform(osVersion) 0] + if {[testConstraint nt] && $major > 4} { + if {$major > 5} { + testConstraint winVista 1 + } elseif {$major == 5} { + testConstraint win2000orXP 1 + } + } else { + testConstraint winOlderThan2000 1 + } } -testConstraint darwin9 [expr { - [testConstraint unix] - && $tcl_platform(os) eq "Darwin" - && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9] -}] +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 notContinuousIntegration [expr {![info exists ::env(CI)]}] testConstraint fileSharing 0 testConstraint notFileSharing 1 testConstraint linkFile 1 testConstraint linkDirectory 1 -# Several tests require need to match results against the Unix username +# Several tests require need to match results against the unix username set user {} if {[testConstraint unix]} { catch { @@ -103,45 +89,6 @@ if {[testConstraint unix]} { } } -# Try getting a lower case glob pattern that will match the home directory of -# a given user to test ~user and [file tildeexpand ~user]. Note this may not -# be the same as ~ even when "user" is current user. For example, on Unix -# platforms ~ will return HOME envvar, but ~user will lookup password file -# bypassing HOME. If home directory not found, returns *$user* so caller can -# succeed by using glob matching under the hope that the path contains -# the user name. -proc gethomedirglob {user} { - if {[testConstraint unix]} { - if {![catch { - exec {*}[auto_execok sh] -c "echo ~$user" - } home]} { - set home [string trim $home] - if {$home ne ""} { - # Expect exact match (except case), no glob * added - return [string tolower $home] - } - } - } elseif {[testConstraint reg]} { - # Windows with registry extension loaded - if {![catch { - set sid [exec {*}[auto_execok powershell] -Command "(Get-LocalUser -Name '$user')\[0\].sid.Value"] - set sid [string trim $sid] - # Get path from the Windows registry - set home [registry get "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList\\$sid" ProfileImagePath] - set home [string trim [string tolower $home]] - } result]} { - if {$home ne ""} { - # file join for \ -> / - return [file join [string tolower $home]] - } - } - } - - # Caller will need to use glob matching and hope user - # name is in the home directory path - return *[string tolower $user]* -} - proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string @@ -156,18 +103,18 @@ proc createfile {file {string a}} { # if the file does not exist, or has a different content # proc checkcontent {file matchString} { - try { + if {[catch { set f [open $file] set fileString [read $f] close $f - } on error {} { + }]} { return 0 } return [string match $matchString $fileString] } proc openup {path} { - testchmod 0o777 $path + testchmod 777 $path if {[file isdirectory $path]} { catch { foreach p [glob -directory $path *] { @@ -206,8 +153,8 @@ proc contents {file} { 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 +# A really long file name +# length of long is 1216 chars, which should be greater than any static buffer # or allowable filename. set long "abcdefghihjllmnopqrstuvwxyz01234567890" @@ -216,29 +163,27 @@ append long $long append long $long append long $long append long $long - -test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup { + +test fCmd-1.1 {TclFileRenameCmd} {notRoot} { cleanup -} -body { createfile tf1 file rename tf1 tf2 glob tf* -} -result {tf2} +} {tf2} -test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup { +test fCmd-2.1 {TclFileCopyCmd} {notRoot} { cleanup -} -body { createfile tf1 file copy tf1 tf2 lsort [glob tf*] -} -result {tf1 tf2} +} {tf1 tf2} test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body { file rename -xyz -} -returnCodes error -result {bad option "-xyz": must be -force or --} +} -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 ?-option value ...? source ?source ...? target"} +} -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} @@ -276,31 +221,27 @@ test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup { } -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} -constraints notRoot -setup { +test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} { cleanup -} -body { createfile tf1 tf1 file rename tf1 tf2 contents tf2 -} -result {tf1} -test fCmd-3.11 {FileCopyRename: just 2 arguments} -constraints notRoot -setup { +} {tf1} +test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} { cleanup -} -body { createfile tf1 tf1 file rename -force -force -- tf1 tf2 contents tf2 -} -result {tf1} -test fCmd-3.12 {FileCopyRename: move each source: 1 source} -setup { +} {tf1} +test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} { cleanup -} -constraints {notRoot} -body { createfile tf1 tf1 file mkdir td1 file rename tf1 td1 contents [file join td1 tf1] -} -result {tf1} -test fCmd-3.13 {FileCopyRename: move each source: multiple sources} -setup { +} {tf1} +test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} { cleanup -} -constraints {notRoot} -body { createfile tf1 tf1 createfile tf2 tf2 createfile tf3 tf3 @@ -309,19 +250,19 @@ test fCmd-3.13 {FileCopyRename: move each source: multiple sources} -setup { file rename tf1 tf2 tf3 tf4 td1 list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \ [contents [file join td1 tf3]] [contents [file join td1 tf4]] -} -result {tf1 tf2 tf3 tf4} +} {tf1 tf2 tf3 tf4} test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { file mkdir td1 file rename ~_totally_bogus_user td1 } -result {user "_totally_bogus_user" doesn't exist} -test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup { +test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup { cleanup -} -constraints {notRoot unixOrWin} -returnCodes error -body { +} -constraints {notRoot unixOrPc} -returnCodes error -body { file mkdir td1 file rename / td1 -} -result {error renaming "/" to "td1": file exists} +} -result {error renaming "/" to "td1": file already exists} test fCmd-3.16 {FileCopyRename: break on first error} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -332,79 +273,72 @@ test fCmd-3.16 {FileCopyRename: break on first error} -setup { file mkdir td1 createfile [file join td1 tf3] file rename tf1 tf2 tf3 tf4 td1 -} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file exists}] +} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}] -test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup { +test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} { cleanup -} -constraints {notRoot} -body { file mkdir td1 glob td* -} -result {td1} -test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} -setup { +} {td1} +test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} { cleanup -} -constraints {notRoot} -body { file mkdir td1 td2 td3 lsort [glob td*] -} -result {td1 td2 td3} -test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} -setup { +} {td1 td2 td3} +test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} { cleanup -} -constraints {notRoot} -body { createfile tf1 catch {file mkdir td1 td2 tf1 td3 td4} glob td1 td2 tf1 td3 td4 -} -result {td1 td2 tf1} +} {td1 td2 tf1} test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup { cleanup } -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 == '\x00'} -setup { +test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setup { cleanup } -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} -setup { +test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} { cleanup -} -constraints {notRoot} -body { file mkdir td1 glob td1 -} -result {td1} -test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} -setup { +} {td1} +test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} { cleanup -} -constraints {notRoot} -body { file mkdir [file join td1 td2 td3 td4] glob td1 [file join td1 td2] -} -result "td1 [file join td1 td2]" -test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} -setup { +} "td1 [file join td1 td2]" +test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} { cleanup -} -constraints {notRoot} -body { file mkdir td1 set x [file exists td1] file mkdir td1 list $x [file exists td1] -} -result {1 1} +} {1 1} test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 file mkdir tf1 -} -result [subst {can't create directory "[file join tf1]": file exists}] -test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup { +} -result [subst {can't create directory "[file join tf1]": file already exists}] +test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} { cleanup -} -constraints {notRoot} -body { file mkdir td1 set x [file exists td1] file mkdir td1 list $x [file exists td1] -} -result {1 1} +} {1 1} test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup { cleanup -} -constraints {unix notRoot testchmod notWsl} -returnCodes error -body { +} -constraints {unix notRoot testchmod} -returnCodes error -body { file mkdir td1/td2/td3 - testchmod 0 td1/td2 + testchmod 000 td1/td2 file mkdir td1/td2/td3/td4 } -cleanup { - testchmod 0o755 td1/td2 + testchmod 755 td1/td2 cleanup } -result {can't create directory "td1/td2/td3": permission denied} test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup { @@ -417,77 +351,70 @@ test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup { test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup { cleanup file delete -force foo -} -constraints {unix notRoot notWsl} -body { +} -constraints {unix notRoot} -body { file mkdir foo - file attr foo -perm 0o40000 + file attr foo -perm 040000 file mkdir foo/tf1 } -returnCodes error -cleanup { file delete -force foo } -result {can't create directory "foo/tf1": permission denied} -test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup { +test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} { cleanup -} -constraints {notRoot} -body { file mkdir tf1 file exists tf1 -} -result 1 +} {1} test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body { file delete -xyz -} -returnCodes error -result {bad option "-xyz": must be -force or --} -test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body { +} -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 -} -result {} -test fCmd-5.3 {TclFileDeleteCmd: 1 file} -constraints {notRoot} -setup { +} -returnCodes error -result {wrong # args: should be "file delete ?options? file ?file ...?"} +test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} { cleanup -} -body { createfile tf1 createfile tf2 file mkdir td1 file delete tf2 glob tf* td* -} -result {tf1 td1} -test fCmd-5.4 {TclFileDeleteCmd: multiple files} -constraints notRoot -setup { +} {tf1 td1} +test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} { cleanup -} -body { createfile tf1 createfile tf2 file mkdir td1 set x [list [file exists tf1] [file exists tf2] [file exists td1]] file delete tf1 td1 tf2 lappend x [file exists tf1] [file exists tf2] [file exists tf3] -} -cleanup {cleanup} -result {1 1 1 0 0 0} -test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup { +} {1 1 1 0 0 0} +test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} { cleanup -} -constraints {notRoot unixOrWin notWine} -body { createfile tf1 createfile tf2 file mkdir td1 catch {file delete tf1 td1 $root tf2} list [file exists tf1] [file exists tf2] [file exists td1] -} -cleanup {cleanup} -result {0 1 0} +} {0 1 0} 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} -setup { +test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} { catch {file delete ~/tf1} -} -constraints {notRoot} -body { createfile ~/tf1 file delete ~/tf1 -} -result {} -test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} -setup { +} {} +test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} { cleanup -} -constraints {notRoot} -body { set x [file exists tf1] file delete tf1 list $x [file exists tf1] -} -result {0 0} -test fCmd-5.9 {TclFileDeleteCmd: is directory} -constraints {notRoot} -setup { +} {0 0} +test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} { cleanup -} -body { file mkdir td1 file delete td1 file exists td1 -} -result {0} +} {0} test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -506,14 +433,14 @@ test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup { } -cleanup { cd $dir } -result {0 0 {}} -test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} -setup { +test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unix} { cleanup -} -constraints {unix} -body { file mkdir [file join td1 td2] + #exec chmod u-rwx [file join td1 td2] file attributes [file join td1 td2] -permissions u+rwx set res [list [catch {file delete -force td1} msg]] lappend res [file exists td1] $msg -} -result {0 0 {}} +} {0 0 {}} test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} { # can't test this, because it's caught by FileCopyRename @@ -526,59 +453,61 @@ test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup { } -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} -setup { +test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} { cleanup -} -constraints {notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* -} -result {tf2} -test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} -setup { +} {tf2} +test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} { cleanup -} -constraints {notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* -} -result {tf2} +} {tf2} test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup { cleanup -} -constraints {unix notRoot testchmod notWsl} -body { +} -constraints {unix notRoot testchmod} -body { file mkdir td1 - testchmod 0 td1 + testchmod 000 td1 createfile tf1 file rename tf1 td1 } -returnCodes error -cleanup { - testchmod 0o755 td1 + testchmod 755 td1 } -result {error renaming "tf1" to "td1/tf1": permission denied} -test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup { +test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup { + cleanup +} -constraints {win 95} -returnCodes error -body { + createfile tf1 + 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 -} -constraints {unix notRoot} -body { createfile tf1 file rename tf1 tf2 glob tf* -} -result {tf2} +} {tf2} test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 createfile tf2 file rename tf1 tf2 -} -result {error renaming "tf1" to "tf2": file exists} +} -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 file rename tf1 tf2 -} -result {error renaming "tf1" to "tf2": file exists} -test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup { +} -result {error renaming "tf1" to "tf2": file already exists} +test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} { cleanup -} -constraints {notRoot} -body { createfile tf1 createfile tf2 file rename -force tf1 tf2 glob tf* -} -result {tf2} +} {tf2} test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -605,7 +534,7 @@ test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} -setup { } -result 1 test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup { cleanup -} -constraints {notRoot notWine} -body { +} -constraints {notRoot} -body { file mkdir [file join td1 td2] createfile [file join td1 td2 tf1] file mkdir td2 @@ -614,25 +543,24 @@ test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup { [subst {error renaming "td2" to "[file join td1 td2]": file *}] test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup { cleanup -} -constraints {notRoot notWine} -returnCodes error -body { +} -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 notWine} -body { +} -constraints {notRoot} -body { file mkdir [file join td1 td2] createfile [file join td1 td2 tf1] file mkdir td2 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} -setup { +test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {xdev notRoot} { cleanup $tmpspace -} -constraints {unix notRoot} -body { createfile tf1 file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf1] -} -result [file join $tmpspace tf1] +} [file join $tmpspace tf1] test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { catch {file delete -force c:/tcl8975@ d:/tcl8975@} } -body { @@ -645,28 +573,28 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { file delete -force c:/tcl8975@ catch {file delete -force d:/tcl8975@} } -result {d:/tcl8975@} -test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup { +test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \ + {xdev notRoot} { cleanup $tmpspace -} -constraints {unix notRoot} -body { file mkdir td1 file rename td1 $tmpspace glob -nocomplain td* [file join $tmpspace td*] -} -result [file join $tmpspace td1] -test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup { +} [file join $tmpspace td1] +test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \ + {xdev notRoot} { cleanup $tmpspace -} -constraints {unix notRoot} -body { createfile tf1 file rename tf1 $tmpspace glob -nocomplain tf* [file join $tmpspace tf*] -} -result [file join $tmpspace tf1] +} [file join $tmpspace tf1] test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace -} -constraints {xdev notRoot notWsl} -body { +} -constraints {notRoot xdev} -body { file mkdir td1/td2/td3 - file attributes td1 -permissions 0 + file attributes td1 -permissions 0000 file rename td1 $tmpspace } -returnCodes error -cleanup { - file attributes td1 -permissions 0o755 + file attributes td1 -permissions 0755 cleanup } -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$} test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { @@ -674,10 +602,10 @@ test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { } -constraints {unix notRoot} -body { file mkdir ~/td1/td2 set td1name [file join [file dirname ~] [file tail ~] td1] - file attributes $td1name -permissions 0 + file attributes $td1name -permissions 0000 file copy ~/td1 td1 } -returnCodes error -cleanup { - file attributes $td1name -permissions 0o755 + file attributes $td1name -permissions 0755 file delete -force ~/td1 } -result {error copying "~/td1": permission denied} test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup { @@ -686,10 +614,10 @@ test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup { file mkdir td2 file mkdir ~/td1 set td1name [file join [file dirname ~] [file tail ~] td1] - file attributes $td1name -permissions 0 + file attributes $td1name -permissions 0000 file copy td2 ~/td1 } -returnCodes error -cleanup { - file attributes $td1name -permissions 0o755 + file attributes $td1name -permissions 0755 file delete -force ~/td1 } -result {error copying "td2" to "~/td1/td2": permission denied} test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { @@ -697,10 +625,10 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { } -constraints {unix notRoot} -body { file mkdir ~/td1/td2 set td2name [file join [file dirname ~] [file tail ~] td1 td2] - file attributes $td2name -permissions 0 + file attributes $td2name -permissions 0000 file copy ~/td1 td1 } -returnCodes error -cleanup { - file attributes $td2name -permissions 0o755 + file attributes $td2name -permissions 0755 file delete -force ~/td1 } -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { @@ -710,15 +638,15 @@ test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { file mkdir [file join $tmpspace td1] createfile [file join $tmpspace td1 tf1] file rename -force td1 $tmpspace -} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file exists} +} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists} test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace -} -constraints {notRoot xdev notWsl} -body { +} -constraints {notRoot xdev} -body { file mkdir td1/td2/td3 - file attributes td1/td2/td3 -permissions 0 + file attributes td1/td2/td3 -permissions 0000 file rename td1 $tmpspace } -returnCodes error -cleanup { - file attributes td1/td2/td3 -permissions 0o755 + file attributes td1/td2/td3 -permissions 0755 cleanup $tmpspace } -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied} test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { @@ -730,13 +658,13 @@ test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { } -result [file join $tmpspace td1 td2] test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup { cleanup $tmpspace -} -constraints {unix notRoot notWsl} -body { +} -constraints {xdev notRoot} -body { file mkdir foo/bar - file attr foo -perm 0o40555 + file attr foo -perm 040555 file rename foo/bar $tmpspace } -returnCodes error -cleanup { catch {file delete [file join $tmpspace bar]} - catch {file attr foo -perm 0o40777} + catch {file attr foo -perm 040777} catch {file delete -force foo} } -match glob -result {*: permission denied} test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup { @@ -759,23 +687,22 @@ test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup { file mkdir [file join tf1 tf2] file delete tf1 } -result {error deleting "tf1": directory not empty} -test fCmd-7.2 {FileForceOption: -force} -constraints {notRoot} -setup { +test fCmd-7.2 {FileForceOption: -force} {notRoot} { cleanup -} -body { file mkdir [file join tf1 tf2] file delete -force tf1 -} -result {} -test fCmd-7.3 {FileForceOption: --} -constraints {notRoot} -body { +} {} +test fCmd-7.3 {FileForceOption: --} {notRoot} { createfile -tf1 file delete -- -tf1 -} -result {} +} {} test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup { createfile -tf1 } -body { file delete -tf1 } -returnCodes error -cleanup { file delete -- -tf1 -} -result {bad option "-tf1": must be -force or --} +} -result {bad option "-tf1": should be -force or --} test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -787,17 +714,17 @@ test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ -constraints {unix notRoot knownBug} -body { - # Labeled knownBug because it is dangerous [Bug: 3881] + # Labelled knownBug because it is dangerous [Bug: 3881] file mkdir td1 - file attr td1 -perm 0o40000 + file attr td1 -perm 040000 file rename ~$user td1 } -returnCodes error -cleanup { file delete -force td1 } -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied" test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ - -constraints {unix notRoot} -body { + {unix notRoot} { string equal [file tail ~$user] ~$user -} -result 0 +} 0 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 \ @@ -805,10 +732,10 @@ test fCmd-8.3 {file copy and path translation: ensure correct error} -body { test fCmd-9.1 {file rename: comprehensive: EACCES} -setup { cleanup -} -constraints {unix notRoot notWsl} -body { +} -constraints {unix notRoot} -body { file mkdir td1 file mkdir td2 - file attr td2 -perm 0o40000 + file attr td2 -perm 040000 file rename td1 td2/ } -returnCodes error -cleanup { file delete -force td2 @@ -824,45 +751,65 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup { } -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 - testchmod 0o444 tf2 + testchmod 444 tf2 file rename tf1 tf3 file rename tf2 tf4 list [lsort [glob tf*]] [file writable tf3] [file writable tf4] } -result {{tf3 tf4} 1 0} -test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup { +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] +} -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 notWsl} -body { +} -constraints {unix notRoot testchmod notDarwin9} -body { file mkdir td1 td2 - testchmod 0o555 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} -setup { +test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} { cleanup -} -constraints {notRoot testchmod notWine} -body { createfile tf1 tf1 createfile tf2 tf2 - testchmod 0o444 tf2 + testchmod 444 tf2 file rename -force tf1 tf1 file rename -force tf2 tf2 list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2] -} -result {tf1 tf2 1 0} -test fCmd-9.6 {file rename: comprehensive: dir to self} -setup { +} {tf1 tf2 1 0} +test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup { cleanup -} -constraints {unix notRoot testchmod notWsl} -body { +} -constraints {testchmod win2000orXP} -body { file mkdir td1 file mkdir td2 - testchmod 0o555 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.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 notWine} -body { +} -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 createfile tfs1 @@ -873,22 +820,23 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup { createfile tfd2 createfile tfd3 createfile tfd4 - testchmod 0o444 tfs3 - testchmod 0o444 tfs4 - testchmod 0o444 tfd2 - testchmod 0o444 tfd4 + testchmod 444 tfs3 + testchmod 444 tfs4 + testchmod 444 tfd2 + testchmod 444 tfd4 set msg [list [catch {file rename tf1 tf2} msg] $msg] file rename -force tfs1 tfd1 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] -} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file exists}} 1 1 0 0} +} -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. + # Under unix, you can rename a read-only directory, but you can't + # move it into another directory. + file mkdir td1 file mkdir [file join td2 td1] file mkdir tds1 @@ -900,11 +848,11 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup { file mkdir [file join tdd3 tds3] file mkdir [file join tdd4 tds4] if {![testConstraint unix]} { - testchmod 0o555 tds3 - testchmod 0o555 tds4 + testchmod 555 tds3 + testchmod 555 tds4 } - testchmod 0o555 [file join tdd2 tds2] - testchmod 0o555 [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 @@ -919,79 +867,89 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup { } list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \ [file writable [file join tdd2 tds2]] $w3 $w4 -} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file exists}} 1 1 0 0}] +} -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 notWine} -body { +} -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])} { + 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] - set w2 0 + if {[testConstraint unix] || [testConstraint winVista]} { + set w2 0 + } else { + set w2 [file writable tds2] + } list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2 } -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} -setup { +test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} { cleanup -} -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 file mkdir td1 - testchmod 0o444 tf2 + testchmod 444 tf2 file rename tf1 [file join td1 tf3] file rename tf2 [file join td1 tf4] list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] -} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] -test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { +} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] +test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} { cleanup -} -constraints {notRoot testchmod} -body { file mkdir td1 file mkdir td2 file mkdir td3 + if {!([testConstraint unix] || [testConstraint winVista])} { + testchmod 555 td2 + } file rename td1 [file join td3 td3] file rename td2 [file join td3 td4] - set w4 0 + 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 -} -result [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] +} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] 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] - testchmod 0o555 [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 list [file exists td3] [file exists [file join td4 td3 td4]] \ [catch {file rename td1 td2} msg] $msg } -cleanup { - testchmod 0o755 [file join td2 td1] -} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file exists}}] + 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 notWine} -body { +} -constraints {notRoot} -body { file mkdir [file join td1 td2] [file join td2 td1 td4] 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} -setup { +test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} { cleanup -} -constraints {notRoot notWine} -body { file mkdir td1 list [glob td*] [list [catch {file rename td1 td1} msg] $msg] -} -result [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.14.1 {file rename: comprehensive: dir into self} -setup { +} [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.14.1 {file rename: comprehensive: dir into self} {notRoot} { cleanup -} -constraints {notRoot} -body { file mkdir td1 file rename td1 td1x file rename td1x td1 set msg "ok" -} -result {ok} +} {ok} test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup { cleanup set dir [pwd] @@ -1034,49 +992,47 @@ test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup { } -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} -setup { +test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} { cleanup -} -constraints {notRoot testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 - testchmod 0o444 tf2 + testchmod 444 tf2 file copy tf1 tf3 file copy tf2 tf4 list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] -} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} +} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup { cleanup -} -constraints {unix notRoot testchmod notWsl} -body { +} -constraints {notRoot unix testchmod} -body { file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] - testchmod 0o555 td2 + testchmod 555 td2 file copy td1 td3 file copy td2 td4 list [lsort [glob td*]] [glob -directory td3 t*] \ [glob -directory td4 t*] [file writable td3] [file writable td4] } -cleanup { - testchmod 0o755 td2 - testchmod 0o755 td4 + 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 {win notRoot testchmod} -body { +} -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 0o555 td2 - testchmod 0o555 td2/tdy; # Above line removes inherited perms. So restore. + testchmod 555 td2 file copy td1 td3 file copy td2 td4 list [lsort [glob td*]] [glob -directory td3 t*] \ [glob -directory td4 t*] [file writable td3] [file writable td4] } -cleanup { - testchmod 0o755 td2 - testchmod 0o755 td4 + testchmod 755 td2 + testchmod 755 td4 } -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 notWine} -body { +} -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 createfile tfs1 @@ -1087,26 +1043,17 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup { createfile tfd2 createfile tfd3 createfile tfd4 - if {$::tcl_platform(platform) eq "windows"} { - # On Windows testchmode will attach an ACL which file copy cannot handle - # so use good old attributes which file copy does understand - file attribute tfs3 -readonly 1 - file attribute tfs4 -readonly 1 - file attribute tfd2 -readonly 1 - file attribute tfd4 -readonly 1 - } else { - testchmod 0o444 tfs3 - testchmod 0o444 tfs4 - testchmod 0o444 tfd2 - testchmod 0o444 tfd4 - } + testchmod 444 tfs3 + testchmod 444 tfs4 + testchmod 444 tfd2 + testchmod 444 tfd4 set msg [list [catch {file copy tf1 tf2} msg] $msg] file copy -force tfs1 tfd1 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] -} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file exists}} 1 1 0 0} +} -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 { @@ -1120,36 +1067,36 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup { file mkdir [file join tdd2 tds2] file mkdir [file join tdd3 tds3] file mkdir [file join tdd4 tds4] - testchmod 0o555 tds3 - testchmod 0o555 tds4 - testchmod 0o555 [file join tdd2 tds2] - testchmod 0o555 [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 -} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file exists}} 1 1 1}] +} -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 unixOrWin testchmod notWsl} -body { +} -constraints {notRoot unixOrPc testchmod} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] - testchmod 0o555 tds2 + testchmod 555 tds2 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] -} -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file exists}} 1 0}] +} -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 - testchmod 0o444 tf2 + testchmod 444 tf2 file copy tf1 [file join td1 tf3] file copy tf2 [file join td1 tf4] list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \ @@ -1157,11 +1104,11 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup { } -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 {unix notRoot testchmod notWsl} -body { +} -constraints {notRoot unix testchmod} -body { file mkdir td1 file mkdir td2 file mkdir td3 - testchmod 0o555 td2 + testchmod 555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ @@ -1169,12 +1116,12 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup { } -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 {win notRoot testchmod} -body { +} -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 - testchmod 0o555 td2 + testchmod 555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ @@ -1210,7 +1157,7 @@ cleanup # old tests -test fCmd-11.1 {TclFileRenameCmd: -- option} -constraints notRoot -setup { +test fCmd-11.1 {TclFileRenameCmd: -- option } -constraints notRoot -setup { catch {file delete -force -- -tfa1} } -body { set s [createfile -tfa1] @@ -1219,7 +1166,7 @@ test fCmd-11.1 {TclFileRenameCmd: -- option} -constraints notRoot -setup { } -cleanup { file delete tfa2 } -result {1 0} -test fCmd-11.2 {TclFileRenameCmd: bad option} -constraints notRoot -setup { +test fCmd-11.2 {TclFileRenameCmd: bad option } -constraints notRoot -setup { catch {file delete -force -- tfa1} } -body { set s [createfile tfa1] @@ -1228,9 +1175,9 @@ test fCmd-11.2 {TclFileRenameCmd: bad option} -constraints notRoot -setup { } -cleanup { file delete tfa1 } -result {1 1 0} -test fCmd-11.3 {TclFileRenameCmd: bad \# args} -returnCodes error -body { - file rename -- -} -match glob -result * +test fCmd-11.3 {TclFileRenameCmd: bad \# args} { + catch {file rename -- } +} {1} test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} -setup { set temp $::env(HOME) } -constraints notRoot -body { @@ -1249,7 +1196,7 @@ test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup { catch {file rename tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 -} -result 1 +} -result {1} test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup { catch {file delete -force -- tfa1 tfad} } -constraints {notRoot} -body { @@ -1294,7 +1241,7 @@ test fCmd-12.1 {renamefile: source filename translation failing} -setup { catch {file rename ~/tfa1 tfa2} } -cleanup { set ::env(HOME) $temp -} -result 1 +} -result {1} test fCmd-12.2 {renamefile: src filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { @@ -1306,7 +1253,7 @@ test fCmd-12.2 {renamefile: src filename translation failing} -setup { } -cleanup { set ::env(HOME) $temp file delete -force tfad -} -result 1 +} -result {1} test fCmd-12.3 {renamefile: stat failing on source} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { @@ -1351,21 +1298,21 @@ test fCmd-12.7 {renamefile: renaming directory into offspring} -setup { catch {file rename tfad tfad/dir} } -cleanup { file delete -force tfad -} -result 1 +} -result {1} test fCmd-12.8 {renamefile: generic error} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot notWsl} -body { +} -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/dir - file attributes tfa -permissions 0o555 + file attributes tfa -permissions 0555 catch {file rename tfa/dir tfa2} } -cleanup { - catch {file attributes tfa -permissions 0o777} + catch {file attributes tfa -permissions 0777} file delete -force tfa -} -result 1 +} -result {1} test fCmd-12.9 {renamefile: moving a file across volumes} -setup { cleanup $tmpspace -} -constraints {unix notRoot} -body { +} -constraints {xdev notRoot} -body { set s [createfile tfa] file rename tfa $tmpspace list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa] @@ -1413,9 +1360,9 @@ test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup { } -cleanup { file delete tfa1 } -result {1 1 0} -test fCmd-13.4 {TclCopyFilesCmd: bad \# args} -constraints {notRoot} -body { - file copy -- -} -returnCodes error -match glob -result * +test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} { + catch {file copy -- } +} {1} test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup { set temp $::env(HOME) } -body { @@ -1424,7 +1371,7 @@ test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup { catch { file copy tfa ~/foobar } } -cleanup { set ::env(HOME) $temp -} -result 1 +} -result {1} test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} } -constraints {notRoot} -body { @@ -1434,7 +1381,7 @@ test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup { catch {file copy tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 -} -result 1 +} -result {1} test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup { catch {file delete -force -- tfa1 tfad} } -constraints {notRoot} -body { @@ -1448,8 +1395,8 @@ test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup { 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] + set s1 [createfile tfa1 ] + set s2 [createfile tfa2 ] file mkdir tfad file copy tfa1 tfa2 tfad list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \ @@ -1480,7 +1427,7 @@ test fCmd-14.1 {copyfile: source filename translation failing} -setup { catch {file copy ~/tfa1 tfa2} } -cleanup { set ::env(HOME) $temp -} -result 1 +} -result {1} test fCmd-14.2 {copyfile: dst filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { @@ -1501,7 +1448,7 @@ test fCmd-14.3 {copyfile: stat failing on source} -setup { test fCmd-14.4 {copyfile: error copying file to directory} -setup { catch {file delete -force -- tfa tfad} } -constraints {notRoot} -body { - set s1 [createfile tfa] + set s1 [createfile tfa ] file mkdir tfad file mkdir tfad/tfa list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \ @@ -1541,14 +1488,14 @@ test fCmd-14.7 {copyfile: copy directory succeeding} -setup { } -result {1 1} test fCmd-14.8 {copyfile: copy directory failing} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot notWsl} -body { +} -constraints {unix notRoot} -body { file mkdir tfa/dir/a/b/c - file attributes tfa/dir -permissions 0 + file attributes tfa/dir -permissions 0000 catch {file copy tfa tfa2} } -cleanup { - file attributes tfa/dir -permissions 0o777 + file attributes tfa/dir -permissions 0777 file delete -force tfa tfa2 -} -result 1 +} -result {1} # # Coverage tests for TclMkdirCmd() @@ -1561,18 +1508,19 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup { catch {file mkdir ~/tfa} } -cleanup { set ::env(HOME) $temp -} -result 1 +} -result {1} # -# Can Tcl_SplitPath return argc == 0? If so them we need a test for that code. +# Can Tcl_SplitPath return argc == 0? If so them we need a +# test for that code. # -test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup { +test fCmd-15.2 {TclMakeDirsCmd - one directory } -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { file mkdir tfa file isdirectory tfa } -cleanup { file delete tfa -} -result 1 +} -result {1} test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { @@ -1586,12 +1534,12 @@ test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup { } -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/file - file attributes tfa -permissions 0 + file attributes tfa -permissions 0000 catch {file mkdir tfa/file} } -cleanup { - file attributes tfa -permissions 0o777 + file attributes tfa -permissions 0777 file delete -force tfa -} -result 1 +} -result {1} test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { @@ -1599,7 +1547,7 @@ test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup file isdir tfa/a/b/c } -cleanup { file delete -force tfa -} -result 1 +} -result {1} test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { @@ -1623,7 +1571,7 @@ test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body { file isdir tfa } -constraints {notRoot} -cleanup { file delete tfa -} -result 1 +} -result {1} # Coverage tests for TclDeleteFilesCommand() test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup { @@ -1647,13 +1595,13 @@ test fCmd-16.3 {test bad option} -constraints {notRoot} -setup { catch {file delete -dog tfa} } -cleanup { file delete tfa -} -result 1 -test fCmd-16.4 {accept zero files (TIP 323)} -body { +} -result {1} +test fCmd-16.4 {test not enough args} -constraints {notRoot} -body { file delete -} -result {} -test fCmd-16.5 {accept zero files (TIP 323)} -body { +} -returnCodes error -match glob -result "wrong \# args: should be *" +test fCmd-16.5 {test not enough args with options} -constraints {notRoot} -body { file delete -- -} -result {} +} -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 { @@ -1662,7 +1610,7 @@ test fCmd-16.6 {delete: source filename translation failing} -setup { catch {file delete ~/tfa} } -cleanup { set ::env(HOME) $temp -} -result 1 +} -result {1} test fCmd-16.7 {remove a non-empty directory without -force} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { @@ -1671,7 +1619,7 @@ test fCmd-16.7 {remove a non-empty directory without -force} -setup { catch {file delete tfa} } -cleanup { file delete -force tfa -} -result 1 +} -result {1} test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { @@ -1680,13 +1628,13 @@ test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup { catch {file delete tfa} } -cleanup { file delete -force tfa -} -result 1 +} -result {1} test fCmd-16.9 {error while deleting file} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot notWsl} -body { +} -constraints {unix notRoot} -body { file mkdir tfa createfile tfa/a - file attributes tfa -permissions 0o555 + file attributes tfa -permissions 0555 catch {file delete tfa/a} ####### ####### If any directory in a tree that is being removed does not have @@ -1694,9 +1642,9 @@ test fCmd-16.9 {error while deleting file} -setup { ####### with "rm -rf" ####### } -cleanup { - file attributes tfa -permissions 0o777 + file attributes tfa -permissions 0777 file delete -force tfa -} -result 1 +} -result {1} test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2} } -body { @@ -1714,14 +1662,14 @@ test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup { # More coverage tests for mkpath() test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup { catch {file delete -force -- tfa1} -} -constraints {unix notRoot notWsl} -body { +} -constraints {unix notRoot} -body { file mkdir tfa1 - file attributes tfa1 -permissions 0o555 + file attributes tfa1 -permissions 0555 catch {file mkdir tfa1/tfa2} } -cleanup { - file attributes tfa1 -permissions 0o777 + file attributes tfa1 -permissions 0777 file delete -force tfa1 -} -result 1 +} -result {1} test fCmd-17.2 {mkdir several levels deep - relative} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { @@ -1738,11 +1686,12 @@ test fCmd-17.3 {mkdir several levels deep - absolute} -setup { file isdir $f } -cleanup { file delete $f [file join [pwd] tfa] -} -result 1 +} -result {1} # # Functionality tests for TclFileRenameCmd() # + test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \ -setup { catch {file delete -force -- tfad} @@ -1750,7 +1699,7 @@ test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \ } -constraints {notRoot} -body { file mkdir tfad/dir cd tfad/dir - set s [createfile foo] + set s [createfile foo ] file rename foo bar file rename bar ./foo file rename ./foo bar @@ -1895,11 +1844,12 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup { file mkdir tfa1 set s [createfile tfa2] file link -symbolic tfalink tfa1 + file rename tfa2 tfalink checkcontent tfa1/tfa2 $s } -cleanup { file delete -force tfa1 tfalink -} -result 1 +} -result {1} test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup { catch {file delete -force -- tfa1 tfalink} } -constraints {unix notRoot} -body { @@ -1924,15 +1874,15 @@ test fCmd-19.1 {remove empty directory} -constraints {notRoot} -setup { } -result {0} test fCmd-19.2 {rmdir error besides EEXIST} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot notWsl} -body { +} -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/a - file attributes tfa -permissions 0o555 + file attributes tfa -permissions 0555 catch {file delete tfa/a} } -cleanup { - file attributes tfa -permissions 0o777 + file attributes tfa -permissions 0777 file delete -force tfa -} -result 1 +} -result {1} test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { @@ -1946,21 +1896,23 @@ test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup { # TclUnixDeleteFile and TraversalDelete are covered by tests from the # TclDeleteFilesCmd suite # +# # # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd # -test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup { + +test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot notWsl} -body { +} -constraints {unix notRoot} -body { file mkdir tfa file mkdir tfa/a - file attributes tfa/a -permissions 00000 + file attributes tfa/a -permissions 0000 catch {file delete -force tfa} } -cleanup { - file attributes tfa/a -permissions 0o777 + file attributes tfa/a -permissions 0777 file delete -force tfa -} -result 1 +} -result {1} test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { @@ -2013,7 +1965,7 @@ test fCmd-21.4 {copy : more than one source and target is not a directory} -setu catch {file copy tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 -} -result 1 +} -result {1} test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2 tfad} } -body { @@ -2124,6 +2076,7 @@ test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} -setup { } -constraints {notRoot} -body { set s [createfile tfa1] set s2 [createfile tfa2 q] + set result [catch {file rename tfa1 tfa2}] file rename -force tfa1 tfa2 lappend result [checkcontent tfa2 $s] @@ -2138,7 +2091,7 @@ test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup { checkcontent tfa1 $s } -cleanup { file delete tfa1 -} -result 1 +} -result {1} test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup { catch {file delete -force -- d1 tfad} } -constraints {notRoot} -body { @@ -2165,6 +2118,7 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup { } -constraints {notRoot} -body { set s [createfile tfa1] set s2 [createfile tfa2 q] + set result [catch {file copy tfa1 tfa2}] file copy -force tfa1 tfa2 lappend result [checkcontent tfa2 $s] [checkcontent tfa1 $s] @@ -2181,10 +2135,12 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup { # TclMacRmdir # Error cases are not covered. # + 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] + list [catch {file delete tfad}] [file delete -force tfad] } -cleanup { catch {file delete -force tfad} @@ -2242,12 +2198,14 @@ test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup # # Functionality tests for TclDeleteFilesCmd # + 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 + list [file isdir tfad1] [file exists tfalink] } -cleanup { file delete tfad1 @@ -2260,6 +2218,7 @@ test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} -setup { file mkdir tfad2 file link -symbolic [file join tfad2 link] [file join .. tfad1] file delete -force tfad2 + list [file isdir tfad1] [file exists tfad2] } -cleanup { file delete tfad1 @@ -2271,10 +2230,10 @@ test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} -setup { file link -symbolic tfad2 tfad1 file delete tfad1 file delete tfad2 + list [file exists tfad1] [file exists tfad2] } -result {0 0} -# There is no fCmd-27.1 test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup { set platform [testgetplatform] } -constraints {testsetplatform} -body { @@ -2323,7 +2282,7 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup { if { [testConstraint win] && - ($::tcl_platform(osVersion) < 5.0 + ([string index $tcl_platform(osVersion) 0] < 5 || [lindex [file system [temporaryDirectory]] 1] ne "NTFS") } then { testConstraint linkDirectory 0 @@ -2338,10 +2297,10 @@ test fCmd-28.2 {file link} -returnCodes error -body { } -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 option "abc": must be -symbolic or -hard} +} -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 option "-abc": must be -symbolic or -hard} +} -result {bad switch "-abc": must be -symbolic or -hard} cd [workingDirectory] makeDirectory abc.dir makeDirectory abc2.dir @@ -2361,7 +2320,7 @@ test fCmd-28.6 {file link: unsupported operation} -setup { file link -hard abc.link abc.dir } -returnCodes error -cleanup { cd [workingDirectory] -} -result {could not create new link "abc.link" pointing to "abc.dir": is a directory} +} -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] } -constraints {linkFile} -body { @@ -2369,15 +2328,13 @@ test fCmd-28.7 {file link: source already exists} -setup { } -returnCodes error -cleanup { cd [workingDirectory] } -result {could not create new link "abc.file": that path already exists} -# In Windows 10 developer mode, we _can_ create symbolic links to files! -test fCmd-28.8 {file link} -constraints {linkFile winLessThan10} -setup { +test fCmd-28.8 {file link} -constraints {linkFile win} -setup { cd [temporaryDirectory] } -body { file link -symbolic abc.link abc.file -} -cleanup { - file delete -force abc.link +} -returnCodes error -cleanup { cd [workingDirectory] -} -returnCodes error -result {could not create new link "abc.link" pointing to "abc.file": invalid argument} +} -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 @@ -2420,7 +2377,7 @@ test fCmd-28.10.1 {file link: linking to nonexistent path} -setup { test fCmd-28.11 {file link: success with directory} -setup { cd [temporaryDirectory] file delete -force abc.link -} -constraints {linkDirectory notWine} -body { +} -constraints {linkDirectory} -body { file link abc.link abc.dir } -cleanup { cd [workingDirectory] @@ -2428,7 +2385,7 @@ test fCmd-28.11 {file link: success with directory} -setup { test fCmd-28.12 {file link: cd into a link} -setup { cd [temporaryDirectory] file delete -force abc.link -} -constraints {linkDirectory notWine} -body { +} -constraints {linkDirectory} -body { file link abc.link abc.dir set orig [pwd] cd abc.link @@ -2436,9 +2393,9 @@ test fCmd-28.12 {file link: cd into a link} -setup { cd .. set up [pwd] cd $orig - # Now '$up' should be either $orig or [file dirname abc.dir], depending on + # 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 + # treats the link as a directory. (On windows the former, on unix the # latter, I believe) if { ([file normalize $up] ne [file normalize $orig]) && @@ -2454,7 +2411,7 @@ test fCmd-28.12 {file link: cd into a link} -setup { file delete -force abc.link cd [workingDirectory] } -result ok -test fCmd-28.13 {file link} -constraints {linkDirectory notWine} -setup { +test fCmd-28.13 {file link} -constraints {linkDirectory} -setup { cd [temporaryDirectory] file link abc.link abc.dir } -body { @@ -2488,7 +2445,7 @@ test fCmd-28.15.1 {file link: copies link not dir} -setup { test fCmd-28.15.2 {file link: copies link not dir} -setup { cd [temporaryDirectory] file delete -force abc.link -} -constraints {linkDirectory notWine} -body { +} -constraints {linkDirectory} -body { file link abc.link abc.dir file copy abc.link abc2.link list [file type abc2.link] [file tail [file link abc2.link]] @@ -2509,7 +2466,7 @@ cd [workingDirectory] test fCmd-28.16 {file link: glob inside link} -setup { cd [temporaryDirectory] file delete -force abc.link -} -constraints {linkDirectory notWine} -body { +} -constraints {linkDirectory} -body { file link abc.link abc.dir lsort [glob -dir abc.link -tails *] } -cleanup { @@ -2519,13 +2476,13 @@ test fCmd-28.16 {file link: glob inside link} -setup { test fCmd-28.17 {file link: glob -type l} -setup { cd [temporaryDirectory] file link abc.link abc.dir -} -constraints {linkDirectory notWine} -body { +} -constraints {linkDirectory} -body { glob -dir [pwd] -type l -tails abc* } -cleanup { file delete -force abc.link cd [workingDirectory] } -result {abc.link} -test fCmd-28.18 {file link: glob -type d} -constraints {linkDirectory notWine} -setup { +test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup { cd [temporaryDirectory] file link abc.link abc.dir } -body { @@ -2536,7 +2493,7 @@ test fCmd-28.18 {file link: glob -type d} -constraints {linkDirectory notWine} - } -result [lsort [list abc.link abc.dir abc2.dir]] test fCmd-28.19 {file link: relative paths} -setup { cd [temporaryDirectory] -} -constraints {win linkDirectory notWine} -body { +} -constraints {win linkDirectory} -body { file mkdir d1/d2/d3 file link d1/l2 d1/d2 } -cleanup { @@ -2571,37 +2528,29 @@ test fCmd-28.22 {file link: relative paths} -setup { catch {file delete -force d1} cd [workingDirectory] } -result d2/d3 -try { - cd [temporaryDirectory] - file delete -force abc.link - file delete -force d1/d2 - file delete -force d1 -} finally { - cd [workingDirectory] -} -removeFile abc2.file -removeFile abc.file -removeDirectory abc2.dir -removeDirectory abc.dir 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] + test fCmd-30.1 {file writable on 'My Documents'} -setup { # Get the localized version of the folder name by looking in the registry. set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal] } -constraints {win reg} -body { file writable $mydocsname } -result 1 -test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body { +test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body { expr {[info exists env(USERPROFILE)] && [file exists $env(USERPROFILE)/NTUSER.DAT] && [file readable $env(USERPROFILE)/NTUSER.DAT]} -} -result 1 -# At least one CI environment (GitHub Actions) is set up with the page file in -# an unusual location; skip the test if that is so. -test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notInCIenv} -body { +} -result {1} +test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win} -body { set r {} if {[info exists env(SystemDrive)]} { set path $env(SystemDrive)/pagefile.sys @@ -2612,145 +2561,10 @@ test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notInCIenv} - return $r } -result {exists 1 readable 0 stat 0 {}} -test fCmd-31.1 {file home} -body { - file home -} -result [file join $::env(HOME)] -test fCmd-31.2 {file home - obeys env} -setup { - set ::env(HOME) $::env(HOME)/xxx -} -cleanup { - set ::env(HOME) [file dirname $::env(HOME)] -} -body { - file home -} -result [file join $::env(HOME) xxx] -test fCmd-31.3 {file home - \ -> /} -constraints win -setup { - set saved $::env(HOME) - set ::env(HOME) C:\\backslash\\path -} -cleanup { - set ::env(HOME) $saved -} -body { - file home -} -result C:/backslash/path -test fCmd-31.4 {file home - error} -setup { - set saved $::env(HOME) - unset ::env(HOME) -} -cleanup { - set ::env(HOME) $saved -} -body { - file home -} -returnCodes error -result {couldn't find HOME environment variable to expand path} -test fCmd-31.5 { - file home - relative path. Following 8.x ~ expansion behavior, relative - paths are not made absolute -} -setup { - set saved $::env(HOME) - set ::env(HOME) relative/path -} -cleanup { - set ::env(HOME) $saved -} -body { - file home -} -result relative/path -test fCmd-31.6 {file home USER} -body { - # Note - as in 8.x this form does NOT necessarily give same result as - # env(HOME) even when user is current user. Assume result contains user - # name, else not sure how to check - string tolower [file home $::tcl_platform(user)] -} -match glob -result [gethomedirglob $::tcl_platform(user)] -test fCmd-31.7 {file home UNKNOWNUSER} -body { - file home nosuchuser -} -returnCodes error -result {user "nosuchuser" doesn't exist} -test fCmd-31.8 {file home extra arg} -body { - file home $::tcl_platform(user) arg -} -returnCodes error -result {wrong # args: should be "file home ?user?"} -test fCmd-31.9 {file home USER does not follow env(HOME)} -setup { - set ::env(HOME) [file join $::env(HOME) foo] -} -cleanup { - set ::env(HOME) [file dirname $::env(HOME)] -} -body { - string tolower [file home $::tcl_platform(user)] -} -match glob -result [gethomedirglob $::tcl_platform(user)] - -test fCmd-32.1 {file tildeexpand ~} -body { - file tildeexpand ~ -} -result [file join $::env(HOME)] -test fCmd-32.2 {file tildeexpand ~ - obeys env} -setup { - set ::env(HOME) $::env(HOME)/xxx -} -cleanup { - set ::env(HOME) [file dirname $::env(HOME)] -} -body { - file tildeexpand ~ -} -result [file join $::env(HOME) xxx] -test fCmd-32.3 {file tildeexpand ~ - error} -setup { - set saved $::env(HOME) - unset ::env(HOME) -} -cleanup { - set ::env(HOME) $saved -} -body { - file tildeexpand ~ -} -returnCodes error -result {couldn't find HOME environment variable to expand path} -test fCmd-32.4 { - file tildeexpand ~ - relative path. Following 8.x ~ expansion behavior, relative - paths are not made absolute -} -setup { - set saved $::env(HOME) - set ::env(HOME) relative/path -} -cleanup { - set ::env(HOME) $saved -} -body { - file tildeexpand ~ -} -result relative/path -test fCmd-32.5 {file tildeexpand ~USER} -body { - # Note - as in 8.x this form does NOT necessarily give same result as - # env(HOME) even when user is current user. Assume result contains user - # name, else not sure how to check - string tolower [file tildeexpand ~$::tcl_platform(user)] -} -match glob -result [gethomedirglob $::tcl_platform(user)] -test fCmd-32.6 {file tildeexpand ~UNKNOWNUSER} -body { - file tildeexpand ~nosuchuser -} -returnCodes error -result {user "nosuchuser" doesn't exist} -test fCmd-32.7 {file tildeexpand ~extra arg} -body { - file tildeexpand ~ arg -} -returnCodes error -result {wrong # args: should be "file tildeexpand path"} -test fCmd-32.8 {file tildeexpand ~/path} -body { - file tildeexpand ~/foo -} -result [file join $::env(HOME)/foo] -test fCmd-32.9 {file tildeexpand ~USER/bar} -body { - # Note - as in 8.x this form does NOT necessarily give same result as - # env(HOME) even when user is current user. Assume result contains user - # name, else not sure how to check - string tolower [file tildeexpand ~$::tcl_platform(user)/bar] -} -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar] -test fCmd-32.10 {file tildeexpand ~UNKNOWNUSER} -body { - file tildeexpand ~nosuchuser/foo -} -returnCodes error -result {user "nosuchuser" doesn't exist} -test fCmd-32.11 {file tildeexpand /~/path} -body { - file tildeexpand /~/foo -} -result /~/foo -test fCmd-32.12 {file tildeexpand /~user/path} -body { - file tildeexpand /~$::tcl_platform(user)/foo -} -result /~$::tcl_platform(user)/foo -test fCmd-32.13 {file tildeexpand ./~} -body { - file tildeexpand ./~ -} -result ./~ -test fCmd-32.14 {file tildeexpand relative/path} -body { - file tildeexpand relative/path -} -result relative/path -test fCmd-32.15 {file tildeexpand ~\\path} -body { - file tildeexpand ~\\foo -} -constraints win -result [file join $::env(HOME)/foo] -test fCmd-32.16 {file tildeexpand ~USER\\bar} -body { - # Note - as in 8.x this form does NOT necessarily give same result as - # env(HOME) even when user is current user. Assume result contains user - # name, else not sure how to check - string tolower [file tildeexpand ~$::tcl_platform(user)\\bar] -} -constraints win -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar] -test fCmd-32.17 {file tildeexpand ~USER does not mirror HOME} -setup { - set ::env(HOME) [file join $::env(HOME) foo] -} -cleanup { - set ::env(HOME) [file dirname $::env(HOME)] -} -body { - string tolower [file tildeexpand ~$::tcl_platform(user)] -} -match glob -result [gethomedirglob $::tcl_platform(user)] - +removeFile abc2.file +removeFile abc.file +removeDirectory abc2.dir +removeDirectory abc.dir # cleanup cleanup |