diff options
Diffstat (limited to 'tests/fCmd.test')
| -rw-r--r-- | tests/fCmd.test | 135 |
1 files changed, 70 insertions, 65 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test index 6c73dee..00147bb 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -15,6 +15,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +cd [temporaryDirectory] + testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testchmod [llength [info commands testchmod]] testConstraint winVista 0 @@ -34,6 +36,15 @@ if {[testConstraint unix]} { set group [lindex $groupList 0] testConstraint foundGroup 1 } + + proc dev dir { + file stat $dir stat + return $stat(dev) + } + + if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} { + testConstraint xdev [expr {([dev .] != [dev $tmpspace])}] + } } # Also used in winFCmd... @@ -138,13 +149,6 @@ proc contents {file} { return $r } -cd [temporaryDirectory] - -proc dev dir { - file stat $dir stat - return $stat(dev) -} -testConstraint xdev [expr {[testConstraint unix] && ([dev .] != [dev /tmp])}] set root [lindex [file split [pwd]] 0] @@ -550,12 +554,12 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup { file rename -force td2 td1 } -returnCodes error -match glob -result \ [subst {error renaming "td2" to "[file join td1 td2]": file *}] -test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unix notRoot} { - file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest +test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {xdev notRoot} { + cleanup $tmpspace createfile tf1 - file rename tf1 /tmp/tcltmptest - glob -nocomplain tf* /tmp/tcltmptest/tf1 -} {/tmp/tcltmptest/tf1} + file rename tf1 $tmpspace + glob -nocomplain tf* [file join $tmpspace tf1] +} [file join $tmpspace tf1] test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { catch {file delete -force c:/tcl8975@ d:/tcl8975@} } -body { @@ -569,28 +573,29 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup { catch {file delete -force d:/tcl8975@} } -result {d:/tcl8975@} test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \ - {unix notRoot} { - file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest + {xdev notRoot} { + cleanup $tmpspace file mkdir td1 - file rename td1 /tmp/tcltmptest - glob -nocomplain td* /tmp/tcltmptest/td* -} {/tmp/tcltmptest/td1} + file rename td1 $tmpspace + glob -nocomplain td* [file join $tmpspace td*] +} [file join $tmpspace td1] test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \ - {unix notRoot} { - file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest + {xdev notRoot} { + cleanup $tmpspace createfile tf1 - file rename tf1 /tmp/tcltmptest - glob -nocomplain tf* /tmp/tcltmptest/tf* -} {/tmp/tcltmptest/tf1} + file rename tf1 $tmpspace + glob -nocomplain tf* [file join $tmpspace tf*] +} [file join $tmpspace tf1] test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { - file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest -} -constraints {unix notRoot xdev} -body { + cleanup $tmpspace +} -constraints {notRoot xdev} -body { file mkdir td1/td2/td3 file attributes td1 -permissions 0000 - file rename td1 /tmp/tcltmptest + file rename td1 $tmpspace } -returnCodes error -cleanup { file attributes td1 -permissions 0755 -} -match regexp -result {^error renaming "td1"( to "/tmp/tcltmptest/td1")?: permission denied$} + cleanup +} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$} test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup { cleanup } -constraints {unix notRoot} -body { @@ -626,55 +631,54 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup { file delete -force ~/td1 } -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied" test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { - file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest -} -constraints {unix notRoot xdev} -returnCodes error -body { + cleanup $tmpspace +} -constraints {notRoot xdev} -returnCodes error -body { file mkdir td1/td2/td3 - file mkdir /tmp/tcltmptest/td1 - createfile /tmp/tcltmptest/td1/tf1 - file rename -force td1 /tmp/tcltmptest -} -result {error renaming "td1" to "/tmp/tcltmptest/td1": file already exists} + file mkdir [file join $tmpspace td1] + createfile [file join $tmpspace td1 tf1] + file rename -force td1 $tmpspace +} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists} test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { - file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest -} -constraints {unix notRoot xdev} -body { + cleanup $tmpspace +} -constraints {notRoot xdev} -body { file mkdir td1/td2/td3 file attributes td1/td2/td3 -permissions 0000 - file rename td1 /tmp/tcltmptest + file rename td1 $tmpspace } -returnCodes error -cleanup { file attributes td1/td2/td3 -permissions 0755 -} -result {error renaming "td1" to "/tmp/tcltmptest/td1": "td1/td2/td3": permission denied} + cleanup $tmpspace +} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied} test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { - file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest -} -constraints {unix notRoot xdev} -body { + cleanup $tmpspace +} -constraints {notRoot xdev} -body { file mkdir td1/td2/td3 - file rename td1 /tmp/tcltmptest - glob td* /tmp/tcltmptest/td1/t* -} -result {/tmp/tcltmptest/td1/td2} + file rename td1 $tmpspace + glob td* [file join $tmpspace td1 t*] +} -result [file join $tmpspace td1 td2] test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup { - cleanup - file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest -} -constraints {unix notRoot} -body { + cleanup $tmpspace +} -constraints {xdev notRoot} -body { file mkdir foo/bar file attr foo -perm 040555 - file rename foo/bar /tmp/tcltmptest + file rename foo/bar $tmpspace } -returnCodes error -cleanup { - catch {file delete /tmp/tcltmptest/bar} + catch {file delete [file join $tmpspace bar]} catch {file attr foo -perm 040777} catch {file delete -force foo} } -match glob -result {*: permission denied} test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup { - catch {cleanup /tmp/tcltmptest} -} -constraints {unix notRoot xdev} -body { - file mkdir /tmp/tcltmptest/td1 - createfile /tmp/tcltmptest/td1/tf1 - file rename /tmp/tcltmptest/td1/tf1 tf1 - list [file exists /tmp/tcltmptest/td1/tf1] [file exists tf1] + cleanup $tmpspace +} -constraints {notRoot xdev} -body { + file mkdir [file join $tmpspace td1] + createfile [file join $tmpspace td1 tf1] + file rename [file join $tmpspace td1 tf1] tf1 + list [file exists [file join $tmpspace td1 tf1]] [file exists tf1] } -result {0 1} test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup { cleanup } -returnCodes error -body { file copy tf1 tf2 } -result {error copying "tf1": no such file or directory} -catch {file delete -force /tmp/tcltmptest} test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup { cleanup @@ -1306,25 +1310,23 @@ test fCmd-12.8 {renamefile: generic error} -setup { file delete -force tfa } -result {1} test fCmd-12.9 {renamefile: moving a file across volumes} -setup { - file mkdir /tmp/tcltmptest - catch {file delete -force -- tfa /tmp/tcltmptest/tfa} -} -constraints {unix notRoot} -body { + cleanup $tmpspace +} -constraints {xdev notRoot} -body { set s [createfile tfa] - file rename tfa /tmp/tcltmptest - list [checkcontent /tmp/tcltmptest/tfa $s] [file exists tfa] + file rename tfa $tmpspace + list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa] } -cleanup { - file delete -force /tmp/tcltmptest + cleanup $tmpspace } -result {1 0} test fCmd-12.10 {renamefile: moving a directory across volumes} -setup { - file mkdir /tmp/tcltmptest - catch {file delete -force -- tfad /tmp/tcltmptest/tfad} -} -constraints {unix notRoot} -body { + cleanup $tmpspace +} -constraints {xdev notRoot} -body { file mkdir tfad set s [createfile tfad/a] - file rename tfad /tmp/tcltmptest - list [checkcontent /tmp/tcltmptest/tfad/a $s] [file exists tfad] + file rename tfad $tmpspace + list [checkcontent [file join $tmpspace tfad a] $s] [file exists tfad] } -cleanup { - file delete -force /tmp/tcltmptest + cleanup $tmpspace } -result {1 0} # @@ -2554,5 +2556,8 @@ test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win 2000orNewer kno # cleanup cleanup +if {[testConstraint unix]} { + removeDirectory tcl[pid] /tmp +} ::tcltest::cleanupTests return |