diff options
Diffstat (limited to 'contrib/tcl/tests/fCmd.test')
| -rw-r--r-- | contrib/tcl/tests/fCmd.test | 2102 |
1 files changed, 0 insertions, 2102 deletions
diff --git a/contrib/tcl/tests/fCmd.test b/contrib/tcl/tests/fCmd.test deleted file mode 100644 index ae2b8b08cf9a..000000000000 --- a/contrib/tcl/tests/fCmd.test +++ /dev/null @@ -1,2102 +0,0 @@ -# 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. -# -# Copyright (c) 1996-1997 Sun Microsystems, Inc. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# SCCS: @(#) fCmd.test 1.33 97/11/03 15:58:08 -# - -if {[string compare test [info procs test]] == 1} then {source defs} - -set platform [testgetplatform] - -if {$user == "root"} { - puts "Skipping fCmd tests. They depend on not being able to write to" - puts "certain directories. It would be too dangerous to run them as root." - return -} - -if {"[info commands testchmod]" != "testchmod"} { - puts "Skipping fCmd tests. This application does not seem to have the" - puts "testchmod command that is needed to run these tests." - return -} - -proc createfile {file {string a}} { - set f [open $file w] - puts -nonewline $f $string - close $f - 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 -# -proc checkcontent {file matchString} { - if {[catch { - set f [open $file] - set fileString [read $f] - close $f - }]} { - return 0 - } - return [string match $matchString $fileString] -} - -proc openup {path} { - testchmod 777 $path - if {[file isdirectory $path]} { - catch { - foreach p [glob [file join $path *]] { - openup $p - } - } - } -} - -proc cleanup {args} { - foreach p ". $args" { - set x "" - catch { - set x [glob [file join $p tf*] [file join $p td*]] - } - foreach file $x { - if {[catch {file delete -force -- $file}]} { - openup $file - file delete -force -- $file - } - } - } -} - -proc contents {file} { - set f [open $file r] - set r [read $f] - close $f - set r -} - -set testConfig(NT) 0 -set testConfig(95) 0 - -switch $tcl_platform(os) { - "Windows NT" {set testConfig(NT) 1} - "Windows 95" {set testConfig(95) 1} -} - -set testConfig(fileSharing) 0 -set testConfig(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 testConfig(fileSharing) 1 - set testConfig(notFileSharing) 0 - } - file delete -force foo.dir -} - -set testConfig(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 testConfig(xdev) 1 - } - } -} - -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. - -set long "abcdefghihjllmnopqrstuvwxyz01234567890" -append long $long -append long $long -append long $long -append long $long -append long $long - -test fCmd-1.1 {TclFileRenameCmd} { - cleanup - createfile tf1 - file rename tf1 tf2 - glob tf* -} {tf2} - -test fCmd-2.1 {TclFileCopyCmd} { - cleanup - createfile tf1 - file copy tf1 tf2 - lsort [glob tf*] -} {tf1 tf2} - -test fCmd-3.1 {FileCopyRename: FileForceOption fails} { - list [catch {file rename -xyz} msg] $msg -} {1 {bad option "-xyz": should be -force or --}} -test fCmd-3.2 {FileCopyRename: not enough args} { - 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} { - list [catch {file rename xyz ~nonexistantuser} msg] $msg -} {1 {user "nonexistantuser" doesn't exist}} -test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} { - 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} { - 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 directory: !S_ISDIR(target)} { - cleanup - 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} { - cleanup - 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} { - 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} { - cleanup - list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg -} {1 {error copying: target "tf3" is not a directory}} -test fCmd-3.10 {FileCopyRename: just 2 arguments} { - cleanup - createfile tf1 tf1 - file rename tf1 tf2 - contents tf2 -} {tf1} -test fCmd-3.11 {FileCopyRename: just 2 arguments} { - cleanup - createfile tf1 tf1 - file rename -force -force -- tf1 tf2 - contents tf2 -} {tf1} -test fCmd-3.12 {FileCopyRename: move each source: 1 source} { - cleanup - createfile tf1 tf1 - file mkdir td1 - file rename tf1 td1 - contents [file join td1 tf1] -} {tf1} -test fCmd-3.13 {FileCopyRename: move each source: multiple sources} { - cleanup - createfile tf1 tf1 - createfile tf2 tf2 - createfile tf3 tf3 - createfile tf4 tf4 - file mkdir td1 - 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]] -} {tf1 tf2 tf3 tf4} -test fCmd-3.14 {FileCopyRename: FileBasename fails} { - cleanup - file mkdir td1 - list [catch {file rename ~nonexistantuser td1} msg] $msg -} {1 {user "nonexistantuser" doesn't exist}} -test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {unixOrPc} { - cleanup - 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} { - cleanup - 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}}] - -test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} { - cleanup - file mkdir td1 - glob td* -} {td1} -test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} { - cleanup - file mkdir td1 td2 td3 - lsort [glob td*] -} {td1 td2 td3} -test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} { - cleanup - createfile tf1 - 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} { - cleanup - list [catch {file mkdir ~nonexistantuser} msg] $msg -} {1 {user "nonexistantuser" doesn't exist}} -test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} { - cleanup - list [catch {file mkdir ""} msg] $msg -} {1 {can't create directory "": no such file or directory}} -test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} { - cleanup - file mkdir td1 - glob td1 -} {td1} -test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} { - cleanup - file mkdir [file join td1 td2 td3 td4] - glob td1 [file join td1 td2] -} "td1 [file join td1 td2]" -test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} { - cleanup - file mkdir td1 - set x [file exist td1] - file mkdir td1 - list $x [file exist td1] -} {1 1} -test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} { - cleanup - createfile tf1 - list [catch {file mkdir tf1} msg] $msg -} [subst {1 {can't create directory "[file join tf1]": file already exists}}] -test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} { - cleanup - file mkdir td1 - set x [file exist td1] - file mkdir td1 - list $x [file exist td1] -} {1 1} -test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {unixOnly} { - cleanup - file mkdir td1/td2/td3 - testchmod 000 td1/td2 - set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg] - 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 nonexistantvolume:} msg] $msg -} {1 {can't create directory "nonexistantvolume:": invalid argument}} -test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} { - cleanup - set x [file exist td1] - file mkdir td1 - list $x [file exist td1] -} {0 1} -test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {unixOnly} { - cleanup - file delete -force foo - file mkdir foo - file attr foo -perm 040000 - set result [list [catch {file mkdir foo/tf1} msg] $msg] - 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}}] -test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} { - cleanup - file mkdir tf1 - file exists tf1 -} {1} - -test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} { - list [catch {file delete -xyz} msg] $msg -} {1 {bad option "-xyz": should be -force or --}} -test fCmd-5.2 {TclFileDeleteCmd: not enough args} { - list [catch {file delete -force -force} msg] $msg -} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}} -test fCmd-5.3 {TclFileDeleteCmd: 1 file} { - cleanup - createfile tf1 - createfile tf2 - file mkdir td1 - file delete tf2 - glob tf* td* -} {tf1 td1} -test fCmd-5.4 {TclFileDeleteCmd: multiple files} { - cleanup - createfile tf1 - createfile tf2 - file mkdir td1 - set x [list [file exist tf1] [file exist tf2] [file exist td1]] - file delete tf1 td1 tf2 - lappend x [file exist tf1] [file exist tf2] [file exist tf3] -} {1 1 1 0 0 0} -test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {unixOrPc} { - cleanup - createfile tf1 - createfile tf2 - file mkdir td1 - catch {file delete tf1 td1 $root tf2} - list [file exist tf1] [file exist tf2] [file exist td1] -} {0 1 0} -test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} { - list [catch {file delete ~nonexistantuser} msg] $msg -} {1 {user "nonexistantuser" doesn't exist}} -test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} { - catch {file delete ~/tf1} - createfile ~/tf1 - file delete ~/tf1 -} {} -test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} { - cleanup - set x [file exist tf1] - file delete tf1 - list $x [file exist tf1] -} {0 0} -test fCmd-5.9 {TclFileDeleteCmd: is directory} { - cleanup - file mkdir td1 - file delete td1 - file exist td1 -} {0} -test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} { - cleanup - file mkdir td1/td2 - list [catch {file delete td1} msg] $msg -} {1 {error deleting "td1": directory not empty}} - -test fCmd-6.1 {CopyRenameOneFile: bad source} { - # can't test this, because it's caught by FileCopyRename -} {} -test fCmd-6.2 {CopyRenameOneFile: bad target} { - # can't test this, because it's caught by FileCopyRename -} {} -test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} { - cleanup - list [catch {file rename tf1 tf2} msg] $msg -} {1 {error renaming "tf1": no such file or directory}} -test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} { - cleanup - createfile tf1 - file rename tf1 tf2 - glob tf* -} {tf2} -test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} { - cleanup - createfile tf1 - file rename tf1 tf2 - glob tf* -} {tf2} -test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly} { - cleanup - file mkdir td1 - testchmod 000 td1 - createfile tf1 - set msg [list [catch {file rename tf1 td1} msg] $msg] - testchmod 755 td1 - set msg -} {1 {error renaming "tf1" to "td1/tf1": permission denied}} -test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {95} { - 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.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} { - cleanup - createfile tf1 - file rename tf1 tf2 - glob tf* -} {tf2} -test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} { - cleanup - 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} { - cleanup - createfile tf1 - createfile tf2 - list [catch {file rename tf1 tf2} msg] $msg -} {1 {error renaming "tf1" to "tf2": file already exists}} -test fCmd-6.12 {CopyRenameOneFile: force != 0} { - cleanup - createfile tf1 - createfile tf2 - file rename -force tf1 tf2 - glob tf* -} {tf2} -test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} { - cleanup - 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} { - cleanup - 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} { - cleanup - 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} { - cleanup - 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} {!$testConfig(win32s) || ($root == "C:/")} { - # Don't run this test under Win32s on a drive mounted from an NT - # machine; it causes the NT machine to die. - - 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} { - cleanup - 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} { - cleanup /tmp - createfile tf1 - file rename tf1 /tmp - glob tf* /tmp/tf1 -} {/tmp/tf1} -test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} { - catch {file delete -force c:/tcl8975@ d:/tcl8975@} - file mkdir c:/tcl8975@ - if [catch {file rename c:/tcl8975@ d:/}] { - list d:/tcl8975@ - } else { - set msg [glob c:/tcl8975@ d:/tcl8975@] - file delete -force d:/tcl8975@ - set msg - } -} {d:/tcl8975@} -test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} {unixOnly} { - cleanup /tmp - file mkdir td1 - file rename td1 /tmp - glob td* /tmp/td* -} {/tmp/td1} -test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} {unixOnly} { - cleanup /tmp - createfile tf1 - file rename tf1 /tmp - glob tf* /tmp/tf* -} {/tmp/tf1} -test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} {unixOnly xdev} { - cleanup /tmp - file mkdir td1/td2/td3 - exec chmod 000 td1 - set msg [list [catch {file rename td1 /tmp} msg] $msg] - exec chmod 755 td1 - set msg -} {1 {error renaming "td1": permission denied}} -test fCmd-6.24 {CopyRenameOneFile: error uses original name} {unixOnly} { - cleanup - file mkdir ~/td1/td2 - exec chmod 000 [file join [file dirname ~] [file tail ~] td1] - set msg [list [catch {file copy ~/td1 td1} msg] $msg] - exec chmod 755 [file join [file dirname ~] [file tail ~] td1] - file delete -force ~/td1 - set msg -} {1 {error copying "~/td1": permission denied}} -test fCmd-6.25 {CopyRenameOneFile: error uses original name} {unixOnly} { - cleanup - file mkdir td2 - file mkdir ~/td1 - exec chmod 000 [file join [file dirname ~] [file tail ~] td1] - set msg [list [catch {file copy td2 ~/td1} msg] $msg] - exec chmod 755 [file join [file dirname ~] [file tail ~] td1] - 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} { - cleanup - file mkdir ~/td1/td2 - exec chmod 000 [file join [file dirname ~] [file tail ~] td1 td2] - set msg [list [catch {file copy ~/td1 td1} msg] $msg] - exec chmod 755 [file join [file dirname ~] [file tail ~] td1 td2] - 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 xdev} { - cleanup /tmp - 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 xdev} { - cleanup /tmp - file mkdir td1/td2/td3 - exec chmod 000 td1/td2/td3 - set msg [list [catch {file rename td1 /tmp} msg] $msg] - exec chmod 755 td1/td2/td3 - set msg -} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}} -test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} {unixOnly xdev} { - cleanup /tmp - 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} { - cleanup - file mkdir foo/bar - file attr foo -perm 040555 - set msg [list [catch {file rename foo/bar /tmp} msg] $msg] - set a1 {1 {can't unlink "foo/bar": permission denied}} - set result [expr {$msg == $a1}] - catch {file delete /tmp/bar} - catch {file attr foo -perm 040777} - catch {file delete -force foo} - set result -} {1} -test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} {unixOnly xdev} { - catch {cleanup /tmp} - 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} { - cleanup - list [catch {file copy tf1 tf2} msg] $msg -} {1 {error copying "tf1": no such file or directory}} -catch {cleanup /tmp} - -test fCmd-7.1 {FileForceOption: none} { - cleanup - file mkdir [file join tf1 tf2] - list [catch {file delete tf1} msg] $msg -} {1 {error deleting "tf1": directory not empty}} -test fCmd-7.2 {FileForceOption: -force} { - cleanup - file mkdir [file join tf1 tf2] - file delete -force tf1 -} {} -test fCmd-7.3 {FileForceOption: --} { - createfile -tf1 - file delete -- -tf1 -} {} -test fCmd-7.4 {FileForceOption: bad option} { - createfile -tf1 - set msg [list [catch {file delete -tf1} msg] $msg] - file delete -- -tf1 - set msg -} {1 {bad option "-tf1": should be -force or --}} -test fCmd-7.5 {FileForceOption: multiple times through loop} { - createfile -- - createfile -force - file delete -force -force -- -- -force - list [catch {glob -- -- -force} msg] $msg -} {1 {no files matched glob patterns "-- -force"}} - -test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} {unixOnly} { - file mkdir td1 - file attr td1 -perm 040000 - set result [list [catch {file rename ~$user td1} msg] $msg] - file delete -force td1 - set result -} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}" - -test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly} { - cleanup - file mkdir td1 - file mkdir td2 - file attr td2 -perm 040000 - set result [list [catch {file rename td1 td2/} msg] $msg] - 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} { - 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} { - cleanup - 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} { - cleanup - 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} -test fCmd-9.5 {file rename: comprehensive: file to self} { - cleanup - createfile tf1 tf1 - createfile tf2 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] -} {tf1 tf2 1 0} -test fCmd-9.6 {file rename: comprehensive: dir to self} {unixOrPc} { - cleanup - 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} { - cleanup - createfile tf1 - createfile tf2 - createfile tfs1 - createfile tfs2 - createfile tfs3 - createfile tfs4 - createfile tfd1 - createfile tfd2 - createfile tfd3 - createfile 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] -} {{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} { - # 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 - file mkdir tds2 - file mkdir tds3 - file mkdir tds4 - file mkdir [file join tdd1 tds1] - 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"} { - testchmod 555 tds3 - testchmod 555 tds4 - } - if {$tcl_platform(platform) != "macintosh"} { - 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 { - set w3 0 - set w4 0 - } - 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} { - cleanup - file mkdir tds1 - file mkdir tds2 - file mkdir [file join tdd1 tds1 xxx] - file mkdir [file join tdd2 tds2 xxx] - if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { - 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 {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { - set w2 [file writable tds2] - } else { - set w2 0 - } - 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}] -test fCmd-9.10 {file rename: comprehensive: file to new name and dir} { - cleanup - createfile tf1 - createfile tf2 - file mkdir td1 - testchmod 444 tf2 - file rename tf1 [file join td1 tf3] - file rename tf2 [file join td1 tf4] - list [catch {glob tf*}] [lsort [glob [file join td1 t*]]] \ - [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] -} [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} { - cleanup - file mkdir td1 - file mkdir td2 - file mkdir td3 - if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { - testchmod 555 td2 - } - file rename td1 [file join td3 td3] - file rename td2 [file join td3 td4] - if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { - set w4 [file writable [file join td3 td4]] - } else { - set w4 0 - } - list [lsort [glob td*]] [lsort [glob [file join 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} { - cleanup - file mkdir [file join td1 td2] [file join td2 td1] - if {$tcl_platform(platform) != "macintosh"} { - 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} { - cleanup - 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}}] -test fCmd-9.14 {file rename: comprehensive: dir into self} { - 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} { - cleanup - 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} { - cleanup - 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"}}] - -test fCmd-10.1 {file copy: comprehensive: source doesn't exist} { - cleanup - list [catch {file copy tf1 tf2} msg] $msg -} {1 {error copying "tf1": no such file or directory}} -test fCmd-10.2 {file copy: comprehensive: file to new name} { - cleanup - createfile tf1 tf1 - createfile tf2 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] -} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} -test fCmd-10.3 {file copy: comprehensive: dir to new name} {unixOrPc} { - cleanup - 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 [file join td3 t*]] \ - [glob [file join 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.4 {file copy: comprehensive: file to existing file} { - cleanup - createfile tf1 - createfile tf2 - createfile tfs1 - createfile tfs2 - createfile tfs3 - createfile tfs4 - createfile tfd1 - createfile tfd2 - createfile tfd3 - createfile 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] -} {{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} { - cleanup - file mkdir td1 - file mkdir [file join td2 td1] - file mkdir tds1 - file mkdir tds2 - file mkdir tds3 - file mkdir tds4 - file mkdir [file join tdd1 tds1] - 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] - } - 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} {unixOrPc} { - cleanup - file mkdir tds1 - file mkdir tds2 - file mkdir [file join tdd1 tds1 xxx] - file mkdir [file join tdd2 tds2 xxx] - 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] -} [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} { - cleanup - createfile tf1 - createfile tf2 - file mkdir td1 - testchmod 444 tf2 - file copy tf1 [file join td1 tf3] - file copy tf2 [file join td1 tf4] - list [lsort [glob tf*]] [lsort [glob [file join 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} {unixOrPc} { - cleanup - file mkdir td1 - file mkdir td2 - file mkdir td3 - testchmod 555 td2 - file copy td1 [file join td3 td3] - file copy td2 [file join td3 td4] - list [lsort [glob td*]] [lsort [glob [file join 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.9 {file copy: comprehensive: source and target incompatible} { - cleanup - 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} { - cleanup - 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"}}] -cleanup - -# old tests - -test fCmd-11.1 {TclFileRenameCmd: -- option } { - catch {file delete -force -- -tfa1} - set s [createfile -tfa1] - file rename -- -tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]] - file delete tfa2 - set result -} {1} - -test fCmd-11.2 {TclFileRenameCmd: bad option } { - catch {file delete -force -- tfa1} - set s [createfile tfa1] - set r1 [catch {file rename -x tfa1 tfa2}] - set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]] - file delete tfa1 - set result -} {1} - -test fCmd-11.3 {TclFileRenameCmd: bad \# args} { - catch {file rename -- } -} {1} - -test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} { - 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: more than one source and target is not a directory} { - catch {file delete -force -- tfa1 tfa2 tfa3} - createfile tfa1 - createfile tfa2 - createfile tfa3 - set result [catch {file rename tfa1 tfa2 tfa3}] - file delete tfa1 tfa2 tfa3 - set result -} {1} - -test fCmd-11.6 {TclFileRenameCmd: : single file into directory } { - catch {file delete -force -- tfa1 tfad} - set s [createfile tfa1] - file mkdir tfad - file rename tfa1 tfad - set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]] - file delete -force tfad - set result -} {1} - -test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory } { - catch {file delete -force -- tfa1 tfa2 tfad} - 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]] - - file delete -force tfad - set result -} {1} - -test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory } { - catch {file delete -force -- tfa tfad} - 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 ] - file delete -force tfa tfad - set result -} {1} - -# -# Coverage tests for renamefile() ; -# -test fCmd-12.1 {renamefile: source filename translation failing} { - 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} { - 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 - file delete -force tfad - set result -} {1} - -test fCmd-12.3 {renamefile: stat failing on source} { - 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 } { - catch {file delete -force -- tfa tfad} - 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] - file delete -force tfa tfad - set result -} {1} - -test fCmd-12.5 {renamefile: error renaming directory to file } { - catch {file delete -force -- tfa tfad} - 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 ] - file delete -force tfa tfad - set result -} {1} - -test fCmd-12.6 {renamefile: TclRenameFile succeeding } { - catch {file delete -force -- tfa1 tfa2} - set s [createfile tfa1] - file rename tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]] - file delete tfa2 - set result -} {1} - -test fCmd-12.7 {renamefile: renaming directory into offspring} { - catch {file delete -force -- tfad} - 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} { - catch {file delete -force -- tfa} - file mkdir tfa - file mkdir tfa/dir - exec chmod 555 tfa - set result [catch {file rename tfa/dir tfa2}] - exec chmod 777 tfa - file delete -force tfa - set result -} {1} - - -test fCmd-12.9 {renamefile: moving a file across volumes } {unixOnly} { - catch {file delete -force -- tfa /tmp/tfa} - set s [createfile tfa ] - file rename tfa /tmp - set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]] - file delete /tmp/tfa - set result -} {1} - -test fCmd-12.10 {renamefile: moving a directory across volumes } {unixOnly} { - catch {file delete -force -- tfad /tmp/tfad} - file mkdir tfad - set s [createfile tfad/a ] - file rename tfad /tmp - set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]] - file delete -force /tmp/tfad - set result -} {1} - -# -# Coverage tests for TclCopyFilesCmd() -# -test fCmd-13.1 {TclCopyFilesCmd: -force option } { - catch {file delete -force -- tfa1} - set s [createfile tfa1] - file copy -force tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] - file delete tfa1 tfa2 - set result -} {1} - -test fCmd-13.2 {TclCopyFilesCmd: -- option } { - catch {file delete -force -- tfa1} - set s [createfile -tfa1] - file copy -- -tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && [checkcontent -tfa1 $s]] - file delete -- -tfa1 tfa2 - set result -} {1} - -test fCmd-13.3 {TclCopyFilesCmd: bad option } { - catch {file delete -force -- tfa1} - set s [createfile tfa1] - set r1 [catch {file copy -x tfa1 tfa2}] - set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]] - file delete tfa1 - set result -} {1} - -test fCmd-13.4 {TclCopyFilesCmd: bad \# args} { - catch {file copy -- } -} {1} - -test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} { - global env - set temp $env(HOME) - unset env(HOME) - set result [catch {file copy tfa ~/foobar }] - set env(HOME) $temp - set result - } {1} - -test fCmd-13.6 {TclCopyFilesCmd: more than one source and target is not a directory} { - catch {file delete -force -- tfa1 tfa2 tfa3} - createfile tfa1 - createfile tfa2 - createfile tfa3 - set result [catch {file copy tfa1 tfa2 tfa3}] - file delete tfa1 tfa2 tfa3 - set result -} {1} - -test fCmd-13.7 {TclCopyFilesCmd: : single file into directory } { - catch {file delete -force -- tfa1 tfad} - set s [createfile tfa1] - file mkdir tfad - file copy tfa1 tfad - set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]] - file delete -force tfad tfa1 - set result -} {1} - -test fCmd-13.8 {TclCopyFilesCmd: : multiple files into directory } { - catch {file delete -force -- tfa1 tfa2 tfad} - 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 ] - - file delete -force tfad tfa1 tfa2 - set result -} {1} - -test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory } { - catch {file delete -force -- tfa tfad} - 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 ] - file delete -force tfa tfad - set result -} {1} - -# -# Coverage tests for copyfile() -# -test fCmd-14.1 {copyfile: source filename translation failing} { - 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} { - 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 - file delete -force tfa1 tfad - set result -} {1} - -test fCmd-14.3 {copyfile: stat failing on source} { - 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 } { - catch {file delete -force -- tfa tfad} - 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 ] - file delete -force tfa tfad - set result -} {1} - - test fCmd-14.5 {copyfile: error copying directory to file } { - 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 ] - file delete -force tfa tfad - set result -} {1} - -test fCmd-14.6 {copyfile: copy file succeeding } { - catch {file delete -force -- tfa tfa2} - set s [createfile tfa] - file copy tfa tfa2 - set result [expr [checkcontent tfa $s] && [checkcontent tfa2 $s]] - file delete tfa tfa2 - set result -} {1} - -test fCmd-14.7 {copyfile: copy directory succeeding } { - catch {file delete -force -- tfa tfa2} - file mkdir tfa - set s [createfile tfa/file] - file copy tfa tfa2 - set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]] - file delete -force tfa tfa2 - set result -} {1} - -test fCmd-14.8 {copyfile: copy directory failing } {unixOnly} { - catch {file delete -force -- tfa} - file mkdir tfa/dir/a/b/c - exec chmod 000 tfa/dir - set r1 [catch {file copy tfa tfa2}] - exec chmod 777 tfa/dir - set result $r1 - file delete -force tfa tfa2 - set result -} {1} - -# -# Coverage tests for TclMkdirCmd() -# -test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} { - global env - set temp $env(HOME) - unset env(HOME) - set result [catch {file mkdir ~/tfa}] - set env(HOME) $temp - set 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 } { - catch {file delete -force -- tfa} - file mkdir tfa - set result [file isdirectory tfa] - file delete tfa - set result -} {1} - -test fCmd-15.3 {TclMakeDirsCmd: - two directories } { - catch {file delete -force -- tfa1 tfa2} - file mkdir tfa1 tfa2 - set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]] - file delete tfa1 tfa2 - set result -} {1} - -test fCmd-15.4 {TclMakeDirsCmd - stat failing } {unixOnly} { - catch {file delete -force -- tfa} - file mkdir tfa - createfile tfa/file - exec chmod 000 tfa - set result [catch {file mkdir tfa/file}] - exec chmod 777 tfa - file delete -force tfa - set result -} {1} - -test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep } { - catch {file delete -force -- tfa} - file mkdir tfa/a/b/c - set result [file isdir tfa/a/b/c] - file delete -force tfa - set result -} {1} - - -test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file } { - catch {file delete -force -- tfa} - 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]] - file delete tfa - set result -} {1} - -test fCmd-15.7 {TclMakeDirsCmd - making several directories } { - catch {file delete -force -- tfa1 tfa2} - file mkdir tfa1 tfa2/a/b/c - set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]] - file delete -force tfa1 tfa2 - set result -} {1} - -test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} { - file mkdir tfa - file mkdir tfa - set result [file isdir tfa] - file delete tfa - set result -} {1} - - -# Coverage tests for TclDeleteFilesCommand() -test fCmd-16.1 { test the -- argument } { - catch {file delete -force -- tfa} - createfile tfa - file delete -- tfa - file exists tfa -} {0} - -test fCmd-16.2 { test the -force and -- arguments } { - catch {file delete -force -- tfa} - createfile tfa - file delete -force -- tfa - file exists tfa -} {0} - -test fCmd-16.3 { test bad option } { - catch {file delete -force -- tfa} - createfile tfa - set result [catch {file delete -dog tfa}] - file delete tfa - set result -} {1} - -test fCmd-16.4 { test not enough args } { - catch {file delete} -} {1} - -test fCmd-16.5 { test not enough args with options } { - catch {file delete --} -} {1} - -test fCmd-16.6 {delete: source filename translation failing} { - 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 } { - catch {file delete -force -- tfa} - file mkdir tfa - createfile tfa/a - set result [catch {file delete tfa }] - file delete -force tfa - set result -} {1} - -test fCmd-16.8 {remove a normal file } { - catch {file delete -force -- tfa} - file mkdir tfa - createfile tfa/a - set result [catch {file delete tfa }] - file delete -force tfa - set result -} {1} - -test fCmd-16.9 {error while deleting file } {unixOnly} { - catch {file delete -force -- tfa} - file mkdir tfa - createfile tfa/a - exec chmod 555 tfa - set result [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" - ####### - exec chmod 777 tfa - file delete -force tfa - set result -} {1} - -test fCmd-16.10 {deleting multiple files } { - catch {file delete -force -- tfa1 tfa2} - 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} { - catch {file delete -force -- tfa} - file delete tfa - set result 1 -} {1} - -# More coverage tests for mkpath() - test fCmd-17.1 {mkdir stat failing on target but not ENOENT } {unixOnly} { - catch {file delete -force -- tfa1} - file mkdir tfa1 - exec chmod 555 tfa1 - set result [catch {file mkdir tfa1/tfa2}] - exec chmod 777 tfa1 - file delete -force tfa1 - set result -} {1} - -test fCmd-17.2 {mkdir several levels deep - relative } { - catch {file delete -force -- tfa} - file mkdir tfa/a/b - set result [file isdir tfa/a/b ] - file delete tfa/a/b tfa/a tfa - set result -} {1} - -test fCmd-17.3 {mkdir several levels deep - absolute } { - catch {file delete -force -- tfa} - set f [file join [pwd] tfa a ] - file mkdir $f - set result [file isdir $f ] - file delete $f [file join [pwd] tfa] - set result -} {1} - -# -# Functionality tests for TclFileRenameCmd() -# - -test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} { - catch {file delete -force -- tfad} - file mkdir tfad/dir - cd tfad/dir - set s [createfile foo ] - file rename foo bar - file rename bar ./foo - file rename ./foo bar - file rename ./bar ./foo - file rename foo ../dir/bar - file rename ../dir/bar ./foo - 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 ../.. - file delete -force tfad - set result -} {1} - -test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant } { - catch {file delete -force -- tfa1 tfa2} - file mkdir tfa1 - file rename tfa1 tfa2 - set result [expr [file exists tfa2] && ![file exists tfa1]] - file delete tfa2 - set result -} {1} - -test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory } { - catch {file delete -force -- tfa1 tfad1 tfad2} - 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]] - file delete tfad2/tfa1 - file delete -force tfad2 - set result -} {1} - -test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir } { - catch {file delete -force -- tfa tfad} - 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 ] - file delete tfa tfad - set result -} {1} - -test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir } { - catch {file delete -force -- tfa tfad} - 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} - -# -# 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} { - catch {file delete -force -- tfa} - set s [createfile tfa] - set r1 [catch {file rename tfa tfa}] - set result [expr $r1 && [checkcontent tfa $s]] - file delete tfa - set result -} {1} - -test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} { - catch {file delete -force -- tfa tfad} - file mkdir tfa tfad/tfa - set r1 [catch {file rename tfa tfad}] - set result [expr $r1 && [file isdir tfa]] - file delete -force tfa tfad - set result -} {1} - -test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} { - catch {file delete -force -- tfa tfad} - file mkdir tfa tfad/tfa - file rename -force tfa tfad - set result [expr ![file isdir tfa]] - file delete -force tfad - set result -} {1} - -test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} { - catch {file delete -force -- tfa tfad} - 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]] - file delete -force tfa tfad - set result -} {1} - -test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} { - catch {file delete -force -- tfa tfad} - 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]] - file delete -force tfa tfad - set result -} {1} - -test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} { - 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} { - catch {file delete -force -- tfa1 tfa2 tfa3} - - set s [createfile tfa1] - exec ln -s tfa1 tfa2 - file rename tfa2 tfa3 - set t [file type tfa3] - set result [expr { $t == "link" }] - file delete tfa1 tfa3 - set result -} {1} - -test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} {unixOnly} { - catch {file delete -force -- tfa1 tfa2 tfa3} - - file mkdir tfa1 - exec ln -s tfa1 tfa2 - file rename tfa2 tfa3 - set t [file type tfa3] - set result [expr { $t == "link" }] - file delete tfa1 tfa3 - set result -} {1} - -test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} {unixOnly} { - catch {file delete -force -- tfa1 tfa2 tfa3} - - file mkdir tfa1/a/b/c/d - file mkdir tfa2 - set f [file join [pwd] tfa1/a/b] - set f2 [file join [pwd] {tfa2/b alias}] - exec ln -s $f $f2 - 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] - file delete -force tfa1 tfa2 tfa3 - set result -} {1} - -test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} {unixOnly} { - catch {file delete -force -- tfa1 tfa2 tfalink} - - file mkdir tfa1 - set s [createfile tfa2] - exec ln -s tfa1 tfalink - - file rename tfa2 tfalink - set result [checkcontent tfa1/tfa2 $s ] - file delete -force tfa1 tfalink - set result -} {1} - -test fCmd-18.16 {TclFileRenameCmd : rename a dangling symlink} {unixOnly} { - catch {file delete -force -- tfa1 tfalink} - - file mkdir tfa1 - exec ln -s tfa1 tfalink - file delete tfa1 - file rename tfalink tfa2 - set result [expr [string compare [file type tfa2] "link"] == 0] - file delete tfa2 - set result -} {1} - - -# -# Coverage tests for TclUnixRmdir -# -test fCmd-19.1 { remove empty directory } { - catch {file delete -force -- tfa} - file mkdir tfa - file delete tfa - file exists tfa -} {0} - -test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly} { - catch {file delete -force -- tfa} - file mkdir tfa - file mkdir tfa/a - exec chmod 555 tfa - set result [catch {file delete tfa/a}] - exec chmod 777 tfa - file delete -force tfa - set result -} {1} - -test fCmd-19.3 { recursive remove } { - catch {file delete -force -- tfa} - file mkdir tfa - file mkdir tfa/a - file delete -force tfa - file exists tfa -} {0} - -# -# 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 } {unixOnly} { - catch {file delete -force -- tfa} - file mkdir tfa - file mkdir tfa/a - exec chmod 000 tfa/a - set result [catch {file delete -force tfa}] - exec chmod 777 tfa/a - file delete -force tfa - set result -} {1} - - -# -# Feature testing for TclCopyFilesCmd -# -test fCmd-21.1 {copy : single file to nonexistant } { - catch {file delete -force -- tfa1 tfa2} - set s [createfile tfa1] - file copy tfa1 tfa2 - set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] - file delete tfa1 tfa2 - set result -} {1} - -test fCmd-21.2 {copy : single dir to nonexistant } { - catch {file delete -force -- tfa1 tfa2} - file mkdir tfa1 - file copy tfa1 tfa2 - set result [expr [file isdir tfa2] && [file isdir tfa1]] - file delete tfa1 tfa2 - set result -} {1} - -test fCmd-21.3 {copy : single file into directory } { - catch {file delete -force -- tfa1 tfad} - set s [createfile tfa1] - file mkdir tfad - file copy tfa1 tfad - set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]] - file delete -force tfa1 tfad - set result -} {1} - -test fCmd-21.4 {copy : more than one source and target is not a directory} { - catch {file delete -force -- tfa1 tfa2 tfa3} - createfile tfa1 - createfile tfa2 - createfile tfa3 - set result [catch {file copy tfa1 tfa2 tfa3}] - file delete tfa1 tfa2 tfa3 - set result -} {1} - -test fCmd-21.5 {copy : multiple files into directory } { - catch {file delete -force -- tfa1 tfa2 tfad} - 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] - file delete -force tfa1 tfa2 tfad - set result -} {1} - -test fCmd-21.6 {copy : mixed dirs and files into directory } {notFileSharing} { - catch {file delete -force -- tfa1 tfad1 tfad2} - 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]] - file delete -force tfa1 tfad1 tfad2 - set result -} {1} - -test fCmd-21.7 {TclCopyFilesCmd : copy a dangling link } {unixOnly} { - file mkdir tfad1 - exec ln -s tfad1 tfalink - 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 {TclCopyFilesCmd : copy a link } {unixOnly} { - file mkdir tfad1 - exec ln -s tfad1 tfalink - file copy tfalink tfalink2 - set r1 [file type tfalink] - set r2 [file type tfalink2] - set r3 [file isdir tfad1] - set result [expr {("$r1" == "link" ) && ("$r2" == "link" ) && $r3}] - file delete tfad1 tfalink tfalink2 - set result -} {1} - -test fCmd-21.9 {TclCopyFilesCmd : copy dir with a link in it } {unixOnly} { - file mkdir tfad1 - exec ln -s "[pwd]/tfad1" tfad1/tfalink - file copy tfad1 tfad2 - set result [string match [file type tfad2/tfalink] link] - file delete -force tfad1 tfad2 - set result -} {1} - -test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} { - catch {file delete -force -- tfa tfad} - file mkdir tfa [file join tfad tfa] - set r1 [catch {file copy tfa tfad}] - set result [expr $r1 && [file isdir tfa]] - file delete -force tfa tfad - set result -} {1} - -test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} { - catch {file delete -force -- tfa tfad} - 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]]] - file delete -force tfa tfad - set result -} {1} - -test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} { - catch {file delete -force -- tfa tfad} - 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]]] - file delete -force tfa tfad - set result -} {1} - -# -# Coverage testing for TclpRenameFile -# -test fCmd-22.1 { TclpRenameFile : rename and overwrite in a single dir } { - catch {file delete -force -- tfa1 tfa2} - set s [createfile tfa1] - set s2 [createfile tfa2 q] - - set r1 [catch {rename tfa1 tfa2}] - file rename -force tfa1 tfa2 - set result [expr $r1 && [checkcontent tfa2 $s]] - file delete [glob tfa1 tfa2] - set result -} {1} - -test fCmd-22.2 { TclpRenameFile : attempt to overwrite itself } {macOrUnix} { - catch {file delete -force -- tfa1} - 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 } { - catch {file delete -force -- d1 tfad} - 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]]] - file delete -force d1 tfad - set result -} {1} - -test fCmd-22.4 { TclpRenameFile : rename dir to dir several levels deep } { - catch {file delete -force -- d1 tfad} - 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]]] - file delete -force [glob d1 tfad] - set result -} {1} - - -# -# TclMacCopyFile needs to be redone. -# -test fCmd-22.5 { TclMacCopyFile : copy and overwrite in a single dir } { - catch {file delete -force -- tfa1 tfa2} - set s [createfile tfa1] - set s2 [createfile tfa2 q] - - set r1 [catch {file copy tfa1 tfa2}] - file copy -force tfa1 tfa2 - set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] - file delete tfa1 tfa2 - set result -} {1} - -# -# TclMacMkdir - basic cases are covered elsewhere. -# Error cases are not covered. -# - -# -# TclMacRmdir -# Error cases are not covered. -# - -test fCmd-23.1 { TclMacRmdir : trying to remove a nonempty directory } { - catch {file delete -force -- tfad} - - file mkdir [file join tfad dir] - - set result [catch {file delete tfad}] - file delete -force tfad - set result -} {1} - -# -# TclMacDeleteFile -# Error cases are not covered. -# -test fCmd-24.1 { TclMacDeleteFile : deleting a normal file } { - catch {file delete -force -- tfa1} - - createfile tfa1 - file delete tfa1 - file exists tfa1 -} {0} - -# -# TclMacCopyDirectory -# Error cases are not covered. -# -test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} {notFileSharing} { - catch {file delete -force -- tfad1 tfad2} - - 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]]] - file delete -force tfad1 tfad2 - set result -} {1} - -test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} {notFileSharing} { - catch {file delete -force -- tfad1 tfad2} - - file mkdir tfad1 - file copy tfad1 tfad2 - set result [expr [file isdir tfad1] && [file isdir tfad2]] - file delete tfad1 tfad2 - set result -} {1} - -test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} {notFileSharing} { - catch {file delete -force -- tfad1 tfad2} - - 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]]] - file delete -force tfad1 tfad2 - set result -} {1} - -# -# Functionality tests for TclDeleteFilesCmd -# - -test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly} { - catch {file delete -force -- tfad1 tfad2} - - file mkdir tfad1 - exec ln -s tfad1 tfalink - file delete tfalink - - set r1 [file isdir tfad1] - set r2 [file exists tfalink] - - set result [expr $r1 && !$r2] - file delete tfad1 - set result -} {1} - -test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly} { - catch {file delete -force -- tfad1 tfad2} - - file mkdir tfad1 - file mkdir tfad2 - exec ln -s tfad1 [file join tfad2 link] - file delete -force tfad2 - - set r1 [file isdir tfad1] - set r2 [file exists tfad2] - - set result [expr $r1 && !$r2] - file delete tfad1 - set result -} {1} - -test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly} { - catch {file delete -force -- tfad1 tfad2} - - file mkdir tfad1 - exec ln -s tfad1 tfad2 - file delete tfad1 - file delete tfad2 - - set r1 [file exists tfad1] - set r2 [file exists tfad2] - - set result [expr !$r1 && !$r2] - set result -} {1} - -test fCmd-27.1 {TclFileAttrsCmd - wrong # args} { - list [catch {file attributes a b c d} msg] $msg -} {1 {wrong # args: must be "file attributes name ?option? ?value? ?option value? ..."}} -test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} { - testsetplatform unix - list [catch {file attributes ~_bad_user} msg] $msg [testsetplatform $platform] -} {1 {user "_bad_user" doesn't exist} {}} -test fCmd-27.3 {TclFileAttrsCmd - all attributes} { - catch {file delete -force -- foo.tmp} - 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} { - catch {file delete -force -- foo.tmp} - 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 {}} - -set testConfig(tclGroup) 0 -if {($tcl_platform(platform) == "macintosh") \ - || ($tcl_platform(platform) == "windows")} { - set testConfig(tclGroup) 1 -} elseif {[catch {exec {groups}} groupList] == 0} { - if {[lsearch $groupList tcl] != -1} { - set testConfig(tclGroup) 1 - } -} - -test fCmd-27.5 {TclFileAttrsCmd - setting one option} {tclGroup} { - catch {file delete -force -- foo.tmp} - 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} {tclGroup} { - catch {file delete -force -- foo.tmp} - 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 {} {}} - -cleanup |