sl@0: # This file tests the tclFCmd.c file. sl@0: # sl@0: # This file contains a collection of tests for one or more of the Tcl sl@0: # built-in commands. Sourcing this file into Tcl runs the tests and sl@0: # generates output for errors. No output means no errors were found. sl@0: # sl@0: # Copyright (c) 1996-1997 Sun Microsystems, Inc. sl@0: # Copyright (c) 1999 by Scriptics Corporation. sl@0: # Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved. sl@0: # sl@0: # See the file "license.terms" for information on usage and redistribution sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: # sl@0: # RCS: @(#) $Id: fCmd.test,v 1.26.2.9 2007/05/17 14:18:42 dgp Exp $ sl@0: # sl@0: sl@0: if {[lsearch [namespace children] ::tcltest] == -1} { sl@0: package require tcltest 2 sl@0: namespace import -force ::tcltest::* sl@0: } sl@0: sl@0: tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]] sl@0: tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]] sl@0: tcltest::testConstraint notNetworkFilesystem 0 sl@0: testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}] sl@0: testConstraint 2000orNewer [expr {![testConstraint 95or98]}] sl@0: sl@0: # Several tests require need to match results against the unix username sl@0: set user {} sl@0: if {$tcl_platform(platform) == "unix"} { sl@0: catch {set user [exec whoami]} sl@0: if {$user == ""} { sl@0: catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} sl@0: } sl@0: if {$user == ""} { sl@0: set user "root" sl@0: } sl@0: } sl@0: sl@0: proc createfile {file {string a}} { sl@0: set f [open $file w] sl@0: puts -nonewline $f $string sl@0: close $f sl@0: return $string sl@0: } sl@0: sl@0: # sl@0: # checkcontent -- sl@0: # sl@0: # Ensures that file "file" contains only the string "matchString" sl@0: # returns 0 if the file does not exist, or has a different content sl@0: # sl@0: proc checkcontent {file matchString} { sl@0: if {[catch { sl@0: set f [open $file] sl@0: set fileString [read $f] sl@0: close $f sl@0: }]} { sl@0: return 0 sl@0: } sl@0: return [string match $matchString $fileString] sl@0: } sl@0: sl@0: proc openup {path} { sl@0: testchmod 777 $path sl@0: if {[file isdirectory $path]} { sl@0: catch { sl@0: foreach p [glob -directory $path *] { sl@0: openup $p sl@0: } sl@0: } sl@0: } sl@0: } sl@0: sl@0: proc cleanup {args} { sl@0: if {$::tcl_platform(platform) == "macintosh"} { sl@0: set wd [list :] sl@0: } else { sl@0: set wd [list .] sl@0: } sl@0: foreach p [concat $wd $args] { sl@0: set x "" sl@0: catch { sl@0: set x [glob -directory $p tf* td*] sl@0: } sl@0: foreach file $x { sl@0: if {[catch {file delete -force -- $file}]} { sl@0: catch {openup $file} sl@0: catch {file delete -force -- $file} sl@0: } sl@0: } sl@0: } sl@0: } sl@0: sl@0: proc contents {file} { sl@0: set f [open $file r] sl@0: set r [read $f] sl@0: close $f sl@0: set r sl@0: } sl@0: sl@0: cd [temporaryDirectory] sl@0: sl@0: set ::tcltest::testConstraints(fileSharing) 0 sl@0: set ::tcltest::testConstraints(notFileSharing) 1 sl@0: sl@0: if {$tcl_platform(platform) == "macintosh"} { sl@0: catch {file delete -force foo.dir} sl@0: file mkdir foo.dir sl@0: if {[catch {file attributes foo.dir -readonly 1}] == 0} { sl@0: set ::tcltest::testConstraints(fileSharing) 1 sl@0: set ::tcltest::testConstraints(notFileSharing) 0 sl@0: } sl@0: file delete -force foo.dir sl@0: } sl@0: sl@0: set ::tcltest::testConstraints(xdev) 0 sl@0: sl@0: if {$tcl_platform(platform) == "unix"} { sl@0: if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} { sl@0: set m1 [string range $m1 0 [expr [string first " " $m1]-1]] sl@0: set m2 [string range $m2 0 [expr [string first " " $m2]-1]] sl@0: if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} { sl@0: set ::tcltest::testConstraints(xdev) 1 sl@0: } sl@0: } sl@0: } sl@0: sl@0: set root [lindex [file split [pwd]] 0] sl@0: sl@0: # A really long file name sl@0: # length of long is 1216 chars, which should be greater than any static sl@0: # buffer or allowable filename. sl@0: sl@0: set long "abcdefghihjllmnopqrstuvwxyz01234567890" sl@0: append long $long sl@0: append long $long sl@0: append long $long sl@0: append long $long sl@0: append long $long sl@0: sl@0: test fCmd-1.1 {TclFileRenameCmd} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: file rename tf1 tf2 sl@0: glob tf* sl@0: } {tf2} sl@0: sl@0: test fCmd-2.1 {TclFileCopyCmd} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: file copy tf1 tf2 sl@0: lsort [glob tf*] sl@0: } {tf1 tf2} sl@0: sl@0: test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} { sl@0: list [catch {file rename -xyz} msg] $msg sl@0: } {1 {bad option "-xyz": should be -force or --}} sl@0: test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} { sl@0: list [catch {file rename xyz} msg] $msg sl@0: } {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}} sl@0: test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} { sl@0: list [catch {file rename xyz ~_totally_bogus_user} msg] $msg sl@0: } {1 {user "_totally_bogus_user" doesn't exist}} sl@0: test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} { sl@0: cleanup sl@0: list [catch {file copy tf1 ~} msg] $msg sl@0: } {1 {error copying "tf1": no such file or directory}} sl@0: test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} { sl@0: cleanup sl@0: list [catch {file rename tf1 tf2 tf3} msg] $msg sl@0: } {1 {error renaming: target "tf3" is not a directory}} sl@0: test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \ sl@0: {notRoot} { sl@0: cleanup sl@0: createfile tf3 sl@0: list [catch {file rename tf1 tf2 tf3} msg] $msg sl@0: } {1 {error renaming: target "tf3" is not a directory}} sl@0: test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: createfile tf1 tf1 sl@0: file rename tf1 td1 sl@0: contents [file join td1 tf1] sl@0: } {tf1} sl@0: test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} { sl@0: cleanup sl@0: list [catch {file rename tf1 tf2 tf3} msg] $msg sl@0: } {1 {error renaming: target "tf3" is not a directory}} sl@0: test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} { sl@0: cleanup sl@0: list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg sl@0: } {1 {error copying: target "tf3" is not a directory}} sl@0: test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} { sl@0: cleanup sl@0: createfile tf1 tf1 sl@0: file rename tf1 tf2 sl@0: contents tf2 sl@0: } {tf1} sl@0: test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} { sl@0: cleanup sl@0: createfile tf1 tf1 sl@0: file rename -force -force -- tf1 tf2 sl@0: contents tf2 sl@0: } {tf1} sl@0: test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} { sl@0: cleanup sl@0: createfile tf1 tf1 sl@0: file mkdir td1 sl@0: file rename tf1 td1 sl@0: contents [file join td1 tf1] sl@0: } {tf1} sl@0: test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} { sl@0: cleanup sl@0: createfile tf1 tf1 sl@0: createfile tf2 tf2 sl@0: createfile tf3 tf3 sl@0: createfile tf4 tf4 sl@0: file mkdir td1 sl@0: file rename tf1 tf2 tf3 tf4 td1 sl@0: list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \ sl@0: [contents [file join td1 tf3]] [contents [file join td1 tf4]] sl@0: } {tf1 tf2 tf3 tf4} sl@0: test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: list [catch {file rename ~_totally_bogus_user td1} msg] $msg sl@0: } {1 {user "_totally_bogus_user" doesn't exist}} sl@0: test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} { sl@0: cleanup sl@0: file mkdir td1 sl@0: list [catch {file rename / td1} msg] $msg sl@0: } {1 {error renaming "/" to "td1": file already exists}} sl@0: test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: createfile tf3 sl@0: createfile tf4 sl@0: file mkdir td1 sl@0: createfile [file join td1 tf3] sl@0: list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg sl@0: } [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}] sl@0: sl@0: test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: glob td* sl@0: } {td1} sl@0: test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 td2 td3 sl@0: lsort [glob td*] sl@0: } {td1 td2 td3} sl@0: test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: catch {file mkdir td1 td2 tf1 td3 td4} sl@0: glob td1 td2 tf1 td3 td4 sl@0: } {td1 td2 tf1} sl@0: test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} { sl@0: cleanup sl@0: list [catch {file mkdir ~_totally_bogus_user} msg] $msg sl@0: } {1 {user "_totally_bogus_user" doesn't exist}} sl@0: test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \ sl@0: {notRoot} { sl@0: cleanup sl@0: list [catch {file mkdir ""} msg] $msg sl@0: } {1 {can't create directory "": no such file or directory}} sl@0: test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: glob td1 sl@0: } {td1} sl@0: test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} { sl@0: cleanup sl@0: file mkdir [file join td1 td2 td3 td4] sl@0: glob td1 [file join td1 td2] sl@0: } "td1 [file join td1 td2]" sl@0: test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: set x [file exists td1] sl@0: file mkdir td1 sl@0: list $x [file exists td1] sl@0: } {1 1} sl@0: test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: list [catch {file mkdir tf1} msg] $msg sl@0: } [subst {1 {can't create directory "[file join tf1]": file already exists}}] sl@0: test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: set x [file exists td1] sl@0: file mkdir td1 sl@0: list $x [file exists td1] sl@0: } {1 1} sl@0: test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \ sl@0: {unixOnly notRoot testchmod} { sl@0: cleanup sl@0: file mkdir td1/td2/td3 sl@0: testchmod 000 td1/td2 sl@0: set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg] sl@0: testchmod 755 td1/td2 sl@0: set msg sl@0: } {1 {can't create directory "td1/td2/td3": permission denied}} sl@0: test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} { sl@0: cleanup sl@0: list [catch {file mkdir nonexistentvolume:} msg] $msg sl@0: } {1 {can't create directory "nonexistentvolume:": invalid argument}} sl@0: test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} { sl@0: cleanup sl@0: set x [file exists td1] sl@0: file mkdir td1 sl@0: list $x [file exists td1] sl@0: } {0 1} sl@0: test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \ sl@0: {unixOnly notRoot} { sl@0: cleanup sl@0: file delete -force foo sl@0: file mkdir foo sl@0: file attr foo -perm 040000 sl@0: set result [list [catch {file mkdir foo/tf1} msg] $msg] sl@0: file delete -force foo sl@0: set result sl@0: } {1 {can't create directory "foo/tf1": permission denied}} sl@0: test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} { sl@0: list [catch {file mkdir ${root}:} msg] $msg sl@0: } [subst {1 {can't create directory "${root}:": no such file or directory}}] sl@0: test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} { sl@0: cleanup sl@0: file mkdir tf1 sl@0: file exists tf1 sl@0: } {1} sl@0: sl@0: test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} { sl@0: list [catch {file delete -xyz} msg] $msg sl@0: } {1 {bad option "-xyz": should be -force or --}} sl@0: test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} { sl@0: list [catch {file delete -force -force} msg] $msg sl@0: } {1 {wrong # args: should be "file delete ?options? file ?file ...?"}} sl@0: test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: file mkdir td1 sl@0: file delete tf2 sl@0: glob tf* td* sl@0: } {tf1 td1} sl@0: test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: file mkdir td1 sl@0: set x [list [file exists tf1] [file exists tf2] [file exists td1]] sl@0: file delete tf1 td1 tf2 sl@0: lappend x [file exists tf1] [file exists tf2] [file exists tf3] sl@0: } {1 1 1 0 0 0} sl@0: test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: file mkdir td1 sl@0: catch {file delete tf1 td1 $root tf2} sl@0: list [file exists tf1] [file exists tf2] [file exists td1] sl@0: } {0 1 0} sl@0: test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} { sl@0: list [catch {file delete ~_totally_bogus_user} msg] $msg sl@0: } {1 {user "_totally_bogus_user" doesn't exist}} sl@0: test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} { sl@0: catch {file delete ~/tf1} sl@0: createfile ~/tf1 sl@0: file delete ~/tf1 sl@0: } {} sl@0: test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} { sl@0: cleanup sl@0: set x [file exists tf1] sl@0: file delete tf1 sl@0: list $x [file exists tf1] sl@0: } {0 0} sl@0: test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: file delete td1 sl@0: file exists td1 sl@0: } {0} sl@0: test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} { sl@0: cleanup sl@0: file mkdir [file join td1 td2] sl@0: list [catch {file delete td1} msg] $msg sl@0: } {1 {error deleting "td1": directory not empty}} sl@0: test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} {notRoot} { sl@0: cleanup sl@0: set dir [pwd] sl@0: file mkdir [file join td1 td2] sl@0: cd [file join td1 td2] sl@0: set res [list [catch {file delete -force [file dirname [pwd]]} msg]] sl@0: cd $dir sl@0: lappend res [file exists td1] $msg sl@0: } {0 0 {}} sl@0: test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unixOnly} { sl@0: cleanup sl@0: file mkdir [file join td1 td2] sl@0: #exec chmod u-rwx [file join td1 td2] sl@0: file attributes [file join td1 td2] -permissions u+rwx sl@0: set res [list [catch {file delete -force td1} msg]] sl@0: lappend res [file exists td1] $msg sl@0: } {0 0 {}} sl@0: sl@0: test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} { sl@0: # can't test this, because it's caught by FileCopyRename sl@0: } {} sl@0: test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} { sl@0: # can't test this, because it's caught by FileCopyRename sl@0: } {} sl@0: test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} { sl@0: cleanup sl@0: list [catch {file rename tf1 tf2} msg] $msg sl@0: } {1 {error renaming "tf1": no such file or directory}} sl@0: test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: file rename tf1 tf2 sl@0: glob tf* sl@0: } {tf2} sl@0: test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: file rename tf1 tf2 sl@0: glob tf* sl@0: } {tf2} sl@0: test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot testchmod} { sl@0: cleanup sl@0: file mkdir td1 sl@0: testchmod 000 td1 sl@0: createfile tf1 sl@0: set msg [list [catch {file rename tf1 td1} msg] $msg] sl@0: testchmod 755 td1 sl@0: set msg sl@0: } {1 {error renaming "tf1" to "td1/tf1": permission denied}} sl@0: test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {pcOnly 95} { sl@0: cleanup sl@0: createfile tf1 sl@0: list [catch {file rename tf1 $long} msg] $msg sl@0: } [subst {1 {error renaming "tf1" to "$long": file name too long}}] sl@0: test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} { sl@0: cleanup sl@0: createfile tf1 sl@0: list [catch {file rename tf1 $long} msg] $msg sl@0: } [subst {1 {error renaming "tf1" to "$long": file name too long}}] sl@0: test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: file rename tf1 tf2 sl@0: glob tf* sl@0: } {tf2} sl@0: test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: list [catch {file rename tf1 tf2} msg] $msg sl@0: } {1 {error renaming "tf1" to "tf2": file already exists}} sl@0: test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: list [catch {file rename tf1 tf2} msg] $msg sl@0: } {1 {error renaming "tf1" to "tf2": file already exists}} sl@0: test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: file rename -force tf1 tf2 sl@0: glob tf* sl@0: } {tf2} sl@0: test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: file mkdir td2 sl@0: createfile [file join td2 td1] sl@0: list [catch {file rename -force td1 td2} msg] $msg sl@0: } [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}] sl@0: test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} { sl@0: cleanup sl@0: createfile tf1 sl@0: file mkdir [file join td1 tf1] sl@0: list [catch {file rename -force tf1 td1} msg] $msg sl@0: } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}] sl@0: test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot notNetworkFilesystem} { sl@0: cleanup sl@0: file mkdir [file join td1 td2] sl@0: file mkdir td2 sl@0: createfile [file join td2 tf1] sl@0: file rename -force td2 td1 sl@0: file exists [file join td1 td2 tf1] sl@0: } {1} sl@0: test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {notRoot} { sl@0: cleanup sl@0: file mkdir [file join td1 td2] sl@0: createfile [file join td1 td2 tf1] sl@0: file mkdir td2 sl@0: list [catch {file rename -force td2 td1} msg] $msg sl@0: } [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}] sl@0: sl@0: test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} { sl@0: cleanup sl@0: list [catch {file rename -force $root tf1} msg] $msg sl@0: } [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}] sl@0: test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {notRoot} { sl@0: cleanup sl@0: file mkdir [file join td1 td2] sl@0: createfile [file join td1 td2 tf1] sl@0: file mkdir td2 sl@0: list [catch {file rename -force td2 td1} msg] $msg sl@0: } [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}] sl@0: test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} { sl@0: cleanup /tmp sl@0: createfile tf1 sl@0: file rename tf1 /tmp sl@0: glob tf* /tmp/tf1 sl@0: } {/tmp/tf1} sl@0: test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} { sl@0: catch {file delete -force c:/tcl8975@ d:/tcl8975@} sl@0: file mkdir c:/tcl8975@ sl@0: if [catch {file rename c:/tcl8975@ d:/}] { sl@0: set msg d:/tcl8975@ sl@0: } else { sl@0: set msg [glob c:/tcl8975@ d:/tcl8975@] sl@0: file delete -force d:/tcl8975@ sl@0: } sl@0: file delete -force c:/tcl8975@ sl@0: set msg sl@0: } {d:/tcl8975@} sl@0: test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \ sl@0: {unixOnly notRoot} { sl@0: cleanup /tmp sl@0: file mkdir td1 sl@0: file rename td1 /tmp sl@0: glob td* /tmp/td* sl@0: } {/tmp/td1} sl@0: test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \ sl@0: {unixOnly notRoot} { sl@0: cleanup /tmp sl@0: createfile tf1 sl@0: file rename tf1 /tmp sl@0: glob tf* /tmp/tf* sl@0: } {/tmp/tf1} sl@0: test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \ sl@0: {unixOnly notRoot xdev} { sl@0: cleanup /tmp sl@0: file mkdir td1/td2/td3 sl@0: file attributes td1 -permissions 0000 sl@0: set msg [list [catch {file rename td1 /tmp} msg] $msg] sl@0: file attributes td1 -permissions 0755 sl@0: set msg sl@0: } {1 {error renaming "td1": permission denied}} sl@0: test fCmd-6.24 {CopyRenameOneFile: error uses original name} \ sl@0: {unixOnly notRoot} { sl@0: cleanup sl@0: file mkdir ~/td1/td2 sl@0: set td1name [file join [file dirname ~] [file tail ~] td1] sl@0: file attributes $td1name -permissions 0000 sl@0: set msg [list [catch {file copy ~/td1 td1} msg] $msg] sl@0: file attributes $td1name -permissions 0755 sl@0: file delete -force ~/td1 sl@0: set msg sl@0: } {1 {error copying "~/td1": permission denied}} sl@0: test fCmd-6.25 {CopyRenameOneFile: error uses original name} \ sl@0: {unixOnly notRoot} { sl@0: cleanup sl@0: file mkdir td2 sl@0: file mkdir ~/td1 sl@0: set td1name [file join [file dirname ~] [file tail ~] td1] sl@0: file attributes $td1name -permissions 0000 sl@0: set msg [list [catch {file copy td2 ~/td1} msg] $msg] sl@0: file attributes $td1name -permissions 0755 sl@0: file delete -force ~/td1 sl@0: set msg sl@0: } {1 {error copying "td2" to "~/td1/td2": permission denied}} sl@0: test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \ sl@0: {unixOnly notRoot} { sl@0: cleanup sl@0: file mkdir ~/td1/td2 sl@0: set td2name [file join [file dirname ~] [file tail ~] td1 td2] sl@0: file attributes $td2name -permissions 0000 sl@0: set msg [list [catch {file copy ~/td1 td1} msg] $msg] sl@0: file attributes $td2name -permissions 0755 sl@0: file delete -force ~/td1 sl@0: set msg sl@0: } "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}" sl@0: test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \ sl@0: {unixOnly notRoot xdev} { sl@0: cleanup /tmp sl@0: file mkdir td1/td2/td3 sl@0: file mkdir /tmp/td1 sl@0: createfile /tmp/td1/tf1 sl@0: list [catch {file rename -force td1 /tmp} msg] $msg sl@0: } {1 {error renaming "td1" to "/tmp/td1": file already exists}} sl@0: test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \ sl@0: {unixOnly notRoot xdev} { sl@0: cleanup /tmp sl@0: file mkdir td1/td2/td3 sl@0: file attributes td1/td2/td3 -permissions 0000 sl@0: set msg [list [catch {file rename td1 /tmp} msg] $msg] sl@0: file attributes td1/td2/td3 -permissions 0755 sl@0: set msg sl@0: } {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}} sl@0: test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \ sl@0: {unixOnly notRoot xdev} { sl@0: cleanup /tmp sl@0: file mkdir td1/td2/td3 sl@0: file rename td1 /tmp sl@0: glob td* /tmp/td1/t* sl@0: } {/tmp/td1/td2} sl@0: test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \ sl@0: {unixOnly notRoot} { sl@0: cleanup sl@0: file mkdir foo/bar sl@0: file attr foo -perm 040555 sl@0: set catchResult [catch {file rename foo/bar /tmp} msg] sl@0: set msg [lindex [split $msg :] end] sl@0: catch {file delete /tmp/bar} sl@0: catch {file attr foo -perm 040777} sl@0: catch {file delete -force foo} sl@0: list $catchResult $msg sl@0: } {1 { permission denied}} sl@0: test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \ sl@0: {unixOnly notRoot xdev} { sl@0: catch {cleanup /tmp} sl@0: file mkdir /tmp/td1 sl@0: createfile /tmp/td1/tf1 sl@0: file rename /tmp/td1/tf1 tf1 sl@0: list [file exists /tmp/td1/tf1] [file exists tf1] sl@0: } {0 1} sl@0: test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} { sl@0: cleanup sl@0: list [catch {file copy tf1 tf2} msg] $msg sl@0: } {1 {error copying "tf1": no such file or directory}} sl@0: catch {cleanup /tmp} sl@0: sl@0: test fCmd-7.1 {FileForceOption: none} {notRoot} { sl@0: cleanup sl@0: file mkdir [file join tf1 tf2] sl@0: list [catch {file delete tf1} msg] $msg sl@0: } {1 {error deleting "tf1": directory not empty}} sl@0: test fCmd-7.2 {FileForceOption: -force} {notRoot} { sl@0: cleanup sl@0: file mkdir [file join tf1 tf2] sl@0: file delete -force tf1 sl@0: } {} sl@0: test fCmd-7.3 {FileForceOption: --} {notRoot} { sl@0: createfile -tf1 sl@0: file delete -- -tf1 sl@0: } {} sl@0: test fCmd-7.4 {FileForceOption: bad option} {notRoot} { sl@0: createfile -tf1 sl@0: set msg [list [catch {file delete -tf1} msg] $msg] sl@0: file delete -- -tf1 sl@0: set msg sl@0: } {1 {bad option "-tf1": should be -force or --}} sl@0: test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} { sl@0: createfile -- sl@0: createfile -force sl@0: file delete -force -force -- -- -force sl@0: list [catch {glob -- -- -force} msg] $msg sl@0: } {1 {no files matched glob patterns "-- -force"}} sl@0: sl@0: test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ sl@0: {unixOnly notRoot knownBug} { sl@0: # Labelled knownBug because it is dangerous [Bug: 3881] sl@0: file mkdir td1 sl@0: file attr td1 -perm 040000 sl@0: set result [list [catch {file rename ~$user td1} msg] $msg] sl@0: file delete -force td1 sl@0: set result sl@0: } "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}" sl@0: test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} { sl@0: string equal [file tail ~$user] ~$user sl@0: } 0 sl@0: test fCmd-8.3 {file copy and path translation: ensure correct error} { sl@0: list [catch {file copy ~ [file join this file doesnt exist]} res] $res sl@0: } [list 1 \ sl@0: "error copying \"~\" to \"[file join this file doesnt exist]\":\ sl@0: no such file or directory"] sl@0: sl@0: test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: file mkdir td2 sl@0: file attr td2 -perm 040000 sl@0: set result [list [catch {file rename td1 td2/} msg] $msg] sl@0: file delete -force td2 sl@0: file delete -force td1 sl@0: set result sl@0: } {1 {error renaming "td1" to "td2/td1": permission denied}} sl@0: test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} { sl@0: cleanup sl@0: list [catch {file rename tf1 tf2} msg] $msg sl@0: } {1 {error renaming "tf1": no such file or directory}} sl@0: test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: testchmod 444 tf2 sl@0: file rename tf1 tf3 sl@0: file rename tf2 tf4 sl@0: list [lsort [glob tf*]] [file writable tf3] [file writable tf4] sl@0: } {{tf3 tf4} 1 0} sl@0: test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} { sl@0: cleanup sl@0: file mkdir td1 td2 sl@0: testchmod 555 td2 sl@0: file rename td1 td3 sl@0: file rename td2 td4 sl@0: list [lsort [glob td*]] [file writable td3] [file writable td4] sl@0: } {{td3 td4} 1 0} sl@0: test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} { sl@0: cleanup sl@0: createfile tf1 tf1 sl@0: createfile tf2 tf2 sl@0: testchmod 444 tf2 sl@0: file rename -force tf1 tf1 sl@0: file rename -force tf2 tf2 sl@0: list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2] sl@0: } {tf1 tf2 1 0} sl@0: test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} { sl@0: cleanup sl@0: file mkdir td1 sl@0: file mkdir td2 sl@0: testchmod 555 td2 sl@0: file rename -force td1 . sl@0: file rename -force td2 . sl@0: list [lsort [glob td*]] [file writable td1] [file writable td2] sl@0: } {{td1 td2} 1 0} sl@0: test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: createfile tfs1 sl@0: createfile tfs2 sl@0: createfile tfs3 sl@0: createfile tfs4 sl@0: createfile tfd1 sl@0: createfile tfd2 sl@0: createfile tfd3 sl@0: createfile tfd4 sl@0: testchmod 444 tfs3 sl@0: testchmod 444 tfs4 sl@0: testchmod 444 tfd2 sl@0: testchmod 444 tfd4 sl@0: set msg [list [catch {file rename tf1 tf2} msg] $msg] sl@0: file rename -force tfs1 tfd1 sl@0: file rename -force tfs2 tfd2 sl@0: file rename -force tfs3 tfd3 sl@0: file rename -force tfs4 tfd4 sl@0: list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] sl@0: } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0} sl@0: test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod notNetworkFilesystem} { sl@0: # Under unix, you can rename a read-only directory, but you can't sl@0: # move it into another directory. sl@0: sl@0: cleanup sl@0: file mkdir td1 sl@0: file mkdir [file join td2 td1] sl@0: file mkdir tds1 sl@0: file mkdir tds2 sl@0: file mkdir tds3 sl@0: file mkdir tds4 sl@0: file mkdir [file join tdd1 tds1] sl@0: file mkdir [file join tdd2 tds2] sl@0: file mkdir [file join tdd3 tds3] sl@0: file mkdir [file join tdd4 tds4] sl@0: if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { sl@0: testchmod 555 tds3 sl@0: testchmod 555 tds4 sl@0: } sl@0: if {$tcl_platform(platform) != "macintosh"} { sl@0: testchmod 555 [file join tdd2 tds2] sl@0: testchmod 555 [file join tdd4 tds4] sl@0: } sl@0: set msg [list [catch {file rename td1 td2} msg] $msg] sl@0: file rename -force tds1 tdd1 sl@0: file rename -force tds2 tdd2 sl@0: file rename -force tds3 tdd3 sl@0: file rename -force tds4 tdd4 sl@0: if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { sl@0: set w3 [file writable [file join tdd3 tds3]] sl@0: set w4 [file writable [file join tdd4 tds4]] sl@0: } else { sl@0: set w3 0 sl@0: set w4 0 sl@0: } sl@0: list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \ sl@0: [file writable [file join tdd2 tds2]] $w3 $w4 sl@0: } [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}] sl@0: test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot testchmod} { sl@0: cleanup sl@0: file mkdir tds1 sl@0: file mkdir tds2 sl@0: file mkdir [file join tdd1 tds1 xxx] sl@0: file mkdir [file join tdd2 tds2 xxx] sl@0: if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { sl@0: testchmod 555 tds2 sl@0: } sl@0: set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg] sl@0: set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg] sl@0: if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { sl@0: set w2 [file writable tds2] sl@0: } else { sl@0: set w2 0 sl@0: } sl@0: list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2 sl@0: } [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}] sl@0: test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: file mkdir td1 sl@0: testchmod 444 tf2 sl@0: file rename tf1 [file join td1 tf3] sl@0: file rename tf2 [file join td1 tf4] sl@0: list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ sl@0: [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] sl@0: } [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] sl@0: test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} { sl@0: cleanup sl@0: file mkdir td1 sl@0: file mkdir td2 sl@0: file mkdir td3 sl@0: if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { sl@0: testchmod 555 td2 sl@0: } sl@0: file rename td1 [file join td3 td3] sl@0: file rename td2 [file join td3 td4] sl@0: if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} { sl@0: set w4 [file writable [file join td3 td4]] sl@0: } else { sl@0: set w4 0 sl@0: } sl@0: list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ sl@0: [file writable [file join td3 td3]] $w4 sl@0: } [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}] sl@0: test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod notNetworkFilesystem} { sl@0: cleanup sl@0: file mkdir [file join td1 td2] [file join td2 td1] sl@0: if {$tcl_platform(platform) != "macintosh"} { sl@0: testchmod 555 [file join td2 td1] sl@0: } sl@0: file mkdir [file join td3 td4] [file join td4 td3] sl@0: file rename -force td3 td4 sl@0: set msg [list [file exists td3] [file exists [file join td4 td3 td4]] \ sl@0: [catch {file rename td1 td2} msg] $msg] sl@0: if {$tcl_platform(platform) != "macintosh"} { sl@0: testchmod 755 [file join td2 td1] sl@0: } sl@0: set msg sl@0: } [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}] sl@0: test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {notRoot} { sl@0: cleanup sl@0: file mkdir [file join td1 td2] [file join td2 td1 td4] sl@0: list [catch {file rename -force td1 td2} msg] $msg sl@0: } [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}] sl@0: test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: list [glob td*] [list [catch {file rename td1 td1} msg] $msg] sl@0: } [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}] sl@0: test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \ sl@0: {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: createfile tf1 sl@0: list [catch {file rename -force td1 tf1} msg] $msg sl@0: } {1 {can't overwrite file "tf1" with directory "td1"}} sl@0: test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \ sl@0: {notRoot} { sl@0: cleanup sl@0: file mkdir td1/tf1 sl@0: createfile tf1 sl@0: list [catch {file rename -force tf1 td1} msg] $msg sl@0: } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}] sl@0: sl@0: test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} { sl@0: cleanup sl@0: list [catch {file copy tf1 tf2} msg] $msg sl@0: } {1 {error copying "tf1": no such file or directory}} sl@0: test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} { sl@0: cleanup sl@0: createfile tf1 tf1 sl@0: createfile tf2 tf2 sl@0: testchmod 444 tf2 sl@0: file copy tf1 tf3 sl@0: file copy tf2 tf4 sl@0: list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] sl@0: } {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} sl@0: test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 95or98 testchmod} { sl@0: cleanup sl@0: file mkdir [file join td1 tdx] sl@0: file mkdir [file join td2 tdy] sl@0: testchmod 555 td2 sl@0: file copy td1 td3 sl@0: file copy td2 td4 sl@0: set msg [list [lsort [glob td*]] [glob -directory td3 t*] \ sl@0: [glob -directory td4 t*] [file writable td3] [file writable td4]] sl@0: if {$tcl_platform(platform) != "macintosh"} { sl@0: testchmod 755 td2 sl@0: testchmod 755 td4 sl@0: } sl@0: set msg sl@0: } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}] sl@0: test fCmd-10.3.1 {file copy: comprehensive: dir to new name} {notRoot pc 2000orNewer testchmod} { sl@0: # On Windows with ACLs, copying a directory is defined like this sl@0: cleanup sl@0: file mkdir [file join td1 tdx] sl@0: file mkdir [file join td2 tdy] sl@0: testchmod 555 td2 sl@0: file copy td1 td3 sl@0: file copy td2 td4 sl@0: set msg [list [lsort [glob td*]] [glob -directory td3 t*] \ sl@0: [glob -directory td4 t*] [file writable td3] [file writable td4]] sl@0: testchmod 755 td2 sl@0: testchmod 755 td4 sl@0: set msg sl@0: } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1}] sl@0: test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: createfile tfs1 sl@0: createfile tfs2 sl@0: createfile tfs3 sl@0: createfile tfs4 sl@0: createfile tfd1 sl@0: createfile tfd2 sl@0: createfile tfd3 sl@0: createfile tfd4 sl@0: testchmod 444 tfs3 sl@0: testchmod 444 tfs4 sl@0: testchmod 444 tfd2 sl@0: testchmod 444 tfd4 sl@0: set msg [list [catch {file copy tf1 tf2} msg] $msg] sl@0: file copy -force tfs1 tfd1 sl@0: file copy -force tfs2 tfd2 sl@0: file copy -force tfs3 tfd3 sl@0: file copy -force tfs4 tfd4 sl@0: list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] sl@0: } {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0} sl@0: test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} { sl@0: cleanup sl@0: file mkdir td1 sl@0: file mkdir [file join td2 td1] sl@0: file mkdir tds1 sl@0: file mkdir tds2 sl@0: file mkdir tds3 sl@0: file mkdir tds4 sl@0: file mkdir [file join tdd1 tds1] sl@0: file mkdir [file join tdd2 tds2] sl@0: file mkdir [file join tdd3 tds3] sl@0: file mkdir [file join tdd4 tds4] sl@0: if {$tcl_platform(platform) != "macintosh"} { sl@0: testchmod 555 tds3 sl@0: testchmod 555 tds4 sl@0: testchmod 555 [file join tdd2 tds2] sl@0: testchmod 555 [file join tdd4 tds4] sl@0: } sl@0: set a1 [list [catch {file copy td1 td2} msg] $msg] sl@0: set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg] sl@0: set a3 [catch {file copy -force tds2 tdd2}] sl@0: set a4 [catch {file copy -force tds3 tdd3}] sl@0: set a5 [catch {file copy -force tds4 tdd4}] sl@0: list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 sl@0: } [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}] sl@0: test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \ sl@0: {notRoot unixOrPc testchmod} { sl@0: cleanup sl@0: file mkdir tds1 sl@0: file mkdir tds2 sl@0: file mkdir [file join tdd1 tds1 xxx] sl@0: file mkdir [file join tdd2 tds2 xxx] sl@0: testchmod 555 tds2 sl@0: set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg] sl@0: set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg] sl@0: list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2] sl@0: } [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}] sl@0: test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} { sl@0: cleanup sl@0: createfile tf1 sl@0: createfile tf2 sl@0: file mkdir td1 sl@0: testchmod 444 tf2 sl@0: file copy tf1 [file join td1 tf3] sl@0: file copy tf2 [file join td1 tf4] sl@0: list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \ sl@0: [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] sl@0: } [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] sl@0: test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \ sl@0: {notRoot unixOrPc 95or98 testchmod} { sl@0: cleanup sl@0: file mkdir td1 sl@0: file mkdir td2 sl@0: file mkdir td3 sl@0: testchmod 555 td2 sl@0: file copy td1 [file join td3 td3] sl@0: file copy td2 [file join td3 td4] sl@0: list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ sl@0: [file writable [file join td3 td3]] [file writable [file join td3 td4]] sl@0: } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}] sl@0: test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} \ sl@0: {notRoot pc 2000orNewer testchmod} { sl@0: # On Windows with ACLs, copying a directory is defined like this sl@0: cleanup sl@0: file mkdir td1 sl@0: file mkdir td2 sl@0: file mkdir td3 sl@0: testchmod 555 td2 sl@0: file copy td1 [file join td3 td3] sl@0: file copy td2 [file join td3 td4] sl@0: list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ sl@0: [file writable [file join td3 td3]] [file writable [file join td3 td4]] sl@0: } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}] sl@0: test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \ sl@0: {notRoot} { sl@0: cleanup sl@0: file mkdir td1 sl@0: createfile tf1 sl@0: list [catch {file copy -force td1 tf1} msg] $msg sl@0: } {1 {can't overwrite file "tf1" with directory "td1"}} sl@0: test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \ sl@0: {notRoot} { sl@0: cleanup sl@0: file mkdir [file join td1 tf1] sl@0: createfile tf1 sl@0: list [catch {file copy -force tf1 td1} msg] $msg sl@0: } [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}] sl@0: test fCmd-10.11 {file copy: copy to empty file name} { sl@0: cleanup sl@0: createfile tf1 sl@0: list [catch {file copy tf1 ""} msg] $msg sl@0: } {1 {error copying "tf1" to "": no such file or directory}} sl@0: test fCmd-10.12 {file rename: rename to empty file name} { sl@0: cleanup sl@0: createfile tf1 sl@0: list [catch {file rename tf1 ""} msg] $msg sl@0: } {1 {error renaming "tf1" to "": no such file or directory}} sl@0: cleanup sl@0: sl@0: # old tests sl@0: sl@0: test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} { sl@0: catch {file delete -force -- -tfa1} sl@0: set s [createfile -tfa1] sl@0: file rename -- -tfa1 tfa2 sl@0: set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]] sl@0: file delete tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} { sl@0: catch {file delete -force -- tfa1} sl@0: set s [createfile tfa1] sl@0: set r1 [catch {file rename -x tfa1 tfa2}] sl@0: set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]] sl@0: file delete tfa1 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-11.3 {TclFileRenameCmd: bad \# args} { sl@0: catch {file rename -- } sl@0: } {1} sl@0: sl@0: test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} { sl@0: global env sl@0: set temp $env(HOME) sl@0: unset env(HOME) sl@0: set result [catch {file rename tfa ~/foobar }] sl@0: set env(HOME) $temp sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfa3} sl@0: createfile tfa1 sl@0: createfile tfa2 sl@0: createfile tfa3 sl@0: set result [catch {file rename tfa1 tfa2 tfa3}] sl@0: file delete tfa1 tfa2 tfa3 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfad} sl@0: set s [createfile tfa1] sl@0: file mkdir tfad sl@0: file rename tfa1 tfad sl@0: set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]] sl@0: file delete -force tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfad} sl@0: set s1 [createfile tfa1 ] sl@0: set s2 [createfile tfa2 ] sl@0: file mkdir tfad sl@0: file rename tfa1 tfa2 tfad sl@0: set r1 [checkcontent tfad/tfa1 $s1] sl@0: set r2 [checkcontent tfad/tfa2 $s2] sl@0: sl@0: set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]] sl@0: sl@0: file delete -force tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: set s [createfile tfa ] sl@0: file mkdir tfad sl@0: file mkdir tfad/tfa sl@0: set r1 [catch {file rename tfa tfad}] sl@0: set r2 [checkcontent tfa $s] sl@0: set r3 [file isdir tfad] sl@0: set result [expr $r1 && $r2 && $r3 ] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # Coverage tests for renamefile() ; sl@0: # sl@0: test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} { sl@0: global env sl@0: set temp $env(HOME) sl@0: unset env(HOME) sl@0: set result [catch {file rename ~/tfa1 tfa2}] sl@0: set env(HOME) $temp sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} { sl@0: global env sl@0: set temp $env(HOME) sl@0: unset env(HOME) sl@0: set s [createfile tfa1] sl@0: file mkdir tfad sl@0: set result [catch {file rename tfa1 ~/tfa2 tfad}] sl@0: set env(HOME) $temp sl@0: file delete -force tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-12.3 {renamefile: stat failing on source} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: set r1 [catch {file rename tfa1 tfa2}] sl@0: expr {$r1 && ![file exists tfa1] && ![file exists tfa2]} sl@0: } {1} sl@0: sl@0: test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: set s1 [createfile tfa ] sl@0: file mkdir tfad sl@0: file mkdir tfad/tfa sl@0: set r1 [catch {file rename tfa tfad}] sl@0: set r2 [checkcontent tfa $s1] sl@0: set r3 [file isdir tfad/tfa] sl@0: set result [expr $r1 && $r2 && $r3] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa sl@0: file mkdir tfad sl@0: set s [createfile tfad/tfa] sl@0: set r1 [catch {file rename tfa tfad}] sl@0: set r2 [checkcontent tfad/tfa $s] sl@0: set r3 [file isdir tfad] sl@0: set r4 [file isdir tfa] sl@0: set result [expr $r1 && $r2 && $r3 && $r4 ] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: set s [createfile tfa1] sl@0: file rename tfa1 tfa2 sl@0: set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]] sl@0: file delete tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} { sl@0: catch {file delete -force -- tfad} sl@0: file mkdir tfad sl@0: file mkdir tfad/dir sl@0: set result [catch {file rename tfad tfad/dir}] sl@0: file delete -force tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: file mkdir tfa/dir sl@0: file attributes tfa -permissions 0555 sl@0: set result [catch {file rename tfa/dir tfa2}] sl@0: file attributes tfa -permissions 0777 sl@0: file delete -force tfa sl@0: set result sl@0: } {1} sl@0: sl@0: sl@0: test fCmd-12.9 {renamefile: moving a file across volumes} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa /tmp/tfa} sl@0: set s [createfile tfa ] sl@0: file rename tfa /tmp sl@0: set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]] sl@0: file delete /tmp/tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-12.10 {renamefile: moving a directory across volumes } \ sl@0: {unixOnly notRoot} { sl@0: catch {file delete -force -- tfad /tmp/tfad} sl@0: file mkdir tfad sl@0: set s [createfile tfad/a ] sl@0: file rename tfad /tmp sl@0: set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]] sl@0: file delete -force /tmp/tfad sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # Coverage tests for TclCopyFilesCmd() sl@0: # sl@0: test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} { sl@0: catch {file delete -force -- tfa1} sl@0: set s [createfile tfa1] sl@0: file copy -force tfa1 tfa2 sl@0: set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] sl@0: file delete tfa1 tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} { sl@0: catch {file delete -force -- tfa1} sl@0: set s [createfile -tfa1] sl@0: file copy -- -tfa1 tfa2 sl@0: set result [expr [checkcontent tfa2 $s] && [checkcontent -tfa1 $s]] sl@0: file delete -- -tfa1 tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} { sl@0: catch {file delete -force -- tfa1} sl@0: set s [createfile tfa1] sl@0: set r1 [catch {file copy -x tfa1 tfa2}] sl@0: set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]] sl@0: file delete tfa1 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} { sl@0: catch {file copy -- } sl@0: } {1} sl@0: sl@0: test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} { sl@0: global env sl@0: set temp $env(HOME) sl@0: unset env(HOME) sl@0: set result [catch {file copy tfa ~/foobar }] sl@0: set env(HOME) $temp sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfa3} sl@0: createfile tfa1 sl@0: createfile tfa2 sl@0: createfile tfa3 sl@0: set result [catch {file copy tfa1 tfa2 tfa3}] sl@0: file delete tfa1 tfa2 tfa3 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfad} sl@0: set s [createfile tfa1] sl@0: file mkdir tfad sl@0: file copy tfa1 tfad sl@0: set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]] sl@0: file delete -force tfad tfa1 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfad} sl@0: set s1 [createfile tfa1 ] sl@0: set s2 [createfile tfa2 ] sl@0: file mkdir tfad sl@0: file copy tfa1 tfa2 tfad sl@0: set r1 [checkcontent tfad/tfa1 $s1] sl@0: set r2 [checkcontent tfad/tfa2 $s2] sl@0: set r3 [checkcontent tfa1 $s1] sl@0: set r4 [checkcontent tfa2 $s2] sl@0: set result [expr $r1 && $r2 && $r3 && $r4 ] sl@0: sl@0: file delete -force tfad tfa1 tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: set s [createfile tfa ] sl@0: file mkdir tfad sl@0: file mkdir tfad/tfa sl@0: set r1 [catch {file copy tfa tfad}] sl@0: set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]] sl@0: set r3 [file isdir tfad] sl@0: set result [expr $r1 && $r2 && $r3 ] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # Coverage tests for copyfile() sl@0: # sl@0: test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} { sl@0: global env sl@0: set temp $env(HOME) sl@0: unset env(HOME) sl@0: set result [catch {file copy ~/tfa1 tfa2}] sl@0: set env(HOME) $temp sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} { sl@0: global env sl@0: set temp $env(HOME) sl@0: unset env(HOME) sl@0: set s [createfile tfa1] sl@0: file mkdir tfad sl@0: set r1 [catch {file copy tfa1 ~/tfa2 tfad}] sl@0: set result [expr $r1 && [checkcontent tfad/tfa1 $s]] sl@0: set env(HOME) $temp sl@0: file delete -force tfa1 tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-14.3 {copyfile: stat failing on source} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: set r1 [catch {file copy tfa1 tfa2}] sl@0: expr $r1 && ![file exists tfa1] && ![file exists tfa2] sl@0: } {1} sl@0: sl@0: test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: set s1 [createfile tfa ] sl@0: file mkdir tfad sl@0: file mkdir tfad/tfa sl@0: set r1 [catch {file copy tfa tfad}] sl@0: set r2 [checkcontent tfa $s1] sl@0: set r3 [file isdir tfad] sl@0: set r4 [file isdir tfad/tfa] sl@0: set result [expr $r1 && $r2 && $r3 && $r4 ] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa sl@0: file mkdir tfad sl@0: set s [createfile tfad/tfa] sl@0: set r1 [catch {file copy tfa tfad}] sl@0: set r2 [checkcontent tfad/tfa $s] sl@0: set r3 [file isdir tfad] sl@0: set r4 [file isdir tfa] sl@0: set result [expr $r1 && $r2 && $r3 && $r4 ] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} { sl@0: catch {file delete -force -- tfa tfa2} sl@0: set s [createfile tfa] sl@0: file copy tfa tfa2 sl@0: set result [expr [checkcontent tfa $s] && [checkcontent tfa2 $s]] sl@0: file delete tfa tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} { sl@0: catch {file delete -force -- tfa tfa2} sl@0: file mkdir tfa sl@0: set s [createfile tfa/file] sl@0: file copy tfa tfa2 sl@0: set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]] sl@0: file delete -force tfa tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa/dir/a/b/c sl@0: file attributes tfa/dir -permissions 0000 sl@0: set r1 [catch {file copy tfa tfa2}] sl@0: file attributes tfa/dir -permissions 0777 sl@0: set result $r1 sl@0: file delete -force tfa tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # Coverage tests for TclMkdirCmd() sl@0: # sl@0: test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} { sl@0: global env sl@0: set temp $env(HOME) sl@0: unset env(HOME) sl@0: set result [catch {file mkdir ~/tfa}] sl@0: set env(HOME) $temp sl@0: set result sl@0: } {1} sl@0: # sl@0: # Can Tcl_SplitPath return argc == 0? If so them we need a sl@0: # test for that code. sl@0: # sl@0: test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: set result [file isdirectory tfa] sl@0: file delete tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: file mkdir tfa1 tfa2 sl@0: set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]] sl@0: file delete tfa1 tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: createfile tfa/file sl@0: file attributes tfa -permissions 0000 sl@0: set result [catch {file mkdir tfa/file}] sl@0: file attributes tfa -permissions 0777 sl@0: file delete -force tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \ sl@0: {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa/a/b/c sl@0: set result [file isdir tfa/a/b/c] sl@0: file delete -force tfa sl@0: set result sl@0: } {1} sl@0: sl@0: sl@0: test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: set s [createfile tfa] sl@0: set r1 [catch {file mkdir tfa}] sl@0: set r2 [file isdir tfa] sl@0: set r3 [file exists tfa] sl@0: set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]] sl@0: file delete tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: file mkdir tfa1 tfa2/a/b/c sl@0: set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]] sl@0: file delete -force tfa1 tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} { sl@0: file mkdir tfa sl@0: file mkdir tfa sl@0: set result [file isdir tfa] sl@0: file delete tfa sl@0: set result sl@0: } {1} sl@0: sl@0: sl@0: # Coverage tests for TclDeleteFilesCommand() sl@0: test fCmd-16.1 {test the -- argument} {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: createfile tfa sl@0: file delete -- tfa sl@0: file exists tfa sl@0: } {0} sl@0: sl@0: test fCmd-16.2 {test the -force and -- arguments} {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: createfile tfa sl@0: file delete -force -- tfa sl@0: file exists tfa sl@0: } {0} sl@0: sl@0: test fCmd-16.3 {test bad option} {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: createfile tfa sl@0: set result [catch {file delete -dog tfa}] sl@0: file delete tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-16.4 {test not enough args} {notRoot} { sl@0: catch {file delete} sl@0: } {1} sl@0: sl@0: test fCmd-16.5 {test not enough args with options} {notRoot} { sl@0: catch {file delete --} sl@0: } {1} sl@0: sl@0: test fCmd-16.6 {delete: source filename translation failing} {notRoot} { sl@0: global env sl@0: set temp $env(HOME) sl@0: unset env(HOME) sl@0: set result [catch {file delete ~/tfa}] sl@0: set env(HOME) $temp sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: createfile tfa/a sl@0: set result [catch {file delete tfa }] sl@0: file delete -force tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-16.8 {remove a normal file } {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: createfile tfa/a sl@0: set result [catch {file delete tfa }] sl@0: file delete -force tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-16.9 {error while deleting file } {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: createfile tfa/a sl@0: file attributes tfa -permissions 0555 sl@0: set result [catch {file delete tfa/a }] sl@0: ####### sl@0: ####### If any directory in a tree that is being removed does not sl@0: ####### have write permission, the process will fail! sl@0: ####### This is also the case with "rm -rf" sl@0: ####### sl@0: file attributes tfa -permissions 0777 sl@0: file delete -force tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-16.10 {deleting multiple files} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: createfile tfa1 sl@0: createfile tfa2 sl@0: file delete tfa1 tfa2 sl@0: expr ![file exists tfa1] && ![file exists tfa2] sl@0: } {1} sl@0: sl@0: test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file delete tfa sl@0: set result 1 sl@0: } {1} sl@0: sl@0: # More coverage tests for mkpath() sl@0: test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa1} sl@0: file mkdir tfa1 sl@0: file attributes tfa1 -permissions 0555 sl@0: set result [catch {file mkdir tfa1/tfa2}] sl@0: file attributes tfa1 -permissions 0777 sl@0: file delete -force tfa1 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa/a/b sl@0: set result [file isdir tfa/a/b ] sl@0: file delete tfa/a/b tfa/a tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: set f [file join [pwd] tfa a ] sl@0: file mkdir $f sl@0: set result [file isdir $f ] sl@0: file delete $f [file join [pwd] tfa] sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # Functionality tests for TclFileRenameCmd() sl@0: # sl@0: sl@0: test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \ sl@0: {notRoot} { sl@0: catch {file delete -force -- tfad} sl@0: file mkdir tfad/dir sl@0: cd tfad/dir sl@0: set s [createfile foo ] sl@0: file rename foo bar sl@0: file rename bar ./foo sl@0: file rename ./foo bar sl@0: file rename ./bar ./foo sl@0: file rename foo ../dir/bar sl@0: file rename ../dir/bar ./foo sl@0: file rename ../../tfad/dir/foo ../../tfad/dir/bar sl@0: file rename [file join [pwd] bar] foo sl@0: file rename foo [file join [pwd] bar] sl@0: set result [expr [checkcontent bar $s] && ![file exists foo]] sl@0: cd ../.. sl@0: file delete -force tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: file mkdir tfa1 sl@0: file rename tfa1 tfa2 sl@0: set result [expr [file exists tfa2] && ![file exists tfa1]] sl@0: file delete tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfad1 tfad2} sl@0: set s [createfile tfa1 ] sl@0: file mkdir tfad1 tfad2 sl@0: file rename tfa1 tfad1 tfad2 sl@0: set r1 [checkcontent tfad2/tfa1 $s] sl@0: set r2 [file isdir tfad2/tfad1] sl@0: set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]] sl@0: file delete tfad2/tfa1 sl@0: file delete -force tfad2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: set s [createfile tfa ] sl@0: file mkdir tfad sl@0: set r1 [catch {file rename tfad tfa}] sl@0: set r2 [checkcontent tfa $s] sl@0: set r3 [file isdir tfad] sl@0: set result [expr $r1 && $r2 && $r3 ] sl@0: file delete tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: set s [createfile tfa ] sl@0: file mkdir tfad/tfa sl@0: set r1 [catch {file rename tfa tfad}] sl@0: set r2 [checkcontent tfa $s] sl@0: set r3 [file isdir tfad/tfa] sl@0: set result [expr $r1 && $r2 && $r3 ] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # On Windows there is no easy way to determine if two files are the same sl@0: # sl@0: test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: set s [createfile tfa] sl@0: set r1 [catch {file rename tfa tfa}] sl@0: set result [expr $r1 && [checkcontent tfa $s]] sl@0: file delete tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \ sl@0: {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa tfad/tfa sl@0: set r1 [catch {file rename tfa tfad}] sl@0: set result [expr $r1 && [file isdir tfa]] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \ sl@0: {notRoot notNetworkFilesystem} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa tfad/tfa sl@0: file rename -force tfa tfad sl@0: set result [expr ![file isdir tfa]] sl@0: file delete -force tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \ sl@0: {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa tfad/tfa/file sl@0: set r1 [catch {file rename tfa tfad}] sl@0: set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \ sl@0: {notRoot notNetworkFilesystem} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa tfad/tfa/file sl@0: set r1 [catch {file rename -force tfa tfad}] sl@0: set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} { sl@0: catch {file delete -force -- tfa1} sl@0: set r1 [catch {file rename tfa1 tfa2}] sl@0: set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]] sl@0: } {1} sl@0: sl@0: test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \ sl@0: {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfa3} sl@0: sl@0: set s [createfile tfa1] sl@0: file link -symbolic tfa2 tfa1 sl@0: file rename tfa2 tfa3 sl@0: set t [file type tfa3] sl@0: set result [expr {$t eq "link"}] sl@0: file delete tfa1 tfa3 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \ sl@0: {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfa3} sl@0: sl@0: file mkdir tfa1 sl@0: file link -symbolic tfa2 tfa1 sl@0: file rename tfa2 tfa3 sl@0: set t [file type tfa3] sl@0: set result [expr {$t eq "link"}] sl@0: file delete tfa1 tfa3 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \ sl@0: {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfa3} sl@0: sl@0: file mkdir tfa1/a/b/c/d sl@0: file mkdir tfa2 sl@0: set f [file join [pwd] tfa1/a/b] sl@0: set f2 [file join [pwd] {tfa2/b alias}] sl@0: file link -symbolic $f2 $f sl@0: file rename {tfa2/b alias/c} tfa3 sl@0: set r1 [file isdir tfa3] sl@0: set r2 [file exists tfa1/a/b/c] sl@0: set result [expr $r1 && !$r2] sl@0: file delete -force tfa1 tfa2 tfa3 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \ sl@0: {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfalink} sl@0: sl@0: file mkdir tfa1 sl@0: set s [createfile tfa2] sl@0: file link -symbolic tfalink tfa1 sl@0: sl@0: file rename tfa2 tfalink sl@0: set result [checkcontent tfa1/tfa2 $s ] sl@0: file delete -force tfa1 tfalink sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa1 tfalink} sl@0: sl@0: file mkdir tfa1 sl@0: file link -symbolic tfalink tfa1 sl@0: file delete tfa1 sl@0: file rename tfalink tfa2 sl@0: set result [expr [string compare [file type tfa2] "link"] == 0] sl@0: file delete tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: sl@0: # sl@0: # Coverage tests for TclUnixRmdir sl@0: # sl@0: test fCmd-19.1 {remove empty directory} {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: file delete tfa sl@0: file exists tfa sl@0: } {0} sl@0: sl@0: test fCmd-19.2 {rmdir error besides EEXIST} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: file mkdir tfa/a sl@0: file attributes tfa -permissions 0555 sl@0: set result [catch {file delete tfa/a}] sl@0: file attributes tfa -permissions 0777 sl@0: file delete -force tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-19.3 {recursive remove} {notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: file mkdir tfa/a sl@0: file delete -force tfa sl@0: file exists tfa sl@0: } {0} sl@0: sl@0: # sl@0: # TclUnixDeleteFile and TraversalDelete are covered by tests from the sl@0: # TclDeleteFilesCmd suite sl@0: # sl@0: # sl@0: sl@0: # sl@0: # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd sl@0: # sl@0: sl@0: test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \ sl@0: {unixOnly notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: file mkdir tfa/a sl@0: file attributes tfa/a -permissions 0000 sl@0: set result [catch {file delete -force tfa}] sl@0: file attributes tfa/a -permissions 0777 sl@0: file delete -force tfa sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \ sl@0: {unix notRoot} { sl@0: catch {file delete -force -- tfa} sl@0: file mkdir tfa sl@0: for {set i 1} {$i <= 300} {incr i} {createfile tfa/testfile_$i} sl@0: set result [catch {file delete -force tfa} msg] sl@0: while {[catch {file delete -force tfa}]} {} sl@0: list $result $msg sl@0: } {0 {}} sl@0: sl@0: # sl@0: # Feature testing for TclCopyFilesCmd sl@0: # sl@0: test fCmd-21.1 {copy : single file to nonexistant } {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: set s [createfile tfa1] sl@0: file copy tfa1 tfa2 sl@0: set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] sl@0: file delete tfa1 tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: file mkdir tfa1 sl@0: file copy tfa1 tfa2 sl@0: set result [expr [file isdir tfa2] && [file isdir tfa1]] sl@0: file delete tfa1 tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.3 {copy : single file into directory } {notRoot} { sl@0: catch {file delete -force -- tfa1 tfad} sl@0: set s [createfile tfa1] sl@0: file mkdir tfad sl@0: file copy tfa1 tfad sl@0: set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]] sl@0: file delete -force tfa1 tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.4 {copy : more than one source and target is not a directory} \ sl@0: {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfa3} sl@0: createfile tfa1 sl@0: createfile tfa2 sl@0: createfile tfa3 sl@0: set result [catch {file copy tfa1 tfa2 tfa3}] sl@0: file delete tfa1 tfa2 tfa3 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.5 {copy : multiple files into directory } {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2 tfad} sl@0: set s1 [createfile tfa1 ] sl@0: set s2 [createfile tfa2 ] sl@0: file mkdir tfad sl@0: file copy tfa1 tfa2 tfad sl@0: set r1 [checkcontent tfad/tfa1 $s1] sl@0: set r2 [checkcontent tfad/tfa2 $s2] sl@0: set r3 [checkcontent tfa1 $s1] sl@0: set r4 [checkcontent tfa2 $s2] sl@0: set result [expr $r1 && $r2 && $r3 && $r4] sl@0: file delete -force tfa1 tfa2 tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.6 {copy: mixed dirs and files into directory} \ sl@0: {notRoot notFileSharing} { sl@0: catch {file delete -force -- tfa1 tfad1 tfad2} sl@0: set s [createfile tfa1 ] sl@0: file mkdir tfad1 tfad2 sl@0: file copy tfa1 tfad1 tfad2 sl@0: set r1 [checkcontent [file join tfad2 tfa1] $s] sl@0: set r2 [file isdir [file join tfad2 tfad1]] sl@0: set r3 [checkcontent tfa1 $s] sl@0: set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]] sl@0: file delete -force tfa1 tfad1 tfad2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot dontCopyLinks} { sl@0: file mkdir tfad1 sl@0: file link -symbolic tfalink tfad1 sl@0: file delete tfad1 sl@0: set result [list [catch {file copy tfalink tfalink2} msg] $msg] sl@0: file delete -force tfalink tfalink2 sl@0: set result sl@0: } {1 {error copying "tfalink": the target of this link doesn't exist}} sl@0: test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} { sl@0: file mkdir tfad1 sl@0: file link -symbolic tfalink tfad1 sl@0: file delete tfad1 sl@0: file copy tfalink tfalink2 sl@0: set result [string match [file type tfalink2] link] sl@0: file delete tfalink tfalink2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unixOnly notRoot dontCopyLinks} { sl@0: file mkdir tfad1 sl@0: file link -symbolic tfalink tfad1 sl@0: file copy tfalink tfalink2 sl@0: set r1 [file type tfalink]; # link sl@0: set r2 [file type tfalink2]; # directory sl@0: set r3 [file isdir tfad1]; # 1 sl@0: set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}] sl@0: file delete -force tfad1 tfalink tfalink2 sl@0: set result sl@0: } {1} sl@0: test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unixOnly notRoot} { sl@0: file mkdir tfad1 sl@0: file link -symbolic tfalink tfad1 sl@0: file copy tfalink tfalink2 sl@0: set r1 [file type tfalink]; # link sl@0: set r2 [file type tfalink2]; # link sl@0: set r3 [file isdir tfad1]; # 1 sl@0: set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}] sl@0: file delete -force tfad1 tfalink tfalink2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} { sl@0: file mkdir tfad1 sl@0: file link -symbolic tfad1/tfalink "[pwd]/tfad1" sl@0: file copy tfad1 tfad2 sl@0: set result [string match [file type tfad2/tfalink] link] sl@0: file delete -force tfad1 tfad2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \ sl@0: {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa [file join tfad tfa] sl@0: set r1 [catch {file copy tfa tfad}] sl@0: set result [expr $r1 && [file isdir tfa]] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa [file join tfad tfa file] sl@0: set r1 [catch {file copy tfa tfad}] sl@0: set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \ sl@0: {notRoot} { sl@0: catch {file delete -force -- tfa tfad} sl@0: file mkdir tfa [file join tfad tfa file] sl@0: set r1 [catch {file copy -force tfa tfad}] sl@0: set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]] sl@0: file delete -force tfa tfad sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # Coverage testing for TclpRenameFile sl@0: # sl@0: test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: set s [createfile tfa1] sl@0: set s2 [createfile tfa2 q] sl@0: sl@0: set r1 [catch {rename tfa1 tfa2}] sl@0: file rename -force tfa1 tfa2 sl@0: set result [expr $r1 && [checkcontent tfa2 $s]] sl@0: file delete [glob tfa1 tfa2] sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} { sl@0: catch {file delete -force -- tfa1} sl@0: set s [createfile tfa1] sl@0: file rename -force tfa1 tfa1 sl@0: set result [checkcontent tfa1 $s] sl@0: file delete tfa1 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} { sl@0: catch {file delete -force -- d1 tfad} sl@0: file mkdir d1 [file join tfad d1] sl@0: set r1 [catch {file rename d1 tfad}] sl@0: set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]] sl@0: file delete -force d1 tfad sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} { sl@0: catch {file delete -force -- d1 tfad} sl@0: file mkdir d1 [file join tfad a b c] sl@0: file rename d1 [file join tfad a b c d1] sl@0: set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]] sl@0: file delete -force [glob d1 tfad] sl@0: set result sl@0: } {1} sl@0: sl@0: sl@0: # sl@0: # TclMacCopyFile needs to be redone. sl@0: # sl@0: test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} { sl@0: catch {file delete -force -- tfa1 tfa2} sl@0: set s [createfile tfa1] sl@0: set s2 [createfile tfa2 q] sl@0: sl@0: set r1 [catch {file copy tfa1 tfa2}] sl@0: file copy -force tfa1 tfa2 sl@0: set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]] sl@0: file delete tfa1 tfa2 sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # TclMacMkdir - basic cases are covered elsewhere. sl@0: # Error cases are not covered. sl@0: # sl@0: sl@0: # sl@0: # TclMacRmdir sl@0: # Error cases are not covered. sl@0: # sl@0: sl@0: test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} { sl@0: catch {file delete -force -- tfad} sl@0: sl@0: file mkdir [file join tfad dir] sl@0: sl@0: set result [catch {file delete tfad}] sl@0: file delete -force tfad sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # TclMacDeleteFile sl@0: # Error cases are not covered. sl@0: # sl@0: test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} { sl@0: catch {file delete -force -- tfa1} sl@0: sl@0: createfile tfa1 sl@0: file delete tfa1 sl@0: file exists tfa1 sl@0: } {0} sl@0: sl@0: # sl@0: # TclMacCopyDirectory sl@0: # Error cases are not covered. sl@0: # sl@0: test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} {notRoot notFileSharing} { sl@0: catch {file delete -force -- tfad1 tfad2} sl@0: sl@0: file mkdir [file join tfad1 a b c] sl@0: file copy tfad1 tfad2 sl@0: set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]] sl@0: file delete -force tfad1 tfad2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} { sl@0: catch {file delete -force -- tfad1 tfad2} sl@0: sl@0: file mkdir tfad1 sl@0: file copy tfad1 tfad2 sl@0: set result [expr [file isdir tfad1] && [file isdir tfad2]] sl@0: file delete tfad1 tfad2 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} { sl@0: catch {file delete -force -- tfad1 tfad2} sl@0: sl@0: file mkdir [file join tfad1 x y z] sl@0: file mkdir [file join tfad2 dir] sl@0: file copy tfad1 [file join tfad2 dir] sl@0: set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]] sl@0: file delete -force tfad1 tfad2 sl@0: set result sl@0: } {1} sl@0: sl@0: # sl@0: # Functionality tests for TclDeleteFilesCmd sl@0: # sl@0: sl@0: test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfad1 tfad2} sl@0: sl@0: file mkdir tfad1 sl@0: file link -symbolic tfalink tfad1 sl@0: file delete tfalink sl@0: sl@0: set r1 [file isdir tfad1] sl@0: set r2 [file exists tfalink] sl@0: sl@0: set result [expr $r1 && !$r2] sl@0: file delete tfad1 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfad1 tfad2} sl@0: sl@0: file mkdir tfad1 sl@0: file mkdir tfad2 sl@0: file link -symbolic [file join tfad2 link] tfad1 sl@0: file delete -force tfad2 sl@0: sl@0: set r1 [file isdir tfad1] sl@0: set r2 [file exists tfad2] sl@0: sl@0: set result [expr $r1 && !$r2] sl@0: file delete tfad1 sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unixOnly notRoot} { sl@0: catch {file delete -force -- tfad1 tfad2} sl@0: sl@0: file mkdir tfad1 sl@0: file link -symbolic tfad2 tfad1 sl@0: file delete tfad1 sl@0: file delete tfad2 sl@0: sl@0: set r1 [file exists tfad1] sl@0: set r2 [file exists tfad2] sl@0: sl@0: set result [expr !$r1 && !$r2] sl@0: set result sl@0: } {1} sl@0: sl@0: test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} { sl@0: set platform [testgetplatform] sl@0: testsetplatform unix sl@0: list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform] sl@0: } {1 {user "_totally_bogus_user" doesn't exist} {}} sl@0: test fCmd-27.3 {TclFileAttrsCmd - all attributes} { sl@0: catch {file delete -force -- foo.tmp} sl@0: createfile foo.tmp sl@0: list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp] sl@0: } {0 1 {}} sl@0: test fCmd-27.4 {TclFileAttrsCmd - getting one option} { sl@0: catch {file delete -force -- foo.tmp} sl@0: createfile foo.tmp sl@0: set attrs [file attributes foo.tmp] sl@0: list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp] sl@0: } {0 {}} sl@0: sl@0: # Find a group that exists on this Unix system, or else skip tests that sl@0: # require Unix groups. sl@0: if {$tcl_platform(platform) == "unix"} { sl@0: ::tcltest::testConstraint foundGroup 0 sl@0: catch { sl@0: set groupList [exec groups] sl@0: set group [lindex $groupList 0] sl@0: ::tcltest::testConstraint foundGroup 1 sl@0: } sl@0: } else { sl@0: ::tcltest::testConstraint foundGroup 1 sl@0: } sl@0: sl@0: test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} { sl@0: catch {file delete -force -- foo.tmp} sl@0: createfile foo.tmp sl@0: set attrs [file attributes foo.tmp] sl@0: list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp] sl@0: } {0 {} {}} sl@0: test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} { sl@0: catch {file delete -force -- foo.tmp} sl@0: createfile foo.tmp sl@0: set attrs [file attributes foo.tmp] sl@0: list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp] sl@0: } {0 {} {}} sl@0: sl@0: if {[string equal $tcl_platform(platform) "windows"]} { sl@0: if {[string index $tcl_platform(osVersion) 0] >= 5 \ sl@0: && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} { sl@0: tcltest::testConstraint linkDirectory 1 sl@0: tcltest::testConstraint linkFile 1 sl@0: } else { sl@0: tcltest::testConstraint linkDirectory 0 sl@0: tcltest::testConstraint linkFile 0 sl@0: } sl@0: } else { sl@0: tcltest::testConstraint linkFile 1 sl@0: tcltest::testConstraint linkDirectory 1 sl@0: sl@0: if {[string equal $tcl_platform(osSystemName) "Symbian"]} { sl@0: tcltest::testConstraint linkDirectory 0 sl@0: } sl@0: } sl@0: sl@0: test fCmd-28.1 {file link} { sl@0: list [catch {file link} msg] $msg sl@0: } {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}} sl@0: sl@0: test fCmd-28.2 {file link} { sl@0: list [catch {file link a b c d} msg] $msg sl@0: } {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}} sl@0: sl@0: test fCmd-28.3 {file link} { sl@0: list [catch {file link abc b c} msg] $msg sl@0: } {1 {bad switch "abc": must be -symbolic or -hard}} sl@0: sl@0: test fCmd-28.4 {file link} { sl@0: list [catch {file link -abc b c} msg] $msg sl@0: } {1 {bad switch "-abc": must be -symbolic or -hard}} sl@0: cd [workingDirectory] sl@0: sl@0: makeDirectory abc.dir sl@0: makeDirectory abc2.dir sl@0: makeFile contents abc.file sl@0: makeFile contents abc2.file sl@0: sl@0: cd [temporaryDirectory] sl@0: test fCmd-28.5 {file link: source already exists} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: set res [list [catch {file link abc.dir abc2.dir} msg] $msg] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {1 {could not create new link "abc.dir": that path already exists}} sl@0: sl@0: test fCmd-28.6 {file link: unsupported operation} {linkDirectory macOrWin} { sl@0: cd [temporaryDirectory] sl@0: set res [list [catch {file link -hard abc.link abc.dir} msg] $msg] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {1 {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}} sl@0: sl@0: test fCmd-28.7 {file link: source already exists} {linkFile} { sl@0: cd [temporaryDirectory] sl@0: set res [list [catch {file link abc.file abc2.file} msg] $msg] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {1 {could not create new link "abc.file": that path already exists}} sl@0: sl@0: test fCmd-28.8 {file link} {linkFile winOnly} { sl@0: cd [temporaryDirectory] sl@0: set res [list [catch {file link -symbolic abc.link abc.file} msg] $msg] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {1 {could not create new link "abc.link" pointing to "abc.file": not a directory}} sl@0: sl@0: test fCmd-28.9 {file link: success with file} {linkFile} { sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: set res [list [catch {file link abc.link abc.file} msg] $msg] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {0 abc.file} sl@0: sl@0: cd [temporaryDirectory] sl@0: catch {file delete -force abc.link} sl@0: cd [workingDirectory] sl@0: sl@0: test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: set res [list [catch {file link abc.link abc2.doesnt} msg] $msg] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}} sl@0: sl@0: test fCmd-28.11 {file link: success with directory} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: set res [list [catch {file link abc.link abc.dir} msg] $msg] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {0 abc.dir} sl@0: sl@0: test fCmd-28.12 {file link: cd into a link} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: file link abc.link abc.dir sl@0: set orig [pwd] sl@0: cd abc.link sl@0: set dir [pwd] sl@0: cd .. sl@0: set up [pwd] sl@0: cd $orig sl@0: # now '$up' should be either $orig or [file dirname abc.dir], sl@0: # depending on whether 'cd' actually moves to the destination sl@0: # of a link, or simply treats the link as a directory. sl@0: # (on windows the former, on unix the latter, I believe) sl@0: if {([file normalize $up] != [file normalize $orig]) \ sl@0: && ([file normalize $up] != [file normalize [file dirname abc.dir]])} { sl@0: set res "wrong directory with 'cd $link ; cd ..'" sl@0: } else { sl@0: set res "ok" sl@0: } sl@0: cd [workingDirectory] sl@0: set res sl@0: } {ok} sl@0: sl@0: test fCmd-28.13 {file link} {linkDirectory} { sl@0: # duplicate link throws error sl@0: cd [temporaryDirectory] sl@0: set res [list [catch {file link abc.link abc.dir} msg] $msg] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {1 {could not create new link "abc.link": that path already exists}} sl@0: sl@0: test fCmd-28.14 {file link: deletes link not dir} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: set res [list [file exists abc.link] [file exists abc.dir]] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {0 1} sl@0: sl@0: test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} { sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: file link abc.link abc.dir sl@0: file copy abc.link abc2.link sl@0: # abc2.linkdir was a copy of a link to a dir, so it should end up as sl@0: # a directory, not a link (links trace to endpoint). sl@0: set res [list [file type abc2.link] [file tail [file link abc.link]]] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {directory abc.dir} sl@0: test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: file link abc.link abc.dir sl@0: file copy abc.link abc2.link sl@0: set res [list [file type abc2.link] [file tail [file link abc2.link]]] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {link abc.dir} sl@0: sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: file delete -force abc2.link sl@0: sl@0: file copy abc.file abc.dir sl@0: file copy abc2.file abc.dir sl@0: cd [workingDirectory] sl@0: sl@0: test fCmd-28.16 {file link: glob inside link} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: file link abc.link abc.dir sl@0: set res [lsort [glob -dir abc.link -tails *]] sl@0: cd [workingDirectory] sl@0: set res sl@0: } [lsort [list abc.file abc2.file]] sl@0: sl@0: test fCmd-28.17 {file link: glob -type l} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: set res [glob -dir [pwd] -type l -tails abc*] sl@0: cd [workingDirectory] sl@0: set res sl@0: } {abc.link} sl@0: sl@0: test fCmd-28.18 {file link: glob -type d} {linkDirectory} { sl@0: cd [temporaryDirectory] sl@0: set res [lsort [glob -dir [pwd] -type d -tails abc*]] sl@0: cd [workingDirectory] sl@0: set res sl@0: } [lsort [list abc.link abc.dir abc2.dir]] sl@0: sl@0: test fCmd-29.1 {weird memory corruption fault} { sl@0: catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]} sl@0: } 1 sl@0: sl@0: cd [temporaryDirectory] sl@0: file delete -force abc.link sl@0: cd [workingDirectory] sl@0: sl@0: removeFile abc2.file sl@0: removeFile abc.file sl@0: removeDirectory abc2.dir sl@0: removeDirectory abc.dir sl@0: sl@0: # cleanup sl@0: cleanup sl@0: ::tcltest::cleanupTests sl@0: return