diff options
Diffstat (limited to 'tests/unixFCmd.test')
| -rw-r--r-- | tests/unixFCmd.test | 49 |
1 files changed, 25 insertions, 24 deletions
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 2cf71f1..20afe69 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixFCmd.test,v 1.23 2006/03/20 14:24:09 dgp Exp $ +# RCS: @(#) $Id: unixFCmd.test,v 1.24 2006/03/21 11:12:29 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -25,7 +25,7 @@ cd [temporaryDirectory] # Several tests require need to match results against the unix username set user {} -if {$tcl_platform(platform) == "unix"} { +if {[testConstraint unix]} { catch {set user [exec whoami]} if {$user == ""} { catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} @@ -35,6 +35,28 @@ if {$tcl_platform(platform) == "unix"} { } } +# Find a group that exists on this system, or else skip tests that require +# groups +testConstraint foundGroup 0 +if {[testConstraint unix]} { + catch { + set groupList [exec groups] + set group [lindex $groupList 0] + testConstraint foundGroup 1 + } +} + +# check whether -readonly attribute is supported +testConstraint readonlyAttr 0 +if {[testConstraint unix]} { + set f [makeFile "whatever" probe] + catch { + file attributes $f -readonly + testConstraint readonlyAttr 1 + } + removeFile probe +} + proc openup {path} { testchmod 777 $path if {[file isdirectory $path]} { @@ -125,6 +147,7 @@ test unixFCmd-1.9 {Checking EINTR Bug} {unix notRoot nonPortable} { catch {close $pipe} list $line [testgotsig] } {h 1} + test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \ {unix notRoot} { cleanup @@ -232,17 +255,6 @@ test unixFCmd-14.2 {GetPermissionsAttribute} {unix notRoot} { [file delete -force -- foo.test] } {0 {}} -# Find a group that exists on this system, or else skip tests that require -# groups -testConstraint foundGroup 0 -if {$tcl_platform(platform) == "unix"} { - catch { - set groupList [exec groups] - set group [lindex $groupList 0] - testConstraint foundGroup 1 - } -} - #groups hard to test test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unix notRoot} { catch {file delete -force -- foo.test} @@ -330,17 +342,6 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable unix notRoot} { set r } {1 {error getting working directory name:}} -# check whether -readonly attribute is supported -testConstraint readonlyAttr 0 -if {$tcl_platform(platform) == "unix"} { - set f [makeFile "whatever" probe] - catch { - file attributes $f -readonly - testConstraint readonlyAttr 1 - } - removeFile probe -} - test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} {unix notRoot readonlyAttr} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -readonly} msg] $msg |