/brlcad/branches/dmtogl/src/other/tcl/tests/fCmd.test
Unknown | 2537 lines | 2471 code | 66 blank | 0 comment | 0 complexity | 9c1c36b9def7a727d9cf24ab654efbc1 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, LGPL-2.1, Apache-2.0, AGPL-3.0, LGPL-3.0, GPL-3.0, MPL-2.0-no-copyleft-exception, CC-BY-SA-3.0, 0BSD, BSD-3-Clause
Large files files are truncated, but you can click here to view the full file
- # 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.
- # 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.
- #
- # RCS: @(#) $Id$
- #
- if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
- }
- testConstraint testsetplatform [llength [info commands testsetplatform]]
- testConstraint testchmod [llength [info commands testchmod]]
- testConstraint winVista 0
- testConstraint win2000orXP 0
- testConstraint winOlderThan2000 0
- # Don't know how to determine this constraint correctly
- testConstraint notNetworkFilesystem 0
- testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
- testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
- # Find a group that exists on this Unix system, or else skip tests that
- # require Unix groups.
- testConstraint foundGroup [expr {![testConstraint unix]}]
- if {[testConstraint unix]} {
- catch {
- set groupList [exec groups]
- set group [lindex $groupList 0]
- testConstraint foundGroup 1
- }
- }
- # Also used in winFCmd...
- 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" &&
- int([string range $tcl_platform(osVersion) 0 \
- [string first . $tcl_platform(osVersion)]]) >= 9}]
- testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
- testConstraint fileSharing 0
- testConstraint notFileSharing 1
- testConstraint linkFile 1
- testConstraint linkDirectory 1
- # Several tests require need to match results against the unix username
- set user {}
- if {[testConstraint unix]} {
- catch {
- set user [exec whoami]
- }
- if {$user eq ""} {
- catch {
- regexp {^[^(]*\(([^)]*)\)} [exec id] -> user
- }
- }
- if {$user eq ""} {
- set user "root"
- }
- }
- proc createfile {file {string a}} {
- set f [open $file w]
- puts -nonewline $f $string
- 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 -directory $path *] {
- openup $p
- }
- }
- }
- }
- proc cleanup {args} {
- set wd [list .]
- foreach p [concat $wd $args] {
- set x ""
- catch {
- set x [glob -directory $p tf* td*]
- }
- foreach file $x {
- if {
- [catch {file delete -force -- $file}]
- && [testConstraint testchmod]
- } then {
- catch {openup $file}
- catch {file delete -force -- $file}
- }
- }
- }
- }
- proc contents {file} {
- set f [open $file]
- set r [read $f]
- close $f
- return $r
- }
- cd [temporaryDirectory]
- proc dev dir {
- file stat $dir stat
- return $stat(dev)
- }
- testConstraint xdev [expr {[testConstraint unix] && ([dev .] != [dev /tmp])}]
- set root [lindex [file split [pwd]] 0]
- # A really long file name
- # length of long is 1216 chars, which should be greater than any static buffer
- # or allowable filename.
- set long "abcdefghihjllmnopqrstuvwxyz01234567890"
- append long $long
- append long $long
- append long $long
- append long $long
- append long $long
- test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
- cleanup
- createfile tf1
- file rename tf1 tf2
- glob tf*
- } {tf2}
- test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
- cleanup
- createfile tf1
- file copy tf1 tf2
- lsort [glob tf*]
- } {tf1 tf2}
- test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
- file rename -xyz
- } -returnCodes error -result {bad option "-xyz": should be -force or --}
- test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body {
- file rename xyz
- } -returnCodes error -result {wrong # args: should be "file rename ?options? source ?source ...? target"}
- test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
- file rename xyz ~_totally_bogus_user
- } -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
- test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file copy tf1 ~
- } -result {error copying "tf1": no such file or directory}
- test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file rename tf1 tf2 tf3
- } -result {error renaming: target "tf3" is not a directory}
- test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- createfile tf3
- file rename tf1 tf2 tf3
- } -result {error renaming: target "tf3" is not a directory}
- test fCmd-3.7 {FileCopyRename: target exists & is directory} -setup {
- cleanup
- } -constraints {notRoot} -body {
- file mkdir td1
- createfile tf1 tf1
- file rename tf1 td1
- contents [file join td1 tf1]
- } -result {tf1}
- test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file rename tf1 tf2 tf3
- } -result {error renaming: target "tf3" is not a directory}
- test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file copy -force -- tf1 tf2 tf3
- } -result {error copying: target "tf3" is not a directory}
- test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
- cleanup
- createfile tf1 tf1
- file rename tf1 tf2
- contents tf2
- } {tf1}
- test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
- cleanup
- createfile tf1 tf1
- file rename -force -force -- tf1 tf2
- contents tf2
- } {tf1}
- test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
- 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} {notRoot} {
- 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} -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] == '\0'} -setup {
- cleanup
- } -constraints {notRoot unixOrPc} -returnCodes error -body {
- file mkdir td1
- file rename / td1
- } -result {error renaming "/" to "td1": file already exists}
- test fCmd-3.16 {FileCopyRename: break on first error} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- createfile tf1
- createfile tf2
- createfile tf3
- createfile tf4
- file mkdir td1
- createfile [file join td1 tf3]
- file rename tf1 tf2 tf3 tf4 td1
- } -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}]
- test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
- cleanup
- file mkdir td1
- glob td*
- } {td1}
- test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
- cleanup
- file mkdir td1 td2 td3
- lsort [glob td*]
- } {td1 td2 td3}
- test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
- 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} -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 == '\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} {notRoot} {
- cleanup
- file mkdir td1
- glob td1
- } {td1}
- test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
- 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} {notRoot} {
- cleanup
- file mkdir td1
- set x [file exists td1]
- file mkdir td1
- list $x [file exists td1]
- } {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 already exists}]
- test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
- cleanup
- file mkdir td1
- set x [file exists td1]
- file mkdir td1
- list $x [file exists td1]
- } {1 1}
- test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
- cleanup
- } -constraints {unix notRoot testchmod} -returnCodes error -body {
- file mkdir td1/td2/td3
- testchmod 000 td1/td2
- file mkdir td1/td2/td3/td4
- } -cleanup {
- 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 {
- cleanup
- } -constraints {notRoot} -body {
- set x [file exists td1]
- file mkdir td1
- list $x [file exists td1]
- } -result {0 1}
- test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
- cleanup
- file delete -force foo
- } -constraints {unix notRoot} -body {
- file mkdir foo
- file attr foo -perm 040000
- 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} {notRoot} {
- cleanup
- file mkdir tf1
- file exists tf1
- } {1}
- test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
- file delete -xyz
- } -returnCodes error -result {bad option "-xyz": should be -force or --}
- test fCmd-5.2 {TclFileDeleteCmd: not enough args} -constraints {notRoot} -body {
- file delete -force -force
- } -returnCodes error -result {wrong # args: should be "file delete ?options? file ?file ...?"}
- test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
- cleanup
- createfile tf1
- createfile tf2
- file mkdir td1
- file delete tf2
- glob tf* td*
- } {tf1 td1}
- test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
- cleanup
- 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]
- } {1 1 1 0 0 0}
- test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
- cleanup
- createfile tf1
- createfile tf2
- file mkdir td1
- catch {file delete tf1 td1 $root tf2}
- list [file exists tf1] [file exists tf2] [file exists td1]
- } {0 1 0}
- test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
- file delete ~_totally_bogus_user
- } -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
- test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
- catch {file delete ~/tf1}
- createfile ~/tf1
- file delete ~/tf1
- } {}
- test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
- cleanup
- set x [file exists tf1]
- file delete tf1
- list $x [file exists tf1]
- } {0 0}
- test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
- cleanup
- file mkdir td1
- file delete td1
- file exists td1
- } {0}
- test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file mkdir [file join td1 td2]
- file delete td1
- } -result {error deleting "td1": directory not empty}
- test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup {
- cleanup
- set dir [pwd]
- } -constraints {notRoot} -body {
- file mkdir [file join td1 td2]
- cd [file join td1 td2]
- set res [list [catch {file delete -force [file dirname [pwd]]} msg]]
- cd $dir
- lappend res [file exists td1] $msg
- } -cleanup {
- cd $dir
- } -result {0 0 {}}
- test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unix} {
- cleanup
- file mkdir [file join td1 td2]
- #exec chmod u-rwx [file join td1 td2]
- file attributes [file join td1 td2] -permissions u+rwx
- set res [list [catch {file delete -force td1} msg]]
- lappend res [file exists td1] $msg
- } {0 0 {}}
- test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} {
- # can't test this, because it's caught by FileCopyRename
- } {}
- test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot emptyTest} {
- # can't test this, because it's caught by FileCopyRename
- } {}
- test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file rename tf1 tf2
- } -result {error renaming "tf1": no such file or directory}
- test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
- cleanup
- createfile tf1
- file rename tf1 tf2
- glob tf*
- } {tf2}
- test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
- cleanup
- createfile tf1
- file rename tf1 tf2
- glob tf*
- } {tf2}
- test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
- cleanup
- } -constraints {unix notRoot testchmod} -body {
- file mkdir td1
- testchmod 000 td1
- createfile tf1
- file rename tf1 td1
- } -returnCodes error -cleanup {
- testchmod 755 td1
- } -result {error renaming "tf1" to "td1/tf1": permission denied}
- test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup {
- cleanup
- } -constraints {win 95} -returnCodes error -body {
- createfile tf1
- file rename tf1 $long
- } -result [subst {error renaming "tf1" to "$long": file name too long}]
- test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unix notRoot} {
- cleanup
- createfile tf1
- file rename tf1 tf2
- glob tf*
- } {tf2}
- test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- createfile tf1
- createfile tf2
- file rename tf1 tf2
- } -result {error renaming "tf1" to "tf2": file already exists}
- test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- createfile tf1
- createfile tf2
- file rename tf1 tf2
- } -result {error renaming "tf1" to "tf2": file already exists}
- test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
- cleanup
- createfile tf1
- createfile tf2
- file rename -force tf1 tf2
- glob tf*
- } {tf2}
- test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file mkdir td1
- file mkdir td2
- createfile [file join td2 td1]
- file rename -force td1 td2
- } -result [subst {can't overwrite file "[file join td2 td1]" with directory "td1"}]
- test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- createfile tf1
- file mkdir [file join td1 tf1]
- file rename -force tf1 td1
- } -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
- test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} -setup {
- cleanup
- } -constraints {notRoot notNetworkFilesystem} -body {
- file mkdir [file join td1 td2]
- file mkdir td2
- createfile [file join td2 tf1]
- file rename -force td2 td1
- file exists [file join td1 td2 tf1]
- } -result 1
- test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup {
- cleanup
- } -constraints {notRoot} -body {
- file mkdir [file join td1 td2]
- createfile [file join td1 td2 tf1]
- file mkdir td2
- file rename -force td2 td1
- } -returnCodes error -match glob -result \
- [subst {error renaming "td2" to "[file join td1 td2]": file *}]
- test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file rename -force $root tf1
- } -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}]
- test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
- cleanup
- } -constraints {notRoot} -body {
- file mkdir [file join td1 td2]
- createfile [file join td1 td2 tf1]
- file mkdir td2
- file rename -force td2 td1
- } -returnCodes error -match glob -result \
- [subst {error renaming "td2" to "[file join td1 td2]": file *}]
- test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unix notRoot} {
- cleanup /tmp
- createfile tf1
- file rename tf1 /tmp
- glob -nocomplain tf* /tmp/tf1
- } {/tmp/tf1}
- test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
- catch {file delete -force c:/tcl8975@ d:/tcl8975@}
- } -body {
- file mkdir c:/tcl8975@
- if {[catch {file rename c:/tcl8975@ d:/}]} {
- return d:/tcl8975@
- }
- glob c:/tcl8975@ d:/tcl8975@
- } -cleanup {
- file delete -force c:/tcl8975@
- catch {file delete -force d:/tcl8975@}
- } -result {d:/tcl8975@}
- test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
- {unix notRoot} {
- cleanup /tmp
- file mkdir td1
- file rename td1 /tmp
- glob -nocomplain td* /tmp/td*
- } {/tmp/td1}
- test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
- {unix notRoot} {
- cleanup /tmp
- createfile tf1
- file rename tf1 /tmp
- glob -nocomplain tf* /tmp/tf*
- } {/tmp/tf1}
- test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- cleanup /tmp
- } -constraints {unix notRoot xdev} -body {
- file mkdir td1/td2/td3
- file attributes td1 -permissions 0000
- file rename td1 /tmp
- } -returnCodes error -cleanup {
- file attributes td1 -permissions 0755
- } -match regexp -result {^error renaming "td1"( to "/tmp/td1")?: permission denied$}
- test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
- cleanup
- } -constraints {unix notRoot} -body {
- file mkdir ~/td1/td2
- set td1name [file join [file dirname ~] [file tail ~] td1]
- file attributes $td1name -permissions 0000
- file copy ~/td1 td1
- } -returnCodes error -cleanup {
- 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 {
- cleanup
- } -constraints {unix notRoot} -body {
- file mkdir td2
- file mkdir ~/td1
- set td1name [file join [file dirname ~] [file tail ~] td1]
- file attributes $td1name -permissions 0000
- file copy td2 ~/td1
- } -returnCodes error -cleanup {
- 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 {
- cleanup
- } -constraints {unix notRoot} -body {
- file mkdir ~/td1/td2
- set td2name [file join [file dirname ~] [file tail ~] td1 td2]
- file attributes $td2name -permissions 0000
- file copy ~/td1 td1
- } -returnCodes error -cleanup {
- 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 {
- cleanup /tmp
- } -constraints {unix notRoot xdev} -returnCodes error -body {
- file mkdir td1/td2/td3
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- file rename -force td1 /tmp
- } -result {error renaming "td1" to "/tmp/td1": file already exists}
- test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- cleanup /tmp
- } -constraints {unix notRoot xdev} -body {
- file mkdir td1/td2/td3
- file attributes td1/td2/td3 -permissions 0000
- file rename td1 /tmp
- } -returnCodes error -cleanup {
- file attributes td1/td2/td3 -permissions 0755
- } -result {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}
- test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
- cleanup /tmp
- } -constraints {unix notRoot xdev} -body {
- file mkdir td1/td2/td3
- file rename td1 /tmp
- glob td* /tmp/td1/t*
- } -result {/tmp/td1/td2}
- test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
- cleanup
- } -constraints {unix notRoot} -body {
- file mkdir foo/bar
- file attr foo -perm 040555
- file rename foo/bar /tmp
- } -returnCodes error -cleanup {
- catch {file delete /tmp/bar}
- catch {file attr foo -perm 040777}
- catch {file delete -force foo}
- } -match glob -result {*: permission denied}
- test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
- catch {cleanup /tmp}
- } -constraints {unix notRoot xdev} -body {
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- file rename /tmp/td1/tf1 tf1
- list [file exists /tmp/td1/tf1] [file exists tf1]
- } -result {0 1}
- test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup {
- cleanup
- } -returnCodes error -body {
- file copy tf1 tf2
- } -result {error copying "tf1": no such file or directory}
- catch {cleanup /tmp}
- test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup {
- cleanup
- } -returnCodes error -body {
- file mkdir [file join tf1 tf2]
- file delete tf1
- } -result {error deleting "tf1": directory not empty}
- test fCmd-7.2 {FileForceOption: -force} {notRoot} {
- cleanup
- file mkdir [file join tf1 tf2]
- file delete -force tf1
- } {}
- test fCmd-7.3 {FileForceOption: --} {notRoot} {
- createfile -tf1
- file delete -- -tf1
- } {}
- 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": should be -force or --}
- test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- createfile --
- createfile -force
- file delete -force -force -- -- -force
- glob -- -- -force
- } -result {no files matched glob patterns "-- -force"}
- test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
- -constraints {unix notRoot knownBug} -body {
- # Labelled knownBug because it is dangerous [Bug: 3881]
- file mkdir td1
- 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 == ~} \
- {unix notRoot} {
- string equal [file tail ~$user] ~$user
- } 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 \
- {error copying "~" to "[file join this file doesnt exist]": no such file or directory}]
- test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
- cleanup
- } -constraints {unix notRoot} -body {
- file mkdir td1
- file mkdir td2
- file attr td2 -perm 040000
- file rename td1 td2/
- } -returnCodes error -cleanup {
- file delete -force td2
- file delete -force td1
- } -result {error renaming "td1" to "td2/td1": permission denied}
- test fCmd-9.2 {file rename: comprehensive: source doesn't exist} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file rename tf1 tf2
- } -result {error renaming "tf1": no such file or directory}
- test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
- cleanup
- } -constraints {notRoot testchmod} -body {
- createfile tf1
- createfile tf2
- testchmod 444 tf2
- file rename tf1 tf3
- file rename tf2 tf4
- list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
- } -result {{tf3 tf4} 1 0}
- test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup {
- cleanup
- } -constraints {unixOrPc notRoot testchmod notDarwin9 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.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
- 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} -setup {
- cleanup
- } -constraints {notRoot unixOrPc testchmod win2000orXP} -body {
- file mkdir td1
- file mkdir td2
- testchmod 555 td2
- file rename -force td1 .
- file rename -force td2 .
- list [lsort [glob td*]] [file writable td1] [file writable td2]
- } -result {{td1 td2} 1 0}
- test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup {
- cleanup
- } -constraints {notRoot testchmod} -body {
- createfile tf1
- createfile tf2
- createfile tfs1
- 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]
- } -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.
- 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 {![testConstraint unix]} {
- testchmod 555 tds3
- testchmod 555 tds4
- }
- testchmod 555 [file join tdd2 tds2]
- testchmod 555 [file join tdd4 tds4]
- set msg [list [catch {file rename td1 td2} msg] $msg]
- file rename -force tds1 tdd1
- file rename -force tds2 tdd2
- file rename -force tds3 tdd3
- file rename -force tds4 tdd4
- if {[testConstraint unix]} {
- set w3 0
- set w4 0
- } else {
- set w3 [file writable [file join tdd3 tds3]]
- set w4 [file writable [file join tdd4 tds4]]
- }
- list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
- [file writable [file join tdd2 tds2]] $w3 $w4
- } -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
- # Test can hit EEXIST or EBUSY, depending on underlying filesystem
- test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
- cleanup
- } -constraints {notRoot testchmod} -body {
- file mkdir tds1
- file mkdir tds2
- file mkdir [file join tdd1 tds1 xxx]
- file mkdir [file join tdd2 tds2 xxx]
- if {!([testConstraint unix] || [testConstraint winVista])} {
- testchmod 555 tds2
- }
- set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
- set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
- if {[testConstraint unix] || [testConstraint winVista]} {
- 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} {notRoot testchmod} {
- 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 -directory 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} {notRoot testchmod} {
- cleanup
- 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]
- if {[testConstraint unix] || [testConstraint winVista]} {
- set w4 0
- } else {
- set w4 [file writable [file join td3 td4]]
- }
- list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
- [file writable [file join td3 td3]] $w4
- } [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
- test fCmd-9.12 {file rename: comprehensive: target exists} -setup {
- cleanup
- } -constraints {notRoot testchmod notNetworkFilesystem} -body {
- file mkdir [file join td1 td2] [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 755 [file join td2 td1]
- } -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
- # Test can hit EEXIST or EBUSY, depending on underlying filesystem
- test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
- cleanup
- } -constraints {notRoot} -body {
- file mkdir [file join td1 td2] [file join td2 td1 td4]
- file rename -force td1 td2
- } -returnCodes error -match glob -result \
- [subst {error renaming "td1" to "[file join td2 td1]": file *}]
- test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
- cleanup
- file mkdir td1
- list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
- } [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
- test fCmd-9.14.1 {file rename: comprehensive: dir into self} {notRoot} {
- cleanup
- file mkdir td1
- file rename td1 td1x
- file rename td1x td1
- set msg "ok"
- } {ok}
- test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup {
- cleanup
- set dir [pwd]
- } -constraints {nonPortable notRoot} -body {
- file mkdir td1
- cd td1
- file rename [file join .. td1] [file join .. td1x]
- } -returnCodes error -cleanup {
- cd $dir
- } -result [subst {error renaming "[file join .. td1]" to "[file join .. td1x]": permission denied}]
- test fCmd-9.14.3 {file rename: comprehensive: dir into self} -setup {
- cleanup
- set dir [pwd]
- } -constraints {notRoot} -body {
- file mkdir td1
- cd td1
- file rename [file join .. td1] [file join .. td1 foo]
- } -returnCodes error -cleanup {
- cd $dir
- } -result [subst {error renaming "[file join .. td1]" to "[file join .. td1 foo]": trying to rename a volume or move a directory into itself}]
- test fCmd-9.15 {file rename: comprehensive: source and target incompatible} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file mkdir td1
- createfile tf1
- file rename -force td1 tf1
- } -cleanup {
- cleanup
- } -result {can't overwrite file "tf1" with directory "td1"}
- test fCmd-9.16 {file rename: comprehensive: source and target incompatible} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file mkdir td1/tf1
- createfile tf1
- file rename -force tf1 td1
- } -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
- test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file copy tf1 tf2
- } -result {error copying "tf1": no such file or directory}
- test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
- cleanup
- createfile tf1 tf1
- 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} -setup {
- cleanup
- } -constraints {notRoot unixOrPc 95or98 testchmod} -body {
- file mkdir [file join td1 tdx]
- file mkdir [file join td2 tdy]
- testchmod 555 td2
- file copy td1 td3
- file copy td2 td4
- list [lsort [glob td*]] [glob -directory td3 t*] \
- [glob -directory td4 t*] [file writable td3] [file writable td4]
- } -cleanup {
- testchmod 755 td2
- testchmod 755 td4
- } -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0]
- test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
- cleanup
- } -constraints {notRoot win 2000orNewer testchmod} -body {
- # On Windows with ACLs, copying a directory is defined like this
- file mkdir [file join td1 tdx]
- file mkdir [file join td2 tdy]
- testchmod 555 td2
- file copy td1 td3
- file copy td2 td4
- list [lsort [glob td*]] [glob -directory td3 t*] \
- [glob -directory td4 t*] [file writable td3] [file writable td4]
- } -cleanup {
- testchmod 755 td2
- testchmod 755 td4
- } -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1]
- test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup {
- cleanup
- } -constraints {notRoot testchmod} -body {
- 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]
- } -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
- test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
- cleanup
- } -constraints {notRoot testchmod} -body {
- file mkdir td1
- file mkdir [file join td2 td1]
- file mkdir tds1
- 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]
- 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 already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
- test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
- cleanup
- } -constraints {notRoot unixOrPc testchmod} -body {
- file mkdir tds1
- file mkdir tds2
- file mkdir [file join tdd1 tds1 xxx]
- 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]
- } -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 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*]] \
- [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
- } -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
- test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
- cleanup
- } -constraints {notRoot unixOrPc 95or98 testchmod} -body {
- 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 -directory td3 t*]] \
- [file writable [file join td3 td3]] [file writable [file join td3 td4]]
- } -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
- test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup {
- cleanup
- } -constraints {notRoot win 2000orNewer testchmod} -body {
- # On Windows with ACLs, copying a directory is defined like this
- file mkdir td1
- file mkdir td2
- file mkdir td3
- 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*]] \
- [file writable [file join td3 td3]] [file writable [file join td3 td4]]
- } -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
- test fCmd-10.9 {file copy: comprehensive: source and target incompatible} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file mkdir td1
- createfile tf1
- file copy -force td1 tf1
- } -result {can't overwrite file "tf1" with directory "td1"}
- test fCmd-10.10 {file copy: comprehensive: source and target incompatible} -setup {
- cleanup
- } -constraints {notRoot} -returnCodes error -body {
- file mkdir [file join td1 tf1]
- createfile tf1
- file copy -force tf1 td1
- } -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
- test fCmd-10.11 {file copy: copy to empty file name} -setup {
- cleanup
- } -returnCodes error -body {
- createfile tf1
- file copy tf1 ""
- } -result {error copying "tf1" to "": no such file or directory}
- test fCmd-10.12 {file rename: rename to empty file name} -setup {
- cleanup
- } -returnCodes error -body {
- createfile tf1
- file rename tf1 ""
- } -result {error renaming "tf1" to "": no such file or directory}
- cleanup
- # old tests
- test fCmd-11.1 {TclFileRenameCmd: -- option } -constraints notRoot -setup {
- catch {file delete -force -- -tfa1}
- } -body {
- set s [createfile -tfa1]
- file rename -- -tfa1 tfa2
- list [checkcontent tfa2 $s] [file exists -tfa1]
- } -cleanup {
- file delete tfa2
- } -result {1 0}
- test fCmd-11.2 {TclFileRenameCmd: bad option } -constraints notRoot -setup {
- catch {file delete -force -- tfa1}
- } -body {
- set s [createfile tfa1]
- list [catch {file rename -x tfa1 tfa2}] \
- [checkcontent tfa1 $s] [file exists tfa2]
- } -cleanup {
- file delete tfa1
- } -result {1 1 0}
- 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 {
- global env
- unset env(HOME)
- catch { file rename tfa ~/foobar }
- } -cleanup {
- set ::env(HOME) $temp
- } -result 1
- test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup {
- catch {file delete -force -- tfa1 tfa2 tfa3}
- } -constraints {notRoot} -body {
- createfile tfa1
- createfile tfa2
- createfile tfa3
- catch {file rename tfa1 tfa2 tfa3}
- } -cleanup {
- file delete tfa1 tfa2 tfa3
- } -result {1}
- test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup {
- catch {file delete -force -- tfa1 tfad}
- } -constraints {notRoot} -body {
- set s [createfile tfa1]
- file mkdir tfad
- file rename tfa1 tfad
- list [checkcontent tfad/tfa1 $s] [file exists tfa1]
- } -cleanup {
- file delete -force tfad
- } -result {1 0}
- test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} -setup {
- catch {file delete -force -- tfa1 tfa2 tfad}
- } -constraints {notRoot} -body {
- set s1 [createfile tfa1]
- set s2 [createfile tfa2]
- file mkdir tfad
- file rename tfa1 tfa2 tfad
- list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
- [file exists tfa1] [file exists tfa2]
- } -cleanup {
- file delete -force tfad
- } -result {1 1 0 0}
- test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} -setup {
- catch {file delete -force -- tfa tfad}
- } -constraints {notRoot} -body {
- set s [createfile tfa]
- file mkdir tfad
- file mkdir tfad/tfa
- list [catch {file rename tfa tfad}] [checkcontent tfa $s] [file isdir tfad]
- } -cleanup {
- file delete -force tfa tfad
- } -result {1 1 1}
- #
- # Coverage tests for renamefile() ;
- #
- test fCmd-12.1 {renamefile: source filename translation failing} -setup {
- set temp $::env(HOME)
- } -constraints {notRoot} -body {
- global env
- unset env(HOME)
- catch {file rename ~/tfa1 tfa2}
- } -cleanup {
- set ::env(HOME) $temp
- } -result {1}
- test fCmd-12.2 {renamefile: src filename translation failing} -setup {
- set temp $::env(HOME)
- } -constraints {notRoot} -body {
- global env
- unset env(HOME)
- set s [createfile tfa1]
- file mkdir tfad
- catch {file rename tfa1 ~/tfa2 tfad}
- } -cleanup {
- set ::env(HOME) $temp
- file delete -force tfad
- } -result {1}
- test fCmd-12.3 {renamefile: stat failing on source} -setup {
- catch {file delete -force -- tfa1 tfa2}
- } -constraints {notRoot} -body {
- list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
- } -result {1 0 0}
- test fCmd-12.4 {renamefile: error renaming file to directory} -setup {
- catch {file delete -force -- tfa tfad}
- } -constraints {notRoot} -body {
- set s1 [createfile tfa]
- file mkdir tfad
- file mkdir tfad/tfa
- list [catch {file rename tfa tfad}] [checkcontent tfa $s1] \
- [file isdir tfad/tfa]
- } -cleanup {
- file delete -force tfa tfad
- } -result {1 1 1}
- test fCmd-12.5 {renamefile: error renaming directory to file} -setup {
- catch {file delete -force -- tfa tfad}
- } -constraints {notRoot} -body {
- file mkdir tfa
- file mkdir tfad
- set s [createfile tfad/tfa]
- list [catch {file rename tfa tfad}] [checkcontent tfad/tfa $s] \
- [file isdir tfad] [file isdir tfa]
- } -cleanup {
- file delete -force tfa tfad
- } -result {1 1 1 1}
- test fCmd-12.6 {renamefile: TclRenameFile succeeding} -setup {
- catch {file delete -force -- tfa1 tfa2}
- } -constraints {notRoot} -body {
- set s [createfile tfa1]
- file rename tfa1 tfa2
- list [checkcontent tfa2 $s] [file exists tfa1]
- } -cleanup {
- file delete tfa2
- } -result {1 0}
- test fCmd-12.7 {renamefile: renaming directory into offspring} -setup {
- catch {file delete -force -- tfad}
- } -constraints {notRoot} -body {
- file mkdir tfad
- file mkdir tfad/dir
- catch {file rename tfad tfad/dir}
- } -cleanup {
- file delete -force tfad
- } -result {1}
- test fCmd-12.8 {renamefile: generic error} -setup {
- catch {file delete -force -- tfa}
- } -constraints {unix notRoot} -body {
- file mkdir tfa
- file mkdir tfa/dir
- file attributes tfa -permissions 0555
- catch {file rename tfa/dir tfa2}
- } -cleanup {
- catch {file attributes tfa -permissions 0777}
- file delete -force tfa
- } -result {1}
- test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
- catch {file delete -force -- tfa /tmp/tfa}
- } -constraints {unix notRoot} -body {
- set s [createfile tfa]
- file rename tfa /tmp
- list [checkcontent /tmp/tfa $s] [file exists tfa]
- } -cleanup {
- file delete /tmp/tfa
- } -result {1 0}
- test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {
- catch {file delete -force -- tfad /tmp/tfad}
- } -constraints {unix notRoot} -body {
- file mkdir tfad
- set s [createfile tfad/a]
- file rename tfad /tmp
- list [checkcontent /tmp/tfad/a $s] [file exists tfad]
- } -cleanup {
- file delete -force /tmp/tfad
- } -result {1 0}
- #
- # Coverage tests for TclCopyFilesCmd()
- #
- test fCmd-13.1 {TclCopyFilesCmd: -force option} -constraints notRoot -setup {
- catch {file delete -force -- tfa1}
- } -body {
- set s [createfile tfa1]
- file copy -force tfa1 tfa2
- list [checkcontent tfa2 $s] [checkcontent tfa1 $s]
- } -cleanup {
- file delete tfa1 tfa2
- } -result {1 1}
- test fCmd-13.2 {TclCopyFilesCmd: -- option} -constraints {notRoot} -setup {
- catch {file delete -force -- tfa1}
- } -body {
- set s [createfile -tfa1]
- file copy -- -tfa1 tfa2
- list [checkcontent tfa2 $s] [checkcontent -tfa1 $s]
- } -cleanup {
- file delete -- -tfa1 tfa2
- } -result {1 1}
- test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup {
- catch {file delete -force -- tfa1}
- } -body {
- set s [createfile tfa1]
- list [catch {file copy -x tfa1 tfa2}] \
- [checkcontent tfa1 $s] [file exists tfa2]
- } -cleanup {
- file delete tfa1
- } -result {1 1 0}
- test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
- catch {file copy -- }
- } {1}
- test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup {
- set temp $::env(HOME)
- } -body {
- global env
- unset env(HOME)
- catch { file copy tfa ~/foobar }
- } -cleanup {
- set ::env(HOME) $temp
- } -result {1}
- test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
- catch {file delete -force -- tfa1 tfa2 tfa3}
- } -constraints {notRoot} -body {
- createfile tfa1
- createfile tfa2
- createfile tfa3
- catch {file copy tfa1 tfa2 tfa3}
- } -cleanup {
- file delete tfa1 tfa2 tfa3
- } -result {1}
- test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
- catch {file delete -force -- tfa1 tfad}
- } -constraints {notRoot} -body {
- set s [createfile tfa1]
- file mkdir tfad
- file copy tfa1 tfad
- list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]
- } -cleanup {
- file delete -force tfad tfa1
- } -result {1 1}
- test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} -setup {
- catch {file delete -force -- tfa1 tfa2 tfad}
- } -constraints {notRoot} -body {
- set s1 [createfile tfa1 ]
- set s2 [createfile tfa2 ]
- file mkdir tfad
- file copy tfa1 tfa2 tfad
- list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
- [checkcontent tfa1 $s1] [checkcontent tfa2 $s2]
- } -cleanup {
- file delete -force tfad tfa1 tfa2
- } -result {1 1 1 1}
- test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} -setup {
- catch {file delete -force -- tfa tfad}
- } -constraints {notRoot} -body {
- set s [createfile tfa]
- file mkdir tfad
- file mkdir tfad/tfa
- list [catch {file copy tfa tfad}] [checkcontent tfa $s] \
- [file isdir tfad/tfa] [file isdir tfad]
- } -cleanup {
- file delete -force tfa tfad
- } -result {1 1 1 1}
- #
- # Coverage tests for copyfile()
- #
- test fCmd-14.1 {copyfile: source filename translation failing} -setup {
- set temp $::env(HOME)
- } -constraints {notRoot} -body {
- global env
- unset env(HOME)
- catch {file copy ~/tfa1 tfa2}
- } -cleanup {
- set ::env(HOME) $temp
- } -result {1}
- test fCmd-14.2 {copyfile: dst filename translation failing} -setup {
- set temp $::env(HOME)
- } -constraints {notRoot} -body {
- global env
- unset env(HOME)
- set s [createfile tfa1]
- file mkdir tfad
- list [catch {file copy tfa1 ~/tfa2 tfad}] [checkcontent tfad/tfa1 $s]
- } -cleanup {
- set ::env(HOME) $temp
- file delete -force tfa1 tfad
- } -result {1 1}
- test fCmd-14.3 {copyfile: stat failing on source} -setup {
- catch {file delete -force -- tfa1 tfa2}
- } -constraints notRoot -body {
- list [catch {file copy tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
- } -result {1 0 0}
- test fCmd-14.4 {copyfile: error copying file to directory} -setup {
- catch {file delete -force -- tfa tfad}
- } -constraints {notRoot} -body {
- set s1 [createfile tfa ]
- file mkdir tfad
- file mkdir tfad/tfa
- list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \
- [file isdir tfad] [file isdir tfad/tfa]
- } -cleanup {
- file delete -force tfa tfad
- } -result {1 1 1 1}
- test fCmd-14.5 {copyfile: error copying directory to file} -setup {
- catch {file delete -force -- tfa tfad}
- } -constraints {notRoot} -body {
- file mkdir tfa
- file mkdir tfad
- set s [createfile tfad/tfa]
- list [catch {file copy tfa tfad}] [checkcontent tfad/tfa $s] \
- [file isdir tfad] [file isdir tfa]
- } -cleanup {
- file delete -force tfa tfad
- } -result {1 1 1 1}
- test fCmd-14.6 {copyfile: copy file succeeding} -constraints notRoot -setup {
- catch {file delete -…
Large files files are truncated, but you can click here to view the full file