os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/fCmd.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/fCmd.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,2446 @@
1.4 +# This file tests the tclFCmd.c file.
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1996-1997 Sun Microsystems, Inc.
1.11 +# Copyright (c) 1999 by Scriptics Corporation.
1.12 +# Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: fCmd.test,v 1.26.2.9 2007/05/17 14:18:42 dgp Exp $
1.18 +#
1.19 +
1.20 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.21 + package require tcltest 2
1.22 + namespace import -force ::tcltest::*
1.23 +}
1.24 +
1.25 +tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
1.26 +tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]
1.27 +tcltest::testConstraint notNetworkFilesystem 0
1.28 +testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
1.29 +testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
1.30 +
1.31 +# Several tests require need to match results against the unix username
1.32 +set user {}
1.33 +if {$tcl_platform(platform) == "unix"} {
1.34 + catch {set user [exec whoami]}
1.35 + if {$user == ""} {
1.36 + catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
1.37 + }
1.38 + if {$user == ""} {
1.39 + set user "root"
1.40 + }
1.41 +}
1.42 +
1.43 +proc createfile {file {string a}} {
1.44 + set f [open $file w]
1.45 + puts -nonewline $f $string
1.46 + close $f
1.47 + return $string
1.48 +}
1.49 +
1.50 +#
1.51 +# checkcontent --
1.52 +#
1.53 +# Ensures that file "file" contains only the string "matchString"
1.54 +# returns 0 if the file does not exist, or has a different content
1.55 +#
1.56 +proc checkcontent {file matchString} {
1.57 + if {[catch {
1.58 + set f [open $file]
1.59 + set fileString [read $f]
1.60 + close $f
1.61 + }]} {
1.62 + return 0
1.63 + }
1.64 + return [string match $matchString $fileString]
1.65 +}
1.66 +
1.67 +proc openup {path} {
1.68 + testchmod 777 $path
1.69 + if {[file isdirectory $path]} {
1.70 + catch {
1.71 + foreach p [glob -directory $path *] {
1.72 + openup $p
1.73 + }
1.74 + }
1.75 + }
1.76 +}
1.77 +
1.78 +proc cleanup {args} {
1.79 + if {$::tcl_platform(platform) == "macintosh"} {
1.80 + set wd [list :]
1.81 + } else {
1.82 + set wd [list .]
1.83 + }
1.84 + foreach p [concat $wd $args] {
1.85 + set x ""
1.86 + catch {
1.87 + set x [glob -directory $p tf* td*]
1.88 + }
1.89 + foreach file $x {
1.90 + if {[catch {file delete -force -- $file}]} {
1.91 + catch {openup $file}
1.92 + catch {file delete -force -- $file}
1.93 + }
1.94 + }
1.95 + }
1.96 +}
1.97 +
1.98 +proc contents {file} {
1.99 + set f [open $file r]
1.100 + set r [read $f]
1.101 + close $f
1.102 + set r
1.103 +}
1.104 +
1.105 +cd [temporaryDirectory]
1.106 +
1.107 +set ::tcltest::testConstraints(fileSharing) 0
1.108 +set ::tcltest::testConstraints(notFileSharing) 1
1.109 +
1.110 +if {$tcl_platform(platform) == "macintosh"} {
1.111 + catch {file delete -force foo.dir}
1.112 + file mkdir foo.dir
1.113 + if {[catch {file attributes foo.dir -readonly 1}] == 0} {
1.114 + set ::tcltest::testConstraints(fileSharing) 1
1.115 + set ::tcltest::testConstraints(notFileSharing) 0
1.116 + }
1.117 + file delete -force foo.dir
1.118 +}
1.119 +
1.120 +set ::tcltest::testConstraints(xdev) 0
1.121 +
1.122 +if {$tcl_platform(platform) == "unix"} {
1.123 + if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
1.124 + set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
1.125 + set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
1.126 + if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
1.127 + set ::tcltest::testConstraints(xdev) 1
1.128 + }
1.129 + }
1.130 +}
1.131 +
1.132 +set root [lindex [file split [pwd]] 0]
1.133 +
1.134 +# A really long file name
1.135 +# length of long is 1216 chars, which should be greater than any static
1.136 +# buffer or allowable filename.
1.137 +
1.138 +set long "abcdefghihjllmnopqrstuvwxyz01234567890"
1.139 +append long $long
1.140 +append long $long
1.141 +append long $long
1.142 +append long $long
1.143 +append long $long
1.144 +
1.145 +test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
1.146 + cleanup
1.147 + createfile tf1
1.148 + file rename tf1 tf2
1.149 + glob tf*
1.150 +} {tf2}
1.151 +
1.152 +test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
1.153 + cleanup
1.154 + createfile tf1
1.155 + file copy tf1 tf2
1.156 + lsort [glob tf*]
1.157 +} {tf1 tf2}
1.158 +
1.159 +test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} {
1.160 + list [catch {file rename -xyz} msg] $msg
1.161 +} {1 {bad option "-xyz": should be -force or --}}
1.162 +test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} {
1.163 + list [catch {file rename xyz} msg] $msg
1.164 +} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
1.165 +test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {
1.166 + list [catch {file rename xyz ~_totally_bogus_user} msg] $msg
1.167 +} {1 {user "_totally_bogus_user" doesn't exist}}
1.168 +test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} {
1.169 + cleanup
1.170 + list [catch {file copy tf1 ~} msg] $msg
1.171 +} {1 {error copying "tf1": no such file or directory}}
1.172 +test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} {
1.173 + cleanup
1.174 + list [catch {file rename tf1 tf2 tf3} msg] $msg
1.175 +} {1 {error renaming: target "tf3" is not a directory}}
1.176 +test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \
1.177 + {notRoot} {
1.178 + cleanup
1.179 + createfile tf3
1.180 + list [catch {file rename tf1 tf2 tf3} msg] $msg
1.181 +} {1 {error renaming: target "tf3" is not a directory}}
1.182 +test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} {
1.183 + cleanup
1.184 + file mkdir td1
1.185 + createfile tf1 tf1
1.186 + file rename tf1 td1
1.187 + contents [file join td1 tf1]
1.188 +} {tf1}
1.189 +test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
1.190 + cleanup
1.191 + list [catch {file rename tf1 tf2 tf3} msg] $msg
1.192 +} {1 {error renaming: target "tf3" is not a directory}}
1.193 +test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
1.194 + cleanup
1.195 + list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
1.196 +} {1 {error copying: target "tf3" is not a directory}}
1.197 +test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
1.198 + cleanup
1.199 + createfile tf1 tf1
1.200 + file rename tf1 tf2
1.201 + contents tf2
1.202 +} {tf1}
1.203 +test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
1.204 + cleanup
1.205 + createfile tf1 tf1
1.206 + file rename -force -force -- tf1 tf2
1.207 + contents tf2
1.208 +} {tf1}
1.209 +test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
1.210 + cleanup
1.211 + createfile tf1 tf1
1.212 + file mkdir td1
1.213 + file rename tf1 td1
1.214 + contents [file join td1 tf1]
1.215 +} {tf1}
1.216 +test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
1.217 + cleanup
1.218 + createfile tf1 tf1
1.219 + createfile tf2 tf2
1.220 + createfile tf3 tf3
1.221 + createfile tf4 tf4
1.222 + file mkdir td1
1.223 + file rename tf1 tf2 tf3 tf4 td1
1.224 + list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
1.225 + [contents [file join td1 tf3]] [contents [file join td1 tf4]]
1.226 +} {tf1 tf2 tf3 tf4}
1.227 +test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} {
1.228 + cleanup
1.229 + file mkdir td1
1.230 + list [catch {file rename ~_totally_bogus_user td1} msg] $msg
1.231 +} {1 {user "_totally_bogus_user" doesn't exist}}
1.232 +test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} {
1.233 + cleanup
1.234 + file mkdir td1
1.235 + list [catch {file rename / td1} msg] $msg
1.236 +} {1 {error renaming "/" to "td1": file already exists}}
1.237 +test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {
1.238 + cleanup
1.239 + createfile tf1
1.240 + createfile tf2
1.241 + createfile tf3
1.242 + createfile tf4
1.243 + file mkdir td1
1.244 + createfile [file join td1 tf3]
1.245 + list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
1.246 +} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]
1.247 +
1.248 +test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
1.249 + cleanup
1.250 + file mkdir td1
1.251 + glob td*
1.252 +} {td1}
1.253 +test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
1.254 + cleanup
1.255 + file mkdir td1 td2 td3
1.256 + lsort [glob td*]
1.257 +} {td1 td2 td3}
1.258 +test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
1.259 + cleanup
1.260 + createfile tf1
1.261 + catch {file mkdir td1 td2 tf1 td3 td4}
1.262 + glob td1 td2 tf1 td3 td4
1.263 +} {td1 td2 tf1}
1.264 +test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} {
1.265 + cleanup
1.266 + list [catch {file mkdir ~_totally_bogus_user} msg] $msg
1.267 +} {1 {user "_totally_bogus_user" doesn't exist}}
1.268 +test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \
1.269 + {notRoot} {
1.270 + cleanup
1.271 + list [catch {file mkdir ""} msg] $msg
1.272 +} {1 {can't create directory "": no such file or directory}}
1.273 +test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {
1.274 + cleanup
1.275 + file mkdir td1
1.276 + glob td1
1.277 +} {td1}
1.278 +test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
1.279 + cleanup
1.280 + file mkdir [file join td1 td2 td3 td4]
1.281 + glob td1 [file join td1 td2]
1.282 +} "td1 [file join td1 td2]"
1.283 +test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
1.284 + cleanup
1.285 + file mkdir td1
1.286 + set x [file exists td1]
1.287 + file mkdir td1
1.288 + list $x [file exists td1]
1.289 +} {1 1}
1.290 +test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} {
1.291 + cleanup
1.292 + createfile tf1
1.293 + list [catch {file mkdir tf1} msg] $msg
1.294 +} [subst {1 {can't create directory "[file join tf1]": file already exists}}]
1.295 +test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
1.296 + cleanup
1.297 + file mkdir td1
1.298 + set x [file exists td1]
1.299 + file mkdir td1
1.300 + list $x [file exists td1]
1.301 +} {1 1}
1.302 +test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \
1.303 + {unixOnly notRoot testchmod} {
1.304 + cleanup
1.305 + file mkdir td1/td2/td3
1.306 + testchmod 000 td1/td2
1.307 + set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]
1.308 + testchmod 755 td1/td2
1.309 + set msg
1.310 +} {1 {can't create directory "td1/td2/td3": permission denied}}
1.311 +test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {
1.312 + cleanup
1.313 + list [catch {file mkdir nonexistentvolume:} msg] $msg
1.314 +} {1 {can't create directory "nonexistentvolume:": invalid argument}}
1.315 +test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {
1.316 + cleanup
1.317 + set x [file exists td1]
1.318 + file mkdir td1
1.319 + list $x [file exists td1]
1.320 +} {0 1}
1.321 +test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \
1.322 + {unixOnly notRoot} {
1.323 + cleanup
1.324 + file delete -force foo
1.325 + file mkdir foo
1.326 + file attr foo -perm 040000
1.327 + set result [list [catch {file mkdir foo/tf1} msg] $msg]
1.328 + file delete -force foo
1.329 + set result
1.330 +} {1 {can't create directory "foo/tf1": permission denied}}
1.331 +test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {
1.332 + list [catch {file mkdir ${root}:} msg] $msg
1.333 +} [subst {1 {can't create directory "${root}:": no such file or directory}}]
1.334 +test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
1.335 + cleanup
1.336 + file mkdir tf1
1.337 + file exists tf1
1.338 +} {1}
1.339 +
1.340 +test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} {
1.341 + list [catch {file delete -xyz} msg] $msg
1.342 +} {1 {bad option "-xyz": should be -force or --}}
1.343 +test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} {
1.344 + list [catch {file delete -force -force} msg] $msg
1.345 +} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
1.346 +test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
1.347 + cleanup
1.348 + createfile tf1
1.349 + createfile tf2
1.350 + file mkdir td1
1.351 + file delete tf2
1.352 + glob tf* td*
1.353 +} {tf1 td1}
1.354 +test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
1.355 + cleanup
1.356 + createfile tf1
1.357 + createfile tf2
1.358 + file mkdir td1
1.359 + set x [list [file exists tf1] [file exists tf2] [file exists td1]]
1.360 + file delete tf1 td1 tf2
1.361 + lappend x [file exists tf1] [file exists tf2] [file exists tf3]
1.362 +} {1 1 1 0 0 0}
1.363 +test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
1.364 + cleanup
1.365 + createfile tf1
1.366 + createfile tf2
1.367 + file mkdir td1
1.368 + catch {file delete tf1 td1 $root tf2}
1.369 + list [file exists tf1] [file exists tf2] [file exists td1]
1.370 +} {0 1 0}
1.371 +test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {
1.372 + list [catch {file delete ~_totally_bogus_user} msg] $msg
1.373 +} {1 {user "_totally_bogus_user" doesn't exist}}
1.374 +test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
1.375 + catch {file delete ~/tf1}
1.376 + createfile ~/tf1
1.377 + file delete ~/tf1
1.378 +} {}
1.379 +test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
1.380 + cleanup
1.381 + set x [file exists tf1]
1.382 + file delete tf1
1.383 + list $x [file exists tf1]
1.384 +} {0 0}
1.385 +test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
1.386 + cleanup
1.387 + file mkdir td1
1.388 + file delete td1
1.389 + file exists td1
1.390 +} {0}
1.391 +test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {
1.392 + cleanup
1.393 + file mkdir [file join td1 td2]
1.394 + list [catch {file delete td1} msg] $msg
1.395 +} {1 {error deleting "td1": directory not empty}}
1.396 +test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} {notRoot} {
1.397 + cleanup
1.398 + set dir [pwd]
1.399 + file mkdir [file join td1 td2]
1.400 + cd [file join td1 td2]
1.401 + set res [list [catch {file delete -force [file dirname [pwd]]} msg]]
1.402 + cd $dir
1.403 + lappend res [file exists td1] $msg
1.404 +} {0 0 {}}
1.405 +test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unixOnly} {
1.406 + cleanup
1.407 + file mkdir [file join td1 td2]
1.408 + #exec chmod u-rwx [file join td1 td2]
1.409 + file attributes [file join td1 td2] -permissions u+rwx
1.410 + set res [list [catch {file delete -force td1} msg]]
1.411 + lappend res [file exists td1] $msg
1.412 +} {0 0 {}}
1.413 +
1.414 +test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {
1.415 + # can't test this, because it's caught by FileCopyRename
1.416 +} {}
1.417 +test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} {
1.418 + # can't test this, because it's caught by FileCopyRename
1.419 +} {}
1.420 +test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} {
1.421 + cleanup
1.422 + list [catch {file rename tf1 tf2} msg] $msg
1.423 +} {1 {error renaming "tf1": no such file or directory}}
1.424 +test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
1.425 + cleanup
1.426 + createfile tf1
1.427 + file rename tf1 tf2
1.428 + glob tf*
1.429 +} {tf2}
1.430 +test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
1.431 + cleanup
1.432 + createfile tf1
1.433 + file rename tf1 tf2
1.434 + glob tf*
1.435 +} {tf2}
1.436 +test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot testchmod} {
1.437 + cleanup
1.438 + file mkdir td1
1.439 + testchmod 000 td1
1.440 + createfile tf1
1.441 + set msg [list [catch {file rename tf1 td1} msg] $msg]
1.442 + testchmod 755 td1
1.443 + set msg
1.444 +} {1 {error renaming "tf1" to "td1/tf1": permission denied}}
1.445 +test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {pcOnly 95} {
1.446 + cleanup
1.447 + createfile tf1
1.448 + list [catch {file rename tf1 $long} msg] $msg
1.449 +} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
1.450 +test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} {
1.451 + cleanup
1.452 + createfile tf1
1.453 + list [catch {file rename tf1 $long} msg] $msg
1.454 +} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
1.455 +test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly notRoot} {
1.456 + cleanup
1.457 + createfile tf1
1.458 + file rename tf1 tf2
1.459 + glob tf*
1.460 +} {tf2}
1.461 +test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} {
1.462 + cleanup
1.463 + createfile tf1
1.464 + createfile tf2
1.465 + list [catch {file rename tf1 tf2} msg] $msg
1.466 +} {1 {error renaming "tf1" to "tf2": file already exists}}
1.467 +test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} {
1.468 + cleanup
1.469 + createfile tf1
1.470 + createfile tf2
1.471 + list [catch {file rename tf1 tf2} msg] $msg
1.472 +} {1 {error renaming "tf1" to "tf2": file already exists}}
1.473 +test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
1.474 + cleanup
1.475 + createfile tf1
1.476 + createfile tf2
1.477 + file rename -force tf1 tf2
1.478 + glob tf*
1.479 +} {tf2}
1.480 +test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} {
1.481 + cleanup
1.482 + file mkdir td1
1.483 + file mkdir td2
1.484 + createfile [file join td2 td1]
1.485 + list [catch {file rename -force td1 td2} msg] $msg
1.486 +} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
1.487 +test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} {
1.488 + cleanup
1.489 + createfile tf1
1.490 + file mkdir [file join td1 tf1]
1.491 + list [catch {file rename -force tf1 td1} msg] $msg
1.492 +} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
1.493 +test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot notNetworkFilesystem} {
1.494 + cleanup
1.495 + file mkdir [file join td1 td2]
1.496 + file mkdir td2
1.497 + createfile [file join td2 tf1]
1.498 + file rename -force td2 td1
1.499 + file exists [file join td1 td2 tf1]
1.500 +} {1}
1.501 +test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {notRoot} {
1.502 + cleanup
1.503 + file mkdir [file join td1 td2]
1.504 + createfile [file join td1 td2 tf1]
1.505 + file mkdir td2
1.506 + list [catch {file rename -force td2 td1} msg] $msg
1.507 +} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
1.508 +
1.509 +test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} {
1.510 + cleanup
1.511 + list [catch {file rename -force $root tf1} msg] $msg
1.512 +} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
1.513 +test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {notRoot} {
1.514 + cleanup
1.515 + file mkdir [file join td1 td2]
1.516 + createfile [file join td1 td2 tf1]
1.517 + file mkdir td2
1.518 + list [catch {file rename -force td2 td1} msg] $msg
1.519 +} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
1.520 +test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} {
1.521 + cleanup /tmp
1.522 + createfile tf1
1.523 + file rename tf1 /tmp
1.524 + glob tf* /tmp/tf1
1.525 +} {/tmp/tf1}
1.526 +test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
1.527 + catch {file delete -force c:/tcl8975@ d:/tcl8975@}
1.528 + file mkdir c:/tcl8975@
1.529 + if [catch {file rename c:/tcl8975@ d:/}] {
1.530 + set msg d:/tcl8975@
1.531 + } else {
1.532 + set msg [glob c:/tcl8975@ d:/tcl8975@]
1.533 + file delete -force d:/tcl8975@
1.534 + }
1.535 + file delete -force c:/tcl8975@
1.536 + set msg
1.537 +} {d:/tcl8975@}
1.538 +test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
1.539 + {unixOnly notRoot} {
1.540 + cleanup /tmp
1.541 + file mkdir td1
1.542 + file rename td1 /tmp
1.543 + glob td* /tmp/td*
1.544 +} {/tmp/td1}
1.545 +test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
1.546 + {unixOnly notRoot} {
1.547 + cleanup /tmp
1.548 + createfile tf1
1.549 + file rename tf1 /tmp
1.550 + glob tf* /tmp/tf*
1.551 +} {/tmp/tf1}
1.552 +test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
1.553 + {unixOnly notRoot xdev} {
1.554 + cleanup /tmp
1.555 + file mkdir td1/td2/td3
1.556 + file attributes td1 -permissions 0000
1.557 + set msg [list [catch {file rename td1 /tmp} msg] $msg]
1.558 + file attributes td1 -permissions 0755
1.559 + set msg
1.560 +} {1 {error renaming "td1": permission denied}}
1.561 +test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
1.562 + {unixOnly notRoot} {
1.563 + cleanup
1.564 + file mkdir ~/td1/td2
1.565 + set td1name [file join [file dirname ~] [file tail ~] td1]
1.566 + file attributes $td1name -permissions 0000
1.567 + set msg [list [catch {file copy ~/td1 td1} msg] $msg]
1.568 + file attributes $td1name -permissions 0755
1.569 + file delete -force ~/td1
1.570 + set msg
1.571 +} {1 {error copying "~/td1": permission denied}}
1.572 +test fCmd-6.25 {CopyRenameOneFile: error uses original name} \
1.573 + {unixOnly notRoot} {
1.574 + cleanup
1.575 + file mkdir td2
1.576 + file mkdir ~/td1
1.577 + set td1name [file join [file dirname ~] [file tail ~] td1]
1.578 + file attributes $td1name -permissions 0000
1.579 + set msg [list [catch {file copy td2 ~/td1} msg] $msg]
1.580 + file attributes $td1name -permissions 0755
1.581 + file delete -force ~/td1
1.582 + set msg
1.583 +} {1 {error copying "td2" to "~/td1/td2": permission denied}}
1.584 +test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \
1.585 + {unixOnly notRoot} {
1.586 + cleanup
1.587 + file mkdir ~/td1/td2
1.588 + set td2name [file join [file dirname ~] [file tail ~] td1 td2]
1.589 + file attributes $td2name -permissions 0000
1.590 + set msg [list [catch {file copy ~/td1 td1} msg] $msg]
1.591 + file attributes $td2name -permissions 0755
1.592 + file delete -force ~/td1
1.593 + set msg
1.594 +} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
1.595 +test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \
1.596 + {unixOnly notRoot xdev} {
1.597 + cleanup /tmp
1.598 + file mkdir td1/td2/td3
1.599 + file mkdir /tmp/td1
1.600 + createfile /tmp/td1/tf1
1.601 + list [catch {file rename -force td1 /tmp} msg] $msg
1.602 +} {1 {error renaming "td1" to "/tmp/td1": file already exists}}
1.603 +test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \
1.604 + {unixOnly notRoot xdev} {
1.605 + cleanup /tmp
1.606 + file mkdir td1/td2/td3
1.607 + file attributes td1/td2/td3 -permissions 0000
1.608 + set msg [list [catch {file rename td1 /tmp} msg] $msg]
1.609 + file attributes td1/td2/td3 -permissions 0755
1.610 + set msg
1.611 +} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
1.612 +test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \
1.613 + {unixOnly notRoot xdev} {
1.614 + cleanup /tmp
1.615 + file mkdir td1/td2/td3
1.616 + file rename td1 /tmp
1.617 + glob td* /tmp/td1/t*
1.618 +} {/tmp/td1/td2}
1.619 +test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \
1.620 + {unixOnly notRoot} {
1.621 + cleanup
1.622 + file mkdir foo/bar
1.623 + file attr foo -perm 040555
1.624 + set catchResult [catch {file rename foo/bar /tmp} msg]
1.625 + set msg [lindex [split $msg :] end]
1.626 + catch {file delete /tmp/bar}
1.627 + catch {file attr foo -perm 040777}
1.628 + catch {file delete -force foo}
1.629 + list $catchResult $msg
1.630 +} {1 { permission denied}}
1.631 +test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \
1.632 + {unixOnly notRoot xdev} {
1.633 + catch {cleanup /tmp}
1.634 + file mkdir /tmp/td1
1.635 + createfile /tmp/td1/tf1
1.636 + file rename /tmp/td1/tf1 tf1
1.637 + list [file exists /tmp/td1/tf1] [file exists tf1]
1.638 +} {0 1}
1.639 +test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} {
1.640 + cleanup
1.641 + list [catch {file copy tf1 tf2} msg] $msg
1.642 +} {1 {error copying "tf1": no such file or directory}}
1.643 +catch {cleanup /tmp}
1.644 +
1.645 +test fCmd-7.1 {FileForceOption: none} {notRoot} {
1.646 + cleanup
1.647 + file mkdir [file join tf1 tf2]
1.648 + list [catch {file delete tf1} msg] $msg
1.649 +} {1 {error deleting "tf1": directory not empty}}
1.650 +test fCmd-7.2 {FileForceOption: -force} {notRoot} {
1.651 + cleanup
1.652 + file mkdir [file join tf1 tf2]
1.653 + file delete -force tf1
1.654 +} {}
1.655 +test fCmd-7.3 {FileForceOption: --} {notRoot} {
1.656 + createfile -tf1
1.657 + file delete -- -tf1
1.658 +} {}
1.659 +test fCmd-7.4 {FileForceOption: bad option} {notRoot} {
1.660 + createfile -tf1
1.661 + set msg [list [catch {file delete -tf1} msg] $msg]
1.662 + file delete -- -tf1
1.663 + set msg
1.664 +} {1 {bad option "-tf1": should be -force or --}}
1.665 +test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} {
1.666 + createfile --
1.667 + createfile -force
1.668 + file delete -force -force -- -- -force
1.669 + list [catch {glob -- -- -force} msg] $msg
1.670 +} {1 {no files matched glob patterns "-- -force"}}
1.671 +
1.672 +test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
1.673 + {unixOnly notRoot knownBug} {
1.674 + # Labelled knownBug because it is dangerous [Bug: 3881]
1.675 + file mkdir td1
1.676 + file attr td1 -perm 040000
1.677 + set result [list [catch {file rename ~$user td1} msg] $msg]
1.678 + file delete -force td1
1.679 + set result
1.680 +} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
1.681 +test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} {
1.682 + string equal [file tail ~$user] ~$user
1.683 +} 0
1.684 +test fCmd-8.3 {file copy and path translation: ensure correct error} {
1.685 + list [catch {file copy ~ [file join this file doesnt exist]} res] $res
1.686 +} [list 1 \
1.687 + "error copying \"~\" to \"[file join this file doesnt exist]\":\
1.688 + no such file or directory"]
1.689 +
1.690 +test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} {
1.691 + cleanup
1.692 + file mkdir td1
1.693 + file mkdir td2
1.694 + file attr td2 -perm 040000
1.695 + set result [list [catch {file rename td1 td2/} msg] $msg]
1.696 + file delete -force td2
1.697 + file delete -force td1
1.698 + set result
1.699 +} {1 {error renaming "td1" to "td2/td1": permission denied}}
1.700 +test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {
1.701 + cleanup
1.702 + list [catch {file rename tf1 tf2} msg] $msg
1.703 +} {1 {error renaming "tf1": no such file or directory}}
1.704 +test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} {
1.705 + cleanup
1.706 + createfile tf1
1.707 + createfile tf2
1.708 + testchmod 444 tf2
1.709 + file rename tf1 tf3
1.710 + file rename tf2 tf4
1.711 + list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
1.712 +} {{tf3 tf4} 1 0}
1.713 +test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {
1.714 + cleanup
1.715 + file mkdir td1 td2
1.716 + testchmod 555 td2
1.717 + file rename td1 td3
1.718 + file rename td2 td4
1.719 + list [lsort [glob td*]] [file writable td3] [file writable td4]
1.720 +} {{td3 td4} 1 0}
1.721 +test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
1.722 + cleanup
1.723 + createfile tf1 tf1
1.724 + createfile tf2 tf2
1.725 + testchmod 444 tf2
1.726 + file rename -force tf1 tf1
1.727 + file rename -force tf2 tf2
1.728 + list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
1.729 +} {tf1 tf2 1 0}
1.730 +test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {
1.731 + cleanup
1.732 + file mkdir td1
1.733 + file mkdir td2
1.734 + testchmod 555 td2
1.735 + file rename -force td1 .
1.736 + file rename -force td2 .
1.737 + list [lsort [glob td*]] [file writable td1] [file writable td2]
1.738 +} {{td1 td2} 1 0}
1.739 +test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {
1.740 + cleanup
1.741 + createfile tf1
1.742 + createfile tf2
1.743 + createfile tfs1
1.744 + createfile tfs2
1.745 + createfile tfs3
1.746 + createfile tfs4
1.747 + createfile tfd1
1.748 + createfile tfd2
1.749 + createfile tfd3
1.750 + createfile tfd4
1.751 + testchmod 444 tfs3
1.752 + testchmod 444 tfs4
1.753 + testchmod 444 tfd2
1.754 + testchmod 444 tfd4
1.755 + set msg [list [catch {file rename tf1 tf2} msg] $msg]
1.756 + file rename -force tfs1 tfd1
1.757 + file rename -force tfs2 tfd2
1.758 + file rename -force tfs3 tfd3
1.759 + file rename -force tfs4 tfd4
1.760 + list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
1.761 +} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
1.762 +test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod notNetworkFilesystem} {
1.763 + # Under unix, you can rename a read-only directory, but you can't
1.764 + # move it into another directory.
1.765 +
1.766 + cleanup
1.767 + file mkdir td1
1.768 + file mkdir [file join td2 td1]
1.769 + file mkdir tds1
1.770 + file mkdir tds2
1.771 + file mkdir tds3
1.772 + file mkdir tds4
1.773 + file mkdir [file join tdd1 tds1]
1.774 + file mkdir [file join tdd2 tds2]
1.775 + file mkdir [file join tdd3 tds3]
1.776 + file mkdir [file join tdd4 tds4]
1.777 + if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
1.778 + testchmod 555 tds3
1.779 + testchmod 555 tds4
1.780 + }
1.781 + if {$tcl_platform(platform) != "macintosh"} {
1.782 + testchmod 555 [file join tdd2 tds2]
1.783 + testchmod 555 [file join tdd4 tds4]
1.784 + }
1.785 + set msg [list [catch {file rename td1 td2} msg] $msg]
1.786 + file rename -force tds1 tdd1
1.787 + file rename -force tds2 tdd2
1.788 + file rename -force tds3 tdd3
1.789 + file rename -force tds4 tdd4
1.790 + if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
1.791 + set w3 [file writable [file join tdd3 tds3]]
1.792 + set w4 [file writable [file join tdd4 tds4]]
1.793 + } else {
1.794 + set w3 0
1.795 + set w4 0
1.796 + }
1.797 + list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
1.798 + [file writable [file join tdd2 tds2]] $w3 $w4
1.799 +} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
1.800 +test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot testchmod} {
1.801 + cleanup
1.802 + file mkdir tds1
1.803 + file mkdir tds2
1.804 + file mkdir [file join tdd1 tds1 xxx]
1.805 + file mkdir [file join tdd2 tds2 xxx]
1.806 + if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
1.807 + testchmod 555 tds2
1.808 + }
1.809 + set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
1.810 + set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
1.811 + if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
1.812 + set w2 [file writable tds2]
1.813 + } else {
1.814 + set w2 0
1.815 + }
1.816 + list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
1.817 +} [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}]
1.818 +test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
1.819 + cleanup
1.820 + createfile tf1
1.821 + createfile tf2
1.822 + file mkdir td1
1.823 + testchmod 444 tf2
1.824 + file rename tf1 [file join td1 tf3]
1.825 + file rename tf2 [file join td1 tf4]
1.826 + list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
1.827 + [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
1.828 +} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
1.829 +test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {
1.830 + cleanup
1.831 + file mkdir td1
1.832 + file mkdir td2
1.833 + file mkdir td3
1.834 + if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
1.835 + testchmod 555 td2
1.836 + }
1.837 + file rename td1 [file join td3 td3]
1.838 + file rename td2 [file join td3 td4]
1.839 + if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
1.840 + set w4 [file writable [file join td3 td4]]
1.841 + } else {
1.842 + set w4 0
1.843 + }
1.844 + list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
1.845 + [file writable [file join td3 td3]] $w4
1.846 +} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
1.847 +test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod notNetworkFilesystem} {
1.848 + cleanup
1.849 + file mkdir [file join td1 td2] [file join td2 td1]
1.850 + if {$tcl_platform(platform) != "macintosh"} {
1.851 + testchmod 555 [file join td2 td1]
1.852 + }
1.853 + file mkdir [file join td3 td4] [file join td4 td3]
1.854 + file rename -force td3 td4
1.855 + set msg [list [file exists td3] [file exists [file join td4 td3 td4]] \
1.856 + [catch {file rename td1 td2} msg] $msg]
1.857 + if {$tcl_platform(platform) != "macintosh"} {
1.858 + testchmod 755 [file join td2 td1]
1.859 + }
1.860 + set msg
1.861 +} [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
1.862 +test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {notRoot} {
1.863 + cleanup
1.864 + file mkdir [file join td1 td2] [file join td2 td1 td4]
1.865 + list [catch {file rename -force td1 td2} msg] $msg
1.866 +} [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
1.867 +test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
1.868 + cleanup
1.869 + file mkdir td1
1.870 + list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
1.871 +} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
1.872 +test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \
1.873 + {notRoot} {
1.874 + cleanup
1.875 + file mkdir td1
1.876 + createfile tf1
1.877 + list [catch {file rename -force td1 tf1} msg] $msg
1.878 +} {1 {can't overwrite file "tf1" with directory "td1"}}
1.879 +test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \
1.880 + {notRoot} {
1.881 + cleanup
1.882 + file mkdir td1/tf1
1.883 + createfile tf1
1.884 + list [catch {file rename -force tf1 td1} msg] $msg
1.885 +} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
1.886 +
1.887 +test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {
1.888 + cleanup
1.889 + list [catch {file copy tf1 tf2} msg] $msg
1.890 +} {1 {error copying "tf1": no such file or directory}}
1.891 +test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
1.892 + cleanup
1.893 + createfile tf1 tf1
1.894 + createfile tf2 tf2
1.895 + testchmod 444 tf2
1.896 + file copy tf1 tf3
1.897 + file copy tf2 tf4
1.898 + list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
1.899 +} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
1.900 +test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 95or98 testchmod} {
1.901 + cleanup
1.902 + file mkdir [file join td1 tdx]
1.903 + file mkdir [file join td2 tdy]
1.904 + testchmod 555 td2
1.905 + file copy td1 td3
1.906 + file copy td2 td4
1.907 + set msg [list [lsort [glob td*]] [glob -directory td3 t*] \
1.908 + [glob -directory td4 t*] [file writable td3] [file writable td4]]
1.909 + if {$tcl_platform(platform) != "macintosh"} {
1.910 + testchmod 755 td2
1.911 + testchmod 755 td4
1.912 + }
1.913 + set msg
1.914 +} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
1.915 +test fCmd-10.3.1 {file copy: comprehensive: dir to new name} {notRoot pc 2000orNewer testchmod} {
1.916 + # On Windows with ACLs, copying a directory is defined like this
1.917 + cleanup
1.918 + file mkdir [file join td1 tdx]
1.919 + file mkdir [file join td2 tdy]
1.920 + testchmod 555 td2
1.921 + file copy td1 td3
1.922 + file copy td2 td4
1.923 + set msg [list [lsort [glob td*]] [glob -directory td3 t*] \
1.924 + [glob -directory td4 t*] [file writable td3] [file writable td4]]
1.925 + testchmod 755 td2
1.926 + testchmod 755 td4
1.927 + set msg
1.928 +} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1}]
1.929 +test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} {
1.930 + cleanup
1.931 + createfile tf1
1.932 + createfile tf2
1.933 + createfile tfs1
1.934 + createfile tfs2
1.935 + createfile tfs3
1.936 + createfile tfs4
1.937 + createfile tfd1
1.938 + createfile tfd2
1.939 + createfile tfd3
1.940 + createfile tfd4
1.941 + testchmod 444 tfs3
1.942 + testchmod 444 tfs4
1.943 + testchmod 444 tfd2
1.944 + testchmod 444 tfd4
1.945 + set msg [list [catch {file copy tf1 tf2} msg] $msg]
1.946 + file copy -force tfs1 tfd1
1.947 + file copy -force tfs2 tfd2
1.948 + file copy -force tfs3 tfd3
1.949 + file copy -force tfs4 tfd4
1.950 + list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
1.951 +} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
1.952 +test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {
1.953 + cleanup
1.954 + file mkdir td1
1.955 + file mkdir [file join td2 td1]
1.956 + file mkdir tds1
1.957 + file mkdir tds2
1.958 + file mkdir tds3
1.959 + file mkdir tds4
1.960 + file mkdir [file join tdd1 tds1]
1.961 + file mkdir [file join tdd2 tds2]
1.962 + file mkdir [file join tdd3 tds3]
1.963 + file mkdir [file join tdd4 tds4]
1.964 + if {$tcl_platform(platform) != "macintosh"} {
1.965 + testchmod 555 tds3
1.966 + testchmod 555 tds4
1.967 + testchmod 555 [file join tdd2 tds2]
1.968 + testchmod 555 [file join tdd4 tds4]
1.969 + }
1.970 + set a1 [list [catch {file copy td1 td2} msg] $msg]
1.971 + set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
1.972 + set a3 [catch {file copy -force tds2 tdd2}]
1.973 + set a4 [catch {file copy -force tds3 tdd3}]
1.974 + set a5 [catch {file copy -force tds4 tdd4}]
1.975 + list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
1.976 +} [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}]
1.977 +test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
1.978 + {notRoot unixOrPc testchmod} {
1.979 + cleanup
1.980 + file mkdir tds1
1.981 + file mkdir tds2
1.982 + file mkdir [file join tdd1 tds1 xxx]
1.983 + file mkdir [file join tdd2 tds2 xxx]
1.984 + testchmod 555 tds2
1.985 + set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
1.986 + set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
1.987 + list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
1.988 +} [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}]
1.989 +test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
1.990 + cleanup
1.991 + createfile tf1
1.992 + createfile tf2
1.993 + file mkdir td1
1.994 + testchmod 444 tf2
1.995 + file copy tf1 [file join td1 tf3]
1.996 + file copy tf2 [file join td1 tf4]
1.997 + list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \
1.998 + [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
1.999 +} [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
1.1000 +test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
1.1001 + {notRoot unixOrPc 95or98 testchmod} {
1.1002 + cleanup
1.1003 + file mkdir td1
1.1004 + file mkdir td2
1.1005 + file mkdir td3
1.1006 + testchmod 555 td2
1.1007 + file copy td1 [file join td3 td3]
1.1008 + file copy td2 [file join td3 td4]
1.1009 + list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
1.1010 + [file writable [file join td3 td3]] [file writable [file join td3 td4]]
1.1011 +} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
1.1012 +test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} \
1.1013 + {notRoot pc 2000orNewer testchmod} {
1.1014 + # On Windows with ACLs, copying a directory is defined like this
1.1015 + cleanup
1.1016 + file mkdir td1
1.1017 + file mkdir td2
1.1018 + file mkdir td3
1.1019 + testchmod 555 td2
1.1020 + file copy td1 [file join td3 td3]
1.1021 + file copy td2 [file join td3 td4]
1.1022 + list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
1.1023 + [file writable [file join td3 td3]] [file writable [file join td3 td4]]
1.1024 +} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
1.1025 +test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \
1.1026 + {notRoot} {
1.1027 + cleanup
1.1028 + file mkdir td1
1.1029 + createfile tf1
1.1030 + list [catch {file copy -force td1 tf1} msg] $msg
1.1031 +} {1 {can't overwrite file "tf1" with directory "td1"}}
1.1032 +test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \
1.1033 + {notRoot} {
1.1034 + cleanup
1.1035 + file mkdir [file join td1 tf1]
1.1036 + createfile tf1
1.1037 + list [catch {file copy -force tf1 td1} msg] $msg
1.1038 +} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
1.1039 +test fCmd-10.11 {file copy: copy to empty file name} {
1.1040 + cleanup
1.1041 + createfile tf1
1.1042 + list [catch {file copy tf1 ""} msg] $msg
1.1043 +} {1 {error copying "tf1" to "": no such file or directory}}
1.1044 +test fCmd-10.12 {file rename: rename to empty file name} {
1.1045 + cleanup
1.1046 + createfile tf1
1.1047 + list [catch {file rename tf1 ""} msg] $msg
1.1048 +} {1 {error renaming "tf1" to "": no such file or directory}}
1.1049 +cleanup
1.1050 +
1.1051 +# old tests
1.1052 +
1.1053 +test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
1.1054 + catch {file delete -force -- -tfa1}
1.1055 + set s [createfile -tfa1]
1.1056 + file rename -- -tfa1 tfa2
1.1057 + set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]
1.1058 + file delete tfa2
1.1059 + set result
1.1060 +} {1}
1.1061 +
1.1062 +test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} {
1.1063 + catch {file delete -force -- tfa1}
1.1064 + set s [createfile tfa1]
1.1065 + set r1 [catch {file rename -x tfa1 tfa2}]
1.1066 + set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
1.1067 + file delete tfa1
1.1068 + set result
1.1069 +} {1}
1.1070 +
1.1071 +test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
1.1072 + catch {file rename -- }
1.1073 +} {1}
1.1074 +
1.1075 +test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} {
1.1076 + global env
1.1077 + set temp $env(HOME)
1.1078 + unset env(HOME)
1.1079 + set result [catch {file rename tfa ~/foobar }]
1.1080 + set env(HOME) $temp
1.1081 + set result
1.1082 + } {1}
1.1083 +
1.1084 +test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
1.1085 + catch {file delete -force -- tfa1 tfa2 tfa3}
1.1086 + createfile tfa1
1.1087 + createfile tfa2
1.1088 + createfile tfa3
1.1089 + set result [catch {file rename tfa1 tfa2 tfa3}]
1.1090 + file delete tfa1 tfa2 tfa3
1.1091 + set result
1.1092 +} {1}
1.1093 +
1.1094 +test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} {
1.1095 + catch {file delete -force -- tfa1 tfad}
1.1096 + set s [createfile tfa1]
1.1097 + file mkdir tfad
1.1098 + file rename tfa1 tfad
1.1099 + set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]
1.1100 + file delete -force tfad
1.1101 + set result
1.1102 +} {1}
1.1103 +
1.1104 +test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
1.1105 + catch {file delete -force -- tfa1 tfa2 tfad}
1.1106 + set s1 [createfile tfa1 ]
1.1107 + set s2 [createfile tfa2 ]
1.1108 + file mkdir tfad
1.1109 + file rename tfa1 tfa2 tfad
1.1110 + set r1 [checkcontent tfad/tfa1 $s1]
1.1111 + set r2 [checkcontent tfad/tfa2 $s2]
1.1112 +
1.1113 + set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
1.1114 +
1.1115 + file delete -force tfad
1.1116 + set result
1.1117 +} {1}
1.1118 +
1.1119 +test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} {
1.1120 + catch {file delete -force -- tfa tfad}
1.1121 + set s [createfile tfa ]
1.1122 + file mkdir tfad
1.1123 + file mkdir tfad/tfa
1.1124 + set r1 [catch {file rename tfa tfad}]
1.1125 + set r2 [checkcontent tfa $s]
1.1126 + set r3 [file isdir tfad]
1.1127 + set result [expr $r1 && $r2 && $r3 ]
1.1128 + file delete -force tfa tfad
1.1129 + set result
1.1130 +} {1}
1.1131 +
1.1132 +#
1.1133 +# Coverage tests for renamefile() ;
1.1134 +#
1.1135 +test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} {
1.1136 + global env
1.1137 + set temp $env(HOME)
1.1138 + unset env(HOME)
1.1139 + set result [catch {file rename ~/tfa1 tfa2}]
1.1140 + set env(HOME) $temp
1.1141 + set result
1.1142 +} {1}
1.1143 +
1.1144 +test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} {
1.1145 + global env
1.1146 + set temp $env(HOME)
1.1147 + unset env(HOME)
1.1148 + set s [createfile tfa1]
1.1149 + file mkdir tfad
1.1150 + set result [catch {file rename tfa1 ~/tfa2 tfad}]
1.1151 + set env(HOME) $temp
1.1152 + file delete -force tfad
1.1153 + set result
1.1154 +} {1}
1.1155 +
1.1156 +test fCmd-12.3 {renamefile: stat failing on source} {notRoot} {
1.1157 + catch {file delete -force -- tfa1 tfa2}
1.1158 + set r1 [catch {file rename tfa1 tfa2}]
1.1159 + expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
1.1160 +} {1}
1.1161 +
1.1162 +test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} {
1.1163 + catch {file delete -force -- tfa tfad}
1.1164 + set s1 [createfile tfa ]
1.1165 + file mkdir tfad
1.1166 + file mkdir tfad/tfa
1.1167 + set r1 [catch {file rename tfa tfad}]
1.1168 + set r2 [checkcontent tfa $s1]
1.1169 + set r3 [file isdir tfad/tfa]
1.1170 + set result [expr $r1 && $r2 && $r3]
1.1171 + file delete -force tfa tfad
1.1172 + set result
1.1173 +} {1}
1.1174 +
1.1175 +test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} {
1.1176 + catch {file delete -force -- tfa tfad}
1.1177 + file mkdir tfa
1.1178 + file mkdir tfad
1.1179 + set s [createfile tfad/tfa]
1.1180 + set r1 [catch {file rename tfa tfad}]
1.1181 + set r2 [checkcontent tfad/tfa $s]
1.1182 + set r3 [file isdir tfad]
1.1183 + set r4 [file isdir tfa]
1.1184 + set result [expr $r1 && $r2 && $r3 && $r4 ]
1.1185 + file delete -force tfa tfad
1.1186 + set result
1.1187 +} {1}
1.1188 +
1.1189 +test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} {
1.1190 + catch {file delete -force -- tfa1 tfa2}
1.1191 + set s [createfile tfa1]
1.1192 + file rename tfa1 tfa2
1.1193 + set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]
1.1194 + file delete tfa2
1.1195 + set result
1.1196 +} {1}
1.1197 +
1.1198 +test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
1.1199 + catch {file delete -force -- tfad}
1.1200 + file mkdir tfad
1.1201 + file mkdir tfad/dir
1.1202 + set result [catch {file rename tfad tfad/dir}]
1.1203 + file delete -force tfad
1.1204 + set result
1.1205 +} {1}
1.1206 +
1.1207 +test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} {
1.1208 + catch {file delete -force -- tfa}
1.1209 + file mkdir tfa
1.1210 + file mkdir tfa/dir
1.1211 + file attributes tfa -permissions 0555
1.1212 + set result [catch {file rename tfa/dir tfa2}]
1.1213 + file attributes tfa -permissions 0777
1.1214 + file delete -force tfa
1.1215 + set result
1.1216 +} {1}
1.1217 +
1.1218 +
1.1219 +test fCmd-12.9 {renamefile: moving a file across volumes} {unixOnly notRoot} {
1.1220 + catch {file delete -force -- tfa /tmp/tfa}
1.1221 + set s [createfile tfa ]
1.1222 + file rename tfa /tmp
1.1223 + set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]
1.1224 + file delete /tmp/tfa
1.1225 + set result
1.1226 +} {1}
1.1227 +
1.1228 +test fCmd-12.10 {renamefile: moving a directory across volumes } \
1.1229 + {unixOnly notRoot} {
1.1230 + catch {file delete -force -- tfad /tmp/tfad}
1.1231 + file mkdir tfad
1.1232 + set s [createfile tfad/a ]
1.1233 + file rename tfad /tmp
1.1234 + set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]
1.1235 + file delete -force /tmp/tfad
1.1236 + set result
1.1237 +} {1}
1.1238 +
1.1239 +#
1.1240 +# Coverage tests for TclCopyFilesCmd()
1.1241 +#
1.1242 +test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} {
1.1243 + catch {file delete -force -- tfa1}
1.1244 + set s [createfile tfa1]
1.1245 + file copy -force tfa1 tfa2
1.1246 + set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
1.1247 + file delete tfa1 tfa2
1.1248 + set result
1.1249 +} {1}
1.1250 +
1.1251 +test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} {
1.1252 + catch {file delete -force -- tfa1}
1.1253 + set s [createfile -tfa1]
1.1254 + file copy -- -tfa1 tfa2
1.1255 + set result [expr [checkcontent tfa2 $s] && [checkcontent -tfa1 $s]]
1.1256 + file delete -- -tfa1 tfa2
1.1257 + set result
1.1258 +} {1}
1.1259 +
1.1260 +test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} {
1.1261 + catch {file delete -force -- tfa1}
1.1262 + set s [createfile tfa1]
1.1263 + set r1 [catch {file copy -x tfa1 tfa2}]
1.1264 + set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
1.1265 + file delete tfa1
1.1266 + set result
1.1267 +} {1}
1.1268 +
1.1269 +test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
1.1270 + catch {file copy -- }
1.1271 +} {1}
1.1272 +
1.1273 +test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
1.1274 + global env
1.1275 + set temp $env(HOME)
1.1276 + unset env(HOME)
1.1277 + set result [catch {file copy tfa ~/foobar }]
1.1278 + set env(HOME) $temp
1.1279 + set result
1.1280 + } {1}
1.1281 +
1.1282 +test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
1.1283 + catch {file delete -force -- tfa1 tfa2 tfa3}
1.1284 + createfile tfa1
1.1285 + createfile tfa2
1.1286 + createfile tfa3
1.1287 + set result [catch {file copy tfa1 tfa2 tfa3}]
1.1288 + file delete tfa1 tfa2 tfa3
1.1289 + set result
1.1290 +} {1}
1.1291 +
1.1292 +test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} {
1.1293 + catch {file delete -force -- tfa1 tfad}
1.1294 + set s [createfile tfa1]
1.1295 + file mkdir tfad
1.1296 + file copy tfa1 tfad
1.1297 + set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
1.1298 + file delete -force tfad tfa1
1.1299 + set result
1.1300 +} {1}
1.1301 +
1.1302 +test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} {
1.1303 + catch {file delete -force -- tfa1 tfa2 tfad}
1.1304 + set s1 [createfile tfa1 ]
1.1305 + set s2 [createfile tfa2 ]
1.1306 + file mkdir tfad
1.1307 + file copy tfa1 tfa2 tfad
1.1308 + set r1 [checkcontent tfad/tfa1 $s1]
1.1309 + set r2 [checkcontent tfad/tfa2 $s2]
1.1310 + set r3 [checkcontent tfa1 $s1]
1.1311 + set r4 [checkcontent tfa2 $s2]
1.1312 + set result [expr $r1 && $r2 && $r3 && $r4 ]
1.1313 +
1.1314 + file delete -force tfad tfa1 tfa2
1.1315 + set result
1.1316 +} {1}
1.1317 +
1.1318 +test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
1.1319 + catch {file delete -force -- tfa tfad}
1.1320 + set s [createfile tfa ]
1.1321 + file mkdir tfad
1.1322 + file mkdir tfad/tfa
1.1323 + set r1 [catch {file copy tfa tfad}]
1.1324 + set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
1.1325 + set r3 [file isdir tfad]
1.1326 + set result [expr $r1 && $r2 && $r3 ]
1.1327 + file delete -force tfa tfad
1.1328 + set result
1.1329 +} {1}
1.1330 +
1.1331 +#
1.1332 +# Coverage tests for copyfile()
1.1333 +#
1.1334 +test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
1.1335 + global env
1.1336 + set temp $env(HOME)
1.1337 + unset env(HOME)
1.1338 + set result [catch {file copy ~/tfa1 tfa2}]
1.1339 + set env(HOME) $temp
1.1340 + set result
1.1341 +} {1}
1.1342 +
1.1343 +test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {
1.1344 + global env
1.1345 + set temp $env(HOME)
1.1346 + unset env(HOME)
1.1347 + set s [createfile tfa1]
1.1348 + file mkdir tfad
1.1349 + set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
1.1350 + set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
1.1351 + set env(HOME) $temp
1.1352 + file delete -force tfa1 tfad
1.1353 + set result
1.1354 +} {1}
1.1355 +
1.1356 +test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {
1.1357 + catch {file delete -force -- tfa1 tfa2}
1.1358 + set r1 [catch {file copy tfa1 tfa2}]
1.1359 + expr $r1 && ![file exists tfa1] && ![file exists tfa2]
1.1360 +} {1}
1.1361 +
1.1362 +test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {
1.1363 + catch {file delete -force -- tfa tfad}
1.1364 + set s1 [createfile tfa ]
1.1365 + file mkdir tfad
1.1366 + file mkdir tfad/tfa
1.1367 + set r1 [catch {file copy tfa tfad}]
1.1368 + set r2 [checkcontent tfa $s1]
1.1369 + set r3 [file isdir tfad]
1.1370 + set r4 [file isdir tfad/tfa]
1.1371 + set result [expr $r1 && $r2 && $r3 && $r4 ]
1.1372 + file delete -force tfa tfad
1.1373 + set result
1.1374 +} {1}
1.1375 +
1.1376 + test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {
1.1377 + catch {file delete -force -- tfa tfad}
1.1378 + file mkdir tfa
1.1379 + file mkdir tfad
1.1380 + set s [createfile tfad/tfa]
1.1381 + set r1 [catch {file copy tfa tfad}]
1.1382 + set r2 [checkcontent tfad/tfa $s]
1.1383 + set r3 [file isdir tfad]
1.1384 + set r4 [file isdir tfa]
1.1385 + set result [expr $r1 && $r2 && $r3 && $r4 ]
1.1386 + file delete -force tfa tfad
1.1387 + set result
1.1388 +} {1}
1.1389 +
1.1390 +test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {
1.1391 + catch {file delete -force -- tfa tfa2}
1.1392 + set s [createfile tfa]
1.1393 + file copy tfa tfa2
1.1394 + set result [expr [checkcontent tfa $s] && [checkcontent tfa2 $s]]
1.1395 + file delete tfa tfa2
1.1396 + set result
1.1397 +} {1}
1.1398 +
1.1399 +test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
1.1400 + catch {file delete -force -- tfa tfa2}
1.1401 + file mkdir tfa
1.1402 + set s [createfile tfa/file]
1.1403 + file copy tfa tfa2
1.1404 + set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
1.1405 + file delete -force tfa tfa2
1.1406 + set result
1.1407 +} {1}
1.1408 +
1.1409 +test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {
1.1410 + catch {file delete -force -- tfa}
1.1411 + file mkdir tfa/dir/a/b/c
1.1412 + file attributes tfa/dir -permissions 0000
1.1413 + set r1 [catch {file copy tfa tfa2}]
1.1414 + file attributes tfa/dir -permissions 0777
1.1415 + set result $r1
1.1416 + file delete -force tfa tfa2
1.1417 + set result
1.1418 +} {1}
1.1419 +
1.1420 +#
1.1421 +# Coverage tests for TclMkdirCmd()
1.1422 +#
1.1423 +test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
1.1424 + global env
1.1425 + set temp $env(HOME)
1.1426 + unset env(HOME)
1.1427 + set result [catch {file mkdir ~/tfa}]
1.1428 + set env(HOME) $temp
1.1429 + set result
1.1430 +} {1}
1.1431 +#
1.1432 +# Can Tcl_SplitPath return argc == 0? If so them we need a
1.1433 +# test for that code.
1.1434 +#
1.1435 +test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} {
1.1436 + catch {file delete -force -- tfa}
1.1437 + file mkdir tfa
1.1438 + set result [file isdirectory tfa]
1.1439 + file delete tfa
1.1440 + set result
1.1441 +} {1}
1.1442 +
1.1443 +test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {
1.1444 + catch {file delete -force -- tfa1 tfa2}
1.1445 + file mkdir tfa1 tfa2
1.1446 + set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
1.1447 + file delete tfa1 tfa2
1.1448 + set result
1.1449 +} {1}
1.1450 +
1.1451 +test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {
1.1452 + catch {file delete -force -- tfa}
1.1453 + file mkdir tfa
1.1454 + createfile tfa/file
1.1455 + file attributes tfa -permissions 0000
1.1456 + set result [catch {file mkdir tfa/file}]
1.1457 + file attributes tfa -permissions 0777
1.1458 + file delete -force tfa
1.1459 + set result
1.1460 +} {1}
1.1461 +
1.1462 +test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \
1.1463 + {notRoot} {
1.1464 + catch {file delete -force -- tfa}
1.1465 + file mkdir tfa/a/b/c
1.1466 + set result [file isdir tfa/a/b/c]
1.1467 + file delete -force tfa
1.1468 + set result
1.1469 +} {1}
1.1470 +
1.1471 +
1.1472 +test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {
1.1473 + catch {file delete -force -- tfa}
1.1474 + set s [createfile tfa]
1.1475 + set r1 [catch {file mkdir tfa}]
1.1476 + set r2 [file isdir tfa]
1.1477 + set r3 [file exists tfa]
1.1478 + set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
1.1479 + file delete tfa
1.1480 + set result
1.1481 +} {1}
1.1482 +
1.1483 +test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {
1.1484 + catch {file delete -force -- tfa1 tfa2}
1.1485 + file mkdir tfa1 tfa2/a/b/c
1.1486 + set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
1.1487 + file delete -force tfa1 tfa2
1.1488 + set result
1.1489 +} {1}
1.1490 +
1.1491 +test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {
1.1492 + file mkdir tfa
1.1493 + file mkdir tfa
1.1494 + set result [file isdir tfa]
1.1495 + file delete tfa
1.1496 + set result
1.1497 +} {1}
1.1498 +
1.1499 +
1.1500 +# Coverage tests for TclDeleteFilesCommand()
1.1501 +test fCmd-16.1 {test the -- argument} {notRoot} {
1.1502 + catch {file delete -force -- tfa}
1.1503 + createfile tfa
1.1504 + file delete -- tfa
1.1505 + file exists tfa
1.1506 +} {0}
1.1507 +
1.1508 +test fCmd-16.2 {test the -force and -- arguments} {notRoot} {
1.1509 + catch {file delete -force -- tfa}
1.1510 + createfile tfa
1.1511 + file delete -force -- tfa
1.1512 + file exists tfa
1.1513 +} {0}
1.1514 +
1.1515 +test fCmd-16.3 {test bad option} {notRoot} {
1.1516 + catch {file delete -force -- tfa}
1.1517 + createfile tfa
1.1518 + set result [catch {file delete -dog tfa}]
1.1519 + file delete tfa
1.1520 + set result
1.1521 +} {1}
1.1522 +
1.1523 +test fCmd-16.4 {test not enough args} {notRoot} {
1.1524 + catch {file delete}
1.1525 +} {1}
1.1526 +
1.1527 +test fCmd-16.5 {test not enough args with options} {notRoot} {
1.1528 + catch {file delete --}
1.1529 +} {1}
1.1530 +
1.1531 +test fCmd-16.6 {delete: source filename translation failing} {notRoot} {
1.1532 + global env
1.1533 + set temp $env(HOME)
1.1534 + unset env(HOME)
1.1535 + set result [catch {file delete ~/tfa}]
1.1536 + set env(HOME) $temp
1.1537 + set result
1.1538 +} {1}
1.1539 +
1.1540 +test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {
1.1541 + catch {file delete -force -- tfa}
1.1542 + file mkdir tfa
1.1543 + createfile tfa/a
1.1544 + set result [catch {file delete tfa }]
1.1545 + file delete -force tfa
1.1546 + set result
1.1547 +} {1}
1.1548 +
1.1549 +test fCmd-16.8 {remove a normal file } {notRoot} {
1.1550 + catch {file delete -force -- tfa}
1.1551 + file mkdir tfa
1.1552 + createfile tfa/a
1.1553 + set result [catch {file delete tfa }]
1.1554 + file delete -force tfa
1.1555 + set result
1.1556 +} {1}
1.1557 +
1.1558 +test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {
1.1559 + catch {file delete -force -- tfa}
1.1560 + file mkdir tfa
1.1561 + createfile tfa/a
1.1562 + file attributes tfa -permissions 0555
1.1563 + set result [catch {file delete tfa/a }]
1.1564 + #######
1.1565 + ####### If any directory in a tree that is being removed does not
1.1566 + ####### have write permission, the process will fail!
1.1567 + ####### This is also the case with "rm -rf"
1.1568 + #######
1.1569 + file attributes tfa -permissions 0777
1.1570 + file delete -force tfa
1.1571 + set result
1.1572 +} {1}
1.1573 +
1.1574 +test fCmd-16.10 {deleting multiple files} {notRoot} {
1.1575 + catch {file delete -force -- tfa1 tfa2}
1.1576 + createfile tfa1
1.1577 + createfile tfa2
1.1578 + file delete tfa1 tfa2
1.1579 + expr ![file exists tfa1] && ![file exists tfa2]
1.1580 +} {1}
1.1581 +
1.1582 +test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
1.1583 + catch {file delete -force -- tfa}
1.1584 + file delete tfa
1.1585 + set result 1
1.1586 +} {1}
1.1587 +
1.1588 +# More coverage tests for mkpath()
1.1589 + test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {
1.1590 + catch {file delete -force -- tfa1}
1.1591 + file mkdir tfa1
1.1592 + file attributes tfa1 -permissions 0555
1.1593 + set result [catch {file mkdir tfa1/tfa2}]
1.1594 + file attributes tfa1 -permissions 0777
1.1595 + file delete -force tfa1
1.1596 + set result
1.1597 +} {1}
1.1598 +
1.1599 +test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {
1.1600 + catch {file delete -force -- tfa}
1.1601 + file mkdir tfa/a/b
1.1602 + set result [file isdir tfa/a/b ]
1.1603 + file delete tfa/a/b tfa/a tfa
1.1604 + set result
1.1605 +} {1}
1.1606 +
1.1607 +test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {
1.1608 + catch {file delete -force -- tfa}
1.1609 + set f [file join [pwd] tfa a ]
1.1610 + file mkdir $f
1.1611 + set result [file isdir $f ]
1.1612 + file delete $f [file join [pwd] tfa]
1.1613 + set result
1.1614 +} {1}
1.1615 +
1.1616 +#
1.1617 +# Functionality tests for TclFileRenameCmd()
1.1618 +#
1.1619 +
1.1620 +test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
1.1621 + {notRoot} {
1.1622 + catch {file delete -force -- tfad}
1.1623 + file mkdir tfad/dir
1.1624 + cd tfad/dir
1.1625 + set s [createfile foo ]
1.1626 + file rename foo bar
1.1627 + file rename bar ./foo
1.1628 + file rename ./foo bar
1.1629 + file rename ./bar ./foo
1.1630 + file rename foo ../dir/bar
1.1631 + file rename ../dir/bar ./foo
1.1632 + file rename ../../tfad/dir/foo ../../tfad/dir/bar
1.1633 + file rename [file join [pwd] bar] foo
1.1634 + file rename foo [file join [pwd] bar]
1.1635 + set result [expr [checkcontent bar $s] && ![file exists foo]]
1.1636 + cd ../..
1.1637 + file delete -force tfad
1.1638 + set result
1.1639 +} {1}
1.1640 +
1.1641 +test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {
1.1642 + catch {file delete -force -- tfa1 tfa2}
1.1643 + file mkdir tfa1
1.1644 + file rename tfa1 tfa2
1.1645 + set result [expr [file exists tfa2] && ![file exists tfa1]]
1.1646 + file delete tfa2
1.1647 + set result
1.1648 +} {1}
1.1649 +
1.1650 +test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {
1.1651 + catch {file delete -force -- tfa1 tfad1 tfad2}
1.1652 + set s [createfile tfa1 ]
1.1653 + file mkdir tfad1 tfad2
1.1654 + file rename tfa1 tfad1 tfad2
1.1655 + set r1 [checkcontent tfad2/tfa1 $s]
1.1656 + set r2 [file isdir tfad2/tfad1]
1.1657 + set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
1.1658 + file delete tfad2/tfa1
1.1659 + file delete -force tfad2
1.1660 + set result
1.1661 +} {1}
1.1662 +
1.1663 +test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {
1.1664 + catch {file delete -force -- tfa tfad}
1.1665 + set s [createfile tfa ]
1.1666 + file mkdir tfad
1.1667 + set r1 [catch {file rename tfad tfa}]
1.1668 + set r2 [checkcontent tfa $s]
1.1669 + set r3 [file isdir tfad]
1.1670 + set result [expr $r1 && $r2 && $r3 ]
1.1671 + file delete tfa tfad
1.1672 + set result
1.1673 +} {1}
1.1674 +
1.1675 +test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {
1.1676 + catch {file delete -force -- tfa tfad}
1.1677 + set s [createfile tfa ]
1.1678 + file mkdir tfad/tfa
1.1679 + set r1 [catch {file rename tfa tfad}]
1.1680 + set r2 [checkcontent tfa $s]
1.1681 + set r3 [file isdir tfad/tfa]
1.1682 + set result [expr $r1 && $r2 && $r3 ]
1.1683 + file delete -force tfa tfad
1.1684 + set result
1.1685 +} {1}
1.1686 +
1.1687 +#
1.1688 +# On Windows there is no easy way to determine if two files are the same
1.1689 +#
1.1690 +test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} {
1.1691 + catch {file delete -force -- tfa}
1.1692 + set s [createfile tfa]
1.1693 + set r1 [catch {file rename tfa tfa}]
1.1694 + set result [expr $r1 && [checkcontent tfa $s]]
1.1695 + file delete tfa
1.1696 + set result
1.1697 +} {1}
1.1698 +
1.1699 +test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \
1.1700 + {notRoot} {
1.1701 + catch {file delete -force -- tfa tfad}
1.1702 + file mkdir tfa tfad/tfa
1.1703 + set r1 [catch {file rename tfa tfad}]
1.1704 + set result [expr $r1 && [file isdir tfa]]
1.1705 + file delete -force tfa tfad
1.1706 + set result
1.1707 +} {1}
1.1708 +
1.1709 +test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \
1.1710 + {notRoot notNetworkFilesystem} {
1.1711 + catch {file delete -force -- tfa tfad}
1.1712 + file mkdir tfa tfad/tfa
1.1713 + file rename -force tfa tfad
1.1714 + set result [expr ![file isdir tfa]]
1.1715 + file delete -force tfad
1.1716 + set result
1.1717 +} {1}
1.1718 +
1.1719 +test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \
1.1720 + {notRoot} {
1.1721 + catch {file delete -force -- tfa tfad}
1.1722 + file mkdir tfa tfad/tfa/file
1.1723 + set r1 [catch {file rename tfa tfad}]
1.1724 + set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
1.1725 + file delete -force tfa tfad
1.1726 + set result
1.1727 +} {1}
1.1728 +
1.1729 +test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \
1.1730 + {notRoot notNetworkFilesystem} {
1.1731 + catch {file delete -force -- tfa tfad}
1.1732 + file mkdir tfa tfad/tfa/file
1.1733 + set r1 [catch {file rename -force tfa tfad}]
1.1734 + set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
1.1735 + file delete -force tfa tfad
1.1736 + set result
1.1737 +} {1}
1.1738 +
1.1739 +test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {
1.1740 + catch {file delete -force -- tfa1}
1.1741 + set r1 [catch {file rename tfa1 tfa2}]
1.1742 + set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
1.1743 +} {1}
1.1744 +
1.1745 +test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
1.1746 + {unixOnly notRoot} {
1.1747 + catch {file delete -force -- tfa1 tfa2 tfa3}
1.1748 +
1.1749 + set s [createfile tfa1]
1.1750 + file link -symbolic tfa2 tfa1
1.1751 + file rename tfa2 tfa3
1.1752 + set t [file type tfa3]
1.1753 + set result [expr {$t eq "link"}]
1.1754 + file delete tfa1 tfa3
1.1755 + set result
1.1756 +} {1}
1.1757 +
1.1758 +test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
1.1759 + {unixOnly notRoot} {
1.1760 + catch {file delete -force -- tfa1 tfa2 tfa3}
1.1761 +
1.1762 + file mkdir tfa1
1.1763 + file link -symbolic tfa2 tfa1
1.1764 + file rename tfa2 tfa3
1.1765 + set t [file type tfa3]
1.1766 + set result [expr {$t eq "link"}]
1.1767 + file delete tfa1 tfa3
1.1768 + set result
1.1769 +} {1}
1.1770 +
1.1771 +test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
1.1772 + {unixOnly notRoot} {
1.1773 + catch {file delete -force -- tfa1 tfa2 tfa3}
1.1774 +
1.1775 + file mkdir tfa1/a/b/c/d
1.1776 + file mkdir tfa2
1.1777 + set f [file join [pwd] tfa1/a/b]
1.1778 + set f2 [file join [pwd] {tfa2/b alias}]
1.1779 + file link -symbolic $f2 $f
1.1780 + file rename {tfa2/b alias/c} tfa3
1.1781 + set r1 [file isdir tfa3]
1.1782 + set r2 [file exists tfa1/a/b/c]
1.1783 + set result [expr $r1 && !$r2]
1.1784 + file delete -force tfa1 tfa2 tfa3
1.1785 + set result
1.1786 +} {1}
1.1787 +
1.1788 +test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
1.1789 + {unixOnly notRoot} {
1.1790 + catch {file delete -force -- tfa1 tfa2 tfalink}
1.1791 +
1.1792 + file mkdir tfa1
1.1793 + set s [createfile tfa2]
1.1794 + file link -symbolic tfalink tfa1
1.1795 +
1.1796 + file rename tfa2 tfalink
1.1797 + set result [checkcontent tfa1/tfa2 $s ]
1.1798 + file delete -force tfa1 tfalink
1.1799 + set result
1.1800 +} {1}
1.1801 +
1.1802 +test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} {
1.1803 + catch {file delete -force -- tfa1 tfalink}
1.1804 +
1.1805 + file mkdir tfa1
1.1806 + file link -symbolic tfalink tfa1
1.1807 + file delete tfa1
1.1808 + file rename tfalink tfa2
1.1809 + set result [expr [string compare [file type tfa2] "link"] == 0]
1.1810 + file delete tfa2
1.1811 + set result
1.1812 +} {1}
1.1813 +
1.1814 +
1.1815 +#
1.1816 +# Coverage tests for TclUnixRmdir
1.1817 +#
1.1818 +test fCmd-19.1 {remove empty directory} {notRoot} {
1.1819 + catch {file delete -force -- tfa}
1.1820 + file mkdir tfa
1.1821 + file delete tfa
1.1822 + file exists tfa
1.1823 +} {0}
1.1824 +
1.1825 +test fCmd-19.2 {rmdir error besides EEXIST} {unixOnly notRoot} {
1.1826 + catch {file delete -force -- tfa}
1.1827 + file mkdir tfa
1.1828 + file mkdir tfa/a
1.1829 + file attributes tfa -permissions 0555
1.1830 + set result [catch {file delete tfa/a}]
1.1831 + file attributes tfa -permissions 0777
1.1832 + file delete -force tfa
1.1833 + set result
1.1834 +} {1}
1.1835 +
1.1836 +test fCmd-19.3 {recursive remove} {notRoot} {
1.1837 + catch {file delete -force -- tfa}
1.1838 + file mkdir tfa
1.1839 + file mkdir tfa/a
1.1840 + file delete -force tfa
1.1841 + file exists tfa
1.1842 +} {0}
1.1843 +
1.1844 +#
1.1845 +# TclUnixDeleteFile and TraversalDelete are covered by tests from the
1.1846 +# TclDeleteFilesCmd suite
1.1847 +#
1.1848 +#
1.1849 +
1.1850 +#
1.1851 +# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
1.1852 +#
1.1853 +
1.1854 +test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
1.1855 + {unixOnly notRoot} {
1.1856 + catch {file delete -force -- tfa}
1.1857 + file mkdir tfa
1.1858 + file mkdir tfa/a
1.1859 + file attributes tfa/a -permissions 0000
1.1860 + set result [catch {file delete -force tfa}]
1.1861 + file attributes tfa/a -permissions 0777
1.1862 + file delete -force tfa
1.1863 + set result
1.1864 +} {1}
1.1865 +
1.1866 +test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \
1.1867 + {unix notRoot} {
1.1868 + catch {file delete -force -- tfa}
1.1869 + file mkdir tfa
1.1870 + for {set i 1} {$i <= 300} {incr i} {createfile tfa/testfile_$i}
1.1871 + set result [catch {file delete -force tfa} msg]
1.1872 + while {[catch {file delete -force tfa}]} {}
1.1873 + list $result $msg
1.1874 +} {0 {}}
1.1875 +
1.1876 +#
1.1877 +# Feature testing for TclCopyFilesCmd
1.1878 +#
1.1879 +test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
1.1880 + catch {file delete -force -- tfa1 tfa2}
1.1881 + set s [createfile tfa1]
1.1882 + file copy tfa1 tfa2
1.1883 + set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
1.1884 + file delete tfa1 tfa2
1.1885 + set result
1.1886 +} {1}
1.1887 +
1.1888 +test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {
1.1889 + catch {file delete -force -- tfa1 tfa2}
1.1890 + file mkdir tfa1
1.1891 + file copy tfa1 tfa2
1.1892 + set result [expr [file isdir tfa2] && [file isdir tfa1]]
1.1893 + file delete tfa1 tfa2
1.1894 + set result
1.1895 +} {1}
1.1896 +
1.1897 +test fCmd-21.3 {copy : single file into directory } {notRoot} {
1.1898 + catch {file delete -force -- tfa1 tfad}
1.1899 + set s [createfile tfa1]
1.1900 + file mkdir tfad
1.1901 + file copy tfa1 tfad
1.1902 + set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
1.1903 + file delete -force tfa1 tfad
1.1904 + set result
1.1905 +} {1}
1.1906 +
1.1907 +test fCmd-21.4 {copy : more than one source and target is not a directory} \
1.1908 + {notRoot} {
1.1909 + catch {file delete -force -- tfa1 tfa2 tfa3}
1.1910 + createfile tfa1
1.1911 + createfile tfa2
1.1912 + createfile tfa3
1.1913 + set result [catch {file copy tfa1 tfa2 tfa3}]
1.1914 + file delete tfa1 tfa2 tfa3
1.1915 + set result
1.1916 +} {1}
1.1917 +
1.1918 +test fCmd-21.5 {copy : multiple files into directory } {notRoot} {
1.1919 + catch {file delete -force -- tfa1 tfa2 tfad}
1.1920 + set s1 [createfile tfa1 ]
1.1921 + set s2 [createfile tfa2 ]
1.1922 + file mkdir tfad
1.1923 + file copy tfa1 tfa2 tfad
1.1924 + set r1 [checkcontent tfad/tfa1 $s1]
1.1925 + set r2 [checkcontent tfad/tfa2 $s2]
1.1926 + set r3 [checkcontent tfa1 $s1]
1.1927 + set r4 [checkcontent tfa2 $s2]
1.1928 + set result [expr $r1 && $r2 && $r3 && $r4]
1.1929 + file delete -force tfa1 tfa2 tfad
1.1930 + set result
1.1931 +} {1}
1.1932 +
1.1933 +test fCmd-21.6 {copy: mixed dirs and files into directory} \
1.1934 + {notRoot notFileSharing} {
1.1935 + catch {file delete -force -- tfa1 tfad1 tfad2}
1.1936 + set s [createfile tfa1 ]
1.1937 + file mkdir tfad1 tfad2
1.1938 + file copy tfa1 tfad1 tfad2
1.1939 + set r1 [checkcontent [file join tfad2 tfa1] $s]
1.1940 + set r2 [file isdir [file join tfad2 tfad1]]
1.1941 + set r3 [checkcontent tfa1 $s]
1.1942 + set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
1.1943 + file delete -force tfa1 tfad1 tfad2
1.1944 + set result
1.1945 +} {1}
1.1946 +
1.1947 +test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot dontCopyLinks} {
1.1948 + file mkdir tfad1
1.1949 + file link -symbolic tfalink tfad1
1.1950 + file delete tfad1
1.1951 + set result [list [catch {file copy tfalink tfalink2} msg] $msg]
1.1952 + file delete -force tfalink tfalink2
1.1953 + set result
1.1954 +} {1 {error copying "tfalink": the target of this link doesn't exist}}
1.1955 +test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
1.1956 + file mkdir tfad1
1.1957 + file link -symbolic tfalink tfad1
1.1958 + file delete tfad1
1.1959 + file copy tfalink tfalink2
1.1960 + set result [string match [file type tfalink2] link]
1.1961 + file delete tfalink tfalink2
1.1962 + set result
1.1963 +} {1}
1.1964 +
1.1965 +test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unixOnly notRoot dontCopyLinks} {
1.1966 + file mkdir tfad1
1.1967 + file link -symbolic tfalink tfad1
1.1968 + file copy tfalink tfalink2
1.1969 + set r1 [file type tfalink]; # link
1.1970 + set r2 [file type tfalink2]; # directory
1.1971 + set r3 [file isdir tfad1]; # 1
1.1972 + set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}]
1.1973 + file delete -force tfad1 tfalink tfalink2
1.1974 + set result
1.1975 +} {1}
1.1976 +test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unixOnly notRoot} {
1.1977 + file mkdir tfad1
1.1978 + file link -symbolic tfalink tfad1
1.1979 + file copy tfalink tfalink2
1.1980 + set r1 [file type tfalink]; # link
1.1981 + set r2 [file type tfalink2]; # link
1.1982 + set r3 [file isdir tfad1]; # 1
1.1983 + set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}]
1.1984 + file delete -force tfad1 tfalink tfalink2
1.1985 + set result
1.1986 +} {1}
1.1987 +
1.1988 +test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {
1.1989 + file mkdir tfad1
1.1990 + file link -symbolic tfad1/tfalink "[pwd]/tfad1"
1.1991 + file copy tfad1 tfad2
1.1992 + set result [string match [file type tfad2/tfalink] link]
1.1993 + file delete -force tfad1 tfad2
1.1994 + set result
1.1995 +} {1}
1.1996 +
1.1997 +test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \
1.1998 + {notRoot} {
1.1999 + catch {file delete -force -- tfa tfad}
1.2000 + file mkdir tfa [file join tfad tfa]
1.2001 + set r1 [catch {file copy tfa tfad}]
1.2002 + set result [expr $r1 && [file isdir tfa]]
1.2003 + file delete -force tfa tfad
1.2004 + set result
1.2005 +} {1}
1.2006 +
1.2007 +test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {
1.2008 + catch {file delete -force -- tfa tfad}
1.2009 + file mkdir tfa [file join tfad tfa file]
1.2010 + set r1 [catch {file copy tfa tfad}]
1.2011 + set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
1.2012 + file delete -force tfa tfad
1.2013 + set result
1.2014 +} {1}
1.2015 +
1.2016 +test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \
1.2017 + {notRoot} {
1.2018 + catch {file delete -force -- tfa tfad}
1.2019 + file mkdir tfa [file join tfad tfa file]
1.2020 + set r1 [catch {file copy -force tfa tfad}]
1.2021 + set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
1.2022 + file delete -force tfa tfad
1.2023 + set result
1.2024 +} {1}
1.2025 +
1.2026 +#
1.2027 +# Coverage testing for TclpRenameFile
1.2028 +#
1.2029 +test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {
1.2030 + catch {file delete -force -- tfa1 tfa2}
1.2031 + set s [createfile tfa1]
1.2032 + set s2 [createfile tfa2 q]
1.2033 +
1.2034 + set r1 [catch {rename tfa1 tfa2}]
1.2035 + file rename -force tfa1 tfa2
1.2036 + set result [expr $r1 && [checkcontent tfa2 $s]]
1.2037 + file delete [glob tfa1 tfa2]
1.2038 + set result
1.2039 +} {1}
1.2040 +
1.2041 +test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} {
1.2042 + catch {file delete -force -- tfa1}
1.2043 + set s [createfile tfa1]
1.2044 + file rename -force tfa1 tfa1
1.2045 + set result [checkcontent tfa1 $s]
1.2046 + file delete tfa1
1.2047 + set result
1.2048 +} {1}
1.2049 +
1.2050 +test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
1.2051 + catch {file delete -force -- d1 tfad}
1.2052 + file mkdir d1 [file join tfad d1]
1.2053 + set r1 [catch {file rename d1 tfad}]
1.2054 + set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
1.2055 + file delete -force d1 tfad
1.2056 + set result
1.2057 +} {1}
1.2058 +
1.2059 +test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {
1.2060 + catch {file delete -force -- d1 tfad}
1.2061 + file mkdir d1 [file join tfad a b c]
1.2062 + file rename d1 [file join tfad a b c d1]
1.2063 + set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
1.2064 + file delete -force [glob d1 tfad]
1.2065 + set result
1.2066 +} {1}
1.2067 +
1.2068 +
1.2069 +#
1.2070 +# TclMacCopyFile needs to be redone.
1.2071 +#
1.2072 +test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
1.2073 + catch {file delete -force -- tfa1 tfa2}
1.2074 + set s [createfile tfa1]
1.2075 + set s2 [createfile tfa2 q]
1.2076 +
1.2077 + set r1 [catch {file copy tfa1 tfa2}]
1.2078 + file copy -force tfa1 tfa2
1.2079 + set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
1.2080 + file delete tfa1 tfa2
1.2081 + set result
1.2082 +} {1}
1.2083 +
1.2084 +#
1.2085 +# TclMacMkdir - basic cases are covered elsewhere.
1.2086 +# Error cases are not covered.
1.2087 +#
1.2088 +
1.2089 +#
1.2090 +# TclMacRmdir
1.2091 +# Error cases are not covered.
1.2092 +#
1.2093 +
1.2094 +test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
1.2095 + catch {file delete -force -- tfad}
1.2096 +
1.2097 + file mkdir [file join tfad dir]
1.2098 +
1.2099 + set result [catch {file delete tfad}]
1.2100 + file delete -force tfad
1.2101 + set result
1.2102 +} {1}
1.2103 +
1.2104 +#
1.2105 +# TclMacDeleteFile
1.2106 +# Error cases are not covered.
1.2107 +#
1.2108 +test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
1.2109 + catch {file delete -force -- tfa1}
1.2110 +
1.2111 + createfile tfa1
1.2112 + file delete tfa1
1.2113 + file exists tfa1
1.2114 +} {0}
1.2115 +
1.2116 +#
1.2117 +# TclMacCopyDirectory
1.2118 +# Error cases are not covered.
1.2119 +#
1.2120 +test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} {notRoot notFileSharing} {
1.2121 + catch {file delete -force -- tfad1 tfad2}
1.2122 +
1.2123 + file mkdir [file join tfad1 a b c]
1.2124 + file copy tfad1 tfad2
1.2125 + set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
1.2126 + file delete -force tfad1 tfad2
1.2127 + set result
1.2128 +} {1}
1.2129 +
1.2130 +test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} {
1.2131 + catch {file delete -force -- tfad1 tfad2}
1.2132 +
1.2133 + file mkdir tfad1
1.2134 + file copy tfad1 tfad2
1.2135 + set result [expr [file isdir tfad1] && [file isdir tfad2]]
1.2136 + file delete tfad1 tfad2
1.2137 + set result
1.2138 +} {1}
1.2139 +
1.2140 +test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} {
1.2141 + catch {file delete -force -- tfad1 tfad2}
1.2142 +
1.2143 + file mkdir [file join tfad1 x y z]
1.2144 + file mkdir [file join tfad2 dir]
1.2145 + file copy tfad1 [file join tfad2 dir]
1.2146 + set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
1.2147 + file delete -force tfad1 tfad2
1.2148 + set result
1.2149 +} {1}
1.2150 +
1.2151 +#
1.2152 +# Functionality tests for TclDeleteFilesCmd
1.2153 +#
1.2154 +
1.2155 +test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unixOnly notRoot} {
1.2156 + catch {file delete -force -- tfad1 tfad2}
1.2157 +
1.2158 + file mkdir tfad1
1.2159 + file link -symbolic tfalink tfad1
1.2160 + file delete tfalink
1.2161 +
1.2162 + set r1 [file isdir tfad1]
1.2163 + set r2 [file exists tfalink]
1.2164 +
1.2165 + set result [expr $r1 && !$r2]
1.2166 + file delete tfad1
1.2167 + set result
1.2168 +} {1}
1.2169 +
1.2170 +test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} {
1.2171 + catch {file delete -force -- tfad1 tfad2}
1.2172 +
1.2173 + file mkdir tfad1
1.2174 + file mkdir tfad2
1.2175 + file link -symbolic [file join tfad2 link] tfad1
1.2176 + file delete -force tfad2
1.2177 +
1.2178 + set r1 [file isdir tfad1]
1.2179 + set r2 [file exists tfad2]
1.2180 +
1.2181 + set result [expr $r1 && !$r2]
1.2182 + file delete tfad1
1.2183 + set result
1.2184 +} {1}
1.2185 +
1.2186 +test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unixOnly notRoot} {
1.2187 + catch {file delete -force -- tfad1 tfad2}
1.2188 +
1.2189 + file mkdir tfad1
1.2190 + file link -symbolic tfad2 tfad1
1.2191 + file delete tfad1
1.2192 + file delete tfad2
1.2193 +
1.2194 + set r1 [file exists tfad1]
1.2195 + set r2 [file exists tfad2]
1.2196 +
1.2197 + set result [expr !$r1 && !$r2]
1.2198 + set result
1.2199 +} {1}
1.2200 +
1.2201 +test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} {
1.2202 + set platform [testgetplatform]
1.2203 + testsetplatform unix
1.2204 + list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform]
1.2205 +} {1 {user "_totally_bogus_user" doesn't exist} {}}
1.2206 +test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
1.2207 + catch {file delete -force -- foo.tmp}
1.2208 + createfile foo.tmp
1.2209 + list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]
1.2210 +} {0 1 {}}
1.2211 +test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
1.2212 + catch {file delete -force -- foo.tmp}
1.2213 + createfile foo.tmp
1.2214 + set attrs [file attributes foo.tmp]
1.2215 + list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]
1.2216 +} {0 {}}
1.2217 +
1.2218 +# Find a group that exists on this Unix system, or else skip tests that
1.2219 +# require Unix groups.
1.2220 +if {$tcl_platform(platform) == "unix"} {
1.2221 + ::tcltest::testConstraint foundGroup 0
1.2222 + catch {
1.2223 + set groupList [exec groups]
1.2224 + set group [lindex $groupList 0]
1.2225 + ::tcltest::testConstraint foundGroup 1
1.2226 + }
1.2227 +} else {
1.2228 + ::tcltest::testConstraint foundGroup 1
1.2229 +}
1.2230 +
1.2231 +test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
1.2232 + catch {file delete -force -- foo.tmp}
1.2233 + createfile foo.tmp
1.2234 + set attrs [file attributes foo.tmp]
1.2235 + list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
1.2236 +} {0 {} {}}
1.2237 +test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
1.2238 + catch {file delete -force -- foo.tmp}
1.2239 + createfile foo.tmp
1.2240 + set attrs [file attributes foo.tmp]
1.2241 + list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
1.2242 +} {0 {} {}}
1.2243 +
1.2244 +if {[string equal $tcl_platform(platform) "windows"]} {
1.2245 + if {[string index $tcl_platform(osVersion) 0] >= 5 \
1.2246 + && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
1.2247 + tcltest::testConstraint linkDirectory 1
1.2248 + tcltest::testConstraint linkFile 1
1.2249 + } else {
1.2250 + tcltest::testConstraint linkDirectory 0
1.2251 + tcltest::testConstraint linkFile 0
1.2252 + }
1.2253 +} else {
1.2254 + tcltest::testConstraint linkFile 1
1.2255 + tcltest::testConstraint linkDirectory 1
1.2256 +
1.2257 + if {[string equal $tcl_platform(osSystemName) "Symbian"]} {
1.2258 + tcltest::testConstraint linkDirectory 0
1.2259 + }
1.2260 +}
1.2261 +
1.2262 +test fCmd-28.1 {file link} {
1.2263 + list [catch {file link} msg] $msg
1.2264 +} {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
1.2265 +
1.2266 +test fCmd-28.2 {file link} {
1.2267 + list [catch {file link a b c d} msg] $msg
1.2268 +} {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
1.2269 +
1.2270 +test fCmd-28.3 {file link} {
1.2271 + list [catch {file link abc b c} msg] $msg
1.2272 +} {1 {bad switch "abc": must be -symbolic or -hard}}
1.2273 +
1.2274 +test fCmd-28.4 {file link} {
1.2275 + list [catch {file link -abc b c} msg] $msg
1.2276 +} {1 {bad switch "-abc": must be -symbolic or -hard}}
1.2277 +cd [workingDirectory]
1.2278 +
1.2279 +makeDirectory abc.dir
1.2280 +makeDirectory abc2.dir
1.2281 +makeFile contents abc.file
1.2282 +makeFile contents abc2.file
1.2283 +
1.2284 +cd [temporaryDirectory]
1.2285 +test fCmd-28.5 {file link: source already exists} {linkDirectory} {
1.2286 + cd [temporaryDirectory]
1.2287 + set res [list [catch {file link abc.dir abc2.dir} msg] $msg]
1.2288 + cd [workingDirectory]
1.2289 + set res
1.2290 +} {1 {could not create new link "abc.dir": that path already exists}}
1.2291 +
1.2292 +test fCmd-28.6 {file link: unsupported operation} {linkDirectory macOrWin} {
1.2293 + cd [temporaryDirectory]
1.2294 + set res [list [catch {file link -hard abc.link abc.dir} msg] $msg]
1.2295 + cd [workingDirectory]
1.2296 + set res
1.2297 +} {1 {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}}
1.2298 +
1.2299 +test fCmd-28.7 {file link: source already exists} {linkFile} {
1.2300 + cd [temporaryDirectory]
1.2301 + set res [list [catch {file link abc.file abc2.file} msg] $msg]
1.2302 + cd [workingDirectory]
1.2303 + set res
1.2304 +} {1 {could not create new link "abc.file": that path already exists}}
1.2305 +
1.2306 +test fCmd-28.8 {file link} {linkFile winOnly} {
1.2307 + cd [temporaryDirectory]
1.2308 + set res [list [catch {file link -symbolic abc.link abc.file} msg] $msg]
1.2309 + cd [workingDirectory]
1.2310 + set res
1.2311 +} {1 {could not create new link "abc.link" pointing to "abc.file": not a directory}}
1.2312 +
1.2313 +test fCmd-28.9 {file link: success with file} {linkFile} {
1.2314 + cd [temporaryDirectory]
1.2315 + file delete -force abc.link
1.2316 + set res [list [catch {file link abc.link abc.file} msg] $msg]
1.2317 + cd [workingDirectory]
1.2318 + set res
1.2319 +} {0 abc.file}
1.2320 +
1.2321 +cd [temporaryDirectory]
1.2322 +catch {file delete -force abc.link}
1.2323 +cd [workingDirectory]
1.2324 +
1.2325 +test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} {
1.2326 + cd [temporaryDirectory]
1.2327 + file delete -force abc.link
1.2328 + set res [list [catch {file link abc.link abc2.doesnt} msg] $msg]
1.2329 + cd [workingDirectory]
1.2330 + set res
1.2331 +} {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}}
1.2332 +
1.2333 +test fCmd-28.11 {file link: success with directory} {linkDirectory} {
1.2334 + cd [temporaryDirectory]
1.2335 + file delete -force abc.link
1.2336 + set res [list [catch {file link abc.link abc.dir} msg] $msg]
1.2337 + cd [workingDirectory]
1.2338 + set res
1.2339 +} {0 abc.dir}
1.2340 +
1.2341 +test fCmd-28.12 {file link: cd into a link} {linkDirectory} {
1.2342 + cd [temporaryDirectory]
1.2343 + file delete -force abc.link
1.2344 + file link abc.link abc.dir
1.2345 + set orig [pwd]
1.2346 + cd abc.link
1.2347 + set dir [pwd]
1.2348 + cd ..
1.2349 + set up [pwd]
1.2350 + cd $orig
1.2351 + # now '$up' should be either $orig or [file dirname abc.dir],
1.2352 + # depending on whether 'cd' actually moves to the destination
1.2353 + # of a link, or simply treats the link as a directory.
1.2354 + # (on windows the former, on unix the latter, I believe)
1.2355 + if {([file normalize $up] != [file normalize $orig]) \
1.2356 + && ([file normalize $up] != [file normalize [file dirname abc.dir]])} {
1.2357 + set res "wrong directory with 'cd $link ; cd ..'"
1.2358 + } else {
1.2359 + set res "ok"
1.2360 + }
1.2361 + cd [workingDirectory]
1.2362 + set res
1.2363 +} {ok}
1.2364 +
1.2365 +test fCmd-28.13 {file link} {linkDirectory} {
1.2366 + # duplicate link throws error
1.2367 + cd [temporaryDirectory]
1.2368 + set res [list [catch {file link abc.link abc.dir} msg] $msg]
1.2369 + cd [workingDirectory]
1.2370 + set res
1.2371 +} {1 {could not create new link "abc.link": that path already exists}}
1.2372 +
1.2373 +test fCmd-28.14 {file link: deletes link not dir} {linkDirectory} {
1.2374 + cd [temporaryDirectory]
1.2375 + file delete -force abc.link
1.2376 + set res [list [file exists abc.link] [file exists abc.dir]]
1.2377 + cd [workingDirectory]
1.2378 + set res
1.2379 +} {0 1}
1.2380 +
1.2381 +test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} {
1.2382 + cd [temporaryDirectory]
1.2383 + file delete -force abc.link
1.2384 + file link abc.link abc.dir
1.2385 + file copy abc.link abc2.link
1.2386 + # abc2.linkdir was a copy of a link to a dir, so it should end up as
1.2387 + # a directory, not a link (links trace to endpoint).
1.2388 + set res [list [file type abc2.link] [file tail [file link abc.link]]]
1.2389 + cd [workingDirectory]
1.2390 + set res
1.2391 +} {directory abc.dir}
1.2392 +test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} {
1.2393 + cd [temporaryDirectory]
1.2394 + file delete -force abc.link
1.2395 + file link abc.link abc.dir
1.2396 + file copy abc.link abc2.link
1.2397 + set res [list [file type abc2.link] [file tail [file link abc2.link]]]
1.2398 + cd [workingDirectory]
1.2399 + set res
1.2400 +} {link abc.dir}
1.2401 +
1.2402 +cd [temporaryDirectory]
1.2403 +file delete -force abc.link
1.2404 +file delete -force abc2.link
1.2405 +
1.2406 +file copy abc.file abc.dir
1.2407 +file copy abc2.file abc.dir
1.2408 +cd [workingDirectory]
1.2409 +
1.2410 +test fCmd-28.16 {file link: glob inside link} {linkDirectory} {
1.2411 + cd [temporaryDirectory]
1.2412 + file delete -force abc.link
1.2413 + file link abc.link abc.dir
1.2414 + set res [lsort [glob -dir abc.link -tails *]]
1.2415 + cd [workingDirectory]
1.2416 + set res
1.2417 +} [lsort [list abc.file abc2.file]]
1.2418 +
1.2419 +test fCmd-28.17 {file link: glob -type l} {linkDirectory} {
1.2420 + cd [temporaryDirectory]
1.2421 + set res [glob -dir [pwd] -type l -tails abc*]
1.2422 + cd [workingDirectory]
1.2423 + set res
1.2424 +} {abc.link}
1.2425 +
1.2426 +test fCmd-28.18 {file link: glob -type d} {linkDirectory} {
1.2427 + cd [temporaryDirectory]
1.2428 + set res [lsort [glob -dir [pwd] -type d -tails abc*]]
1.2429 + cd [workingDirectory]
1.2430 + set res
1.2431 +} [lsort [list abc.link abc.dir abc2.dir]]
1.2432 +
1.2433 +test fCmd-29.1 {weird memory corruption fault} {
1.2434 + catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]}
1.2435 +} 1
1.2436 +
1.2437 +cd [temporaryDirectory]
1.2438 +file delete -force abc.link
1.2439 +cd [workingDirectory]
1.2440 +
1.2441 +removeFile abc2.file
1.2442 +removeFile abc.file
1.2443 +removeDirectory abc2.dir
1.2444 +removeDirectory abc.dir
1.2445 +
1.2446 +# cleanup
1.2447 +cleanup
1.2448 +::tcltest::cleanupTests
1.2449 +return