1983 lines
58 KiB
Plaintext
1983 lines
58 KiB
Plaintext
# 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 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.18 96/10/14 14:38:39
|
|
#
|
|
|
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
|
|
|
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
|
|
}
|
|
|
|
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 cleanup {args} {
|
|
foreach p ". $args" {
|
|
set x ""
|
|
catch {
|
|
set x [glob [file join $p tf*] [file join $p td*]]
|
|
}
|
|
if {$x != ""} {
|
|
eval file delete -force $x
|
|
}
|
|
}
|
|
}
|
|
|
|
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 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 nonPortable} {
|
|
cleanup
|
|
list [catch {file mkdir /tf1} msg] $msg
|
|
} {1 {can't create directory "/tf1": permission denied}}
|
|
test fcmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {pcOnly} {
|
|
# error message is either "permission denied" or "file already exists"
|
|
catch {file mkdir c:.} msg
|
|
string range $msg 0 26
|
|
} {can't create directory "c:"}
|
|
test fcmd-4.16 {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.17 {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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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 nonPortable} {
|
|
cleanup
|
|
if [file exists /kernel] {
|
|
set msg [list [catch {file rename /kernel td1} msg] $msg]
|
|
set a1 {1 {can't unlink "/kernel": permission denied}}
|
|
expr {$msg == $a1}
|
|
} else {
|
|
list 1
|
|
}
|
|
} {1}
|
|
test fcmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} {unixOnly} {
|
|
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}}
|
|
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} {
|
|
list [catch {file rename ~$user /} msg] $msg
|
|
} "1 {error renaming \"~$user\" to \"/$user\": permission denied}"
|
|
|
|
test fcmd-9.1 {file rename: comprehensive: EACCES} {unixOnly} {
|
|
cleanup
|
|
file mkdir td1
|
|
list [catch {file rename td1 /} msg] $msg
|
|
} {1 {error renaming "td1" to "/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} {
|
|
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} {
|
|
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 td2/td1
|
|
file mkdir tds1
|
|
file mkdir tds2
|
|
file mkdir tds3
|
|
file mkdir tds4
|
|
file mkdir tdd1/tds1
|
|
file mkdir tdd2/tds2
|
|
file mkdir tdd3/tds3
|
|
file mkdir tdd4/tds4
|
|
if {$tcl_platform(platform) != "unix"} {
|
|
testchmod 555 tds3
|
|
testchmod 555 tds4
|
|
}
|
|
testchmod 555 tdd2/tds2
|
|
testchmod 555 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"} {
|
|
set w3 [file writable tdd3/tds3]
|
|
set w4 [file writable tdd4/tds4]
|
|
} else {
|
|
set w3 0
|
|
set w4 0
|
|
}
|
|
list [lsort [glob td*]] $msg [file writable tdd1/tds1] [file writable 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 tdd1/tds1/xxx
|
|
file mkdir tdd2/tds2/xxx
|
|
if {$tcl_platform(platform) != "unix"} {
|
|
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"} {
|
|
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 td1/tf3
|
|
file rename tf2 td1/tf4
|
|
list [catch {glob tf*}] [lsort [glob td1/t*]] [file writable td1/tf3] [file writable 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"} {
|
|
testchmod 555 td2
|
|
}
|
|
file rename td1 td3/td3
|
|
file rename td2 td3/td4
|
|
if {$tcl_platform(platform) != "unix"} {
|
|
set w4 [file writable td3/td4]
|
|
} else {
|
|
set w4 0
|
|
}
|
|
list [lsort [glob td*]] [lsort [glob td3/t*]] [file writable 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 td1/td2 td2/td1
|
|
testchmod 555 td2/td1
|
|
file mkdir td3/td4 td4/td3
|
|
file rename -force td3 td4
|
|
set msg [list [file exists td3] [file exists td4/td3/td4] [catch {file rename td1 td2} msg] $msg]
|
|
testchmod 755 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 td1/td2 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} {
|
|
cleanup
|
|
file mkdir td1/tdx
|
|
file mkdir td2/tdy
|
|
testchmod 555 td2
|
|
file copy td1 td3
|
|
file copy td2 td4
|
|
set msg [list [lsort [glob td*]] [glob td3/t*] [glob td4/t*] [file writable td3] [file writable td4]]
|
|
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 td2/td1
|
|
file mkdir tds1
|
|
file mkdir tds2
|
|
file mkdir tds3
|
|
file mkdir tds4
|
|
file mkdir tdd1/tds1
|
|
file mkdir tdd2/tds2
|
|
file mkdir tdd3/tds3
|
|
file mkdir tdd4/tds4
|
|
testchmod 555 tds3
|
|
testchmod 555 tds4
|
|
testchmod 555 tdd2/tds2
|
|
testchmod 555 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} {
|
|
cleanup
|
|
file mkdir tds1
|
|
file mkdir tds2
|
|
file mkdir tdd1/tds1/xxx
|
|
file mkdir 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 td1/tf3
|
|
file copy tf2 td1/tf4
|
|
list [lsort [glob tf*]] [lsort [glob td1/t*]] [file writable td1/tf3] [file writable 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} {
|
|
cleanup
|
|
file mkdir td1
|
|
file mkdir td2
|
|
file mkdir td3
|
|
testchmod 555 td2
|
|
file copy td1 td3/td3
|
|
file copy td2 td3/td4
|
|
list [lsort [glob td*]] [lsort [glob td3/t*]] [file writable td3/td3] [file writable 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 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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
file delete -force -- tfa
|
|
createfile tfa
|
|
file delete -- tfa
|
|
file exists tfa
|
|
} {0}
|
|
|
|
test fcmd-16.2 { test the -force and -- arguments } {
|
|
file delete -force -- tfa
|
|
createfile tfa
|
|
file delete -force -- tfa
|
|
file exists tfa
|
|
} {0}
|
|
|
|
test fcmd-16.3 { test bad option } {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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} {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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} {
|
|
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 } {
|
|
file delete -force -- tfa
|
|
file mkdir tfa
|
|
file delete tfa
|
|
file exists tfa
|
|
} {0}
|
|
|
|
test fcmd-19.2 { rmdir error besides EEXIST} {unixOnly} {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
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 } {
|
|
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} {
|
|
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 } {
|
|
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 } {
|
|
file delete -force -- tfa1 tfad1 tfad2
|
|
set s [createfile tfa1 ]
|
|
file mkdir tfad1 tfad2
|
|
file copy tfa1 tfad1 tfad2
|
|
set r1 [checkcontent tfad2/tfa1 $s]
|
|
set r2 [file isdir 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} {
|
|
file delete -force -- tfa tfad
|
|
file mkdir tfa 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} {
|
|
file delete -force -- tfa tfad
|
|
file mkdir tfa tfad/tfa/file
|
|
set r1 [catch {file copy tfa tfad}]
|
|
set result [expr $r1 && [file isdir tfa] && [file isdir 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} {
|
|
file delete -force -- tfa tfad
|
|
file mkdir tfa tfad/tfa/file
|
|
set r1 [catch {file copy -force tfa tfad}]
|
|
set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
|
|
file delete -force tfa tfad
|
|
set result
|
|
} {1}
|
|
|
|
#
|
|
# Coverage testing for TclMacRenameFile
|
|
#
|
|
test fcmd-22.1 { TclMacRenameFile : rename and overwrite in a single dir } {
|
|
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 { TclMacRenameFile : attempt to overwrite itself } {macOrUnix} {
|
|
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 { TclMacRenameFile : rename dir to existing dir } {
|
|
file delete -force -- d1 tfad
|
|
file mkdir d1 tfad/d1
|
|
set r1 [catch {file rename d1 tfad}]
|
|
set result [expr $r1 && [file isdir d1] && [file isdir tfad/d1]]
|
|
file delete -force d1 tfad
|
|
set result
|
|
} {1}
|
|
|
|
test fcmd-22.4 { TclMacRenameFile : rename dir to dir several levels deep } {
|
|
file delete -force -- d1 tfad
|
|
file mkdir d1 tfad/a/b/c
|
|
file rename d1 tfad/a/b/c
|
|
set result [expr ![file isdir d1] && [file isdir 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 } {
|
|
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 } {
|
|
file delete -force -- tfad
|
|
|
|
file mkdir 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 } {
|
|
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} {
|
|
file delete -force -- tfad1 tfad2
|
|
|
|
file mkdir tfad1/a/b/c
|
|
file copy tfad1 tfad2
|
|
set result [expr [file isdir tfad1/a/b/c] && [file isdir tfad2/a/b/c]]
|
|
file delete -force tfad1 tfad2
|
|
set result
|
|
} {1}
|
|
|
|
test fcmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} {
|
|
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} {
|
|
file delete -force -- tfad1 tfad2
|
|
|
|
file mkdir tfad1/x/y/z
|
|
file mkdir tfad2/dir
|
|
file copy tfad1 tfad2/dir
|
|
set result [expr [file isdir tfad1/x/y/z] && [file isdir 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} {
|
|
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} {
|
|
file delete -force -- tfad1 tfad2
|
|
|
|
file mkdir tfad1
|
|
file mkdir tfad2
|
|
exec ln -s tfad1 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} {
|
|
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}
|
|
|
|
cleanup
|