diff options
| -rw-r--r-- | tests/unixFCmd.test | 878 |
1 files changed, 439 insertions, 439 deletions
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index db57b9f..43dcf1a 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -1,439 +1,439 @@ -# This file tests the tclUnixFCmd.c file.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixFCmd.test,v 1.25 2008/04/10 00:21:02 dkf Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
- namespace import -force ::tcltest::*
-}
-
-testConstraint testchmod [llength [info commands testchmod]]
-
-# These tests really need to be run from a writable directory, which
-# it is assumed [temporaryDirectory] is.
-set oldcwd [pwd]
-cd [temporaryDirectory]
-
-# Several tests require need to match results against the unix username
-set user {}
-if {[testConstraint unix]} {
- catch {set user [exec whoami]}
- if {$user == ""} {
- catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
- }
- if {$user == ""} {
- set user "root"
- }
-}
-
-# 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]} {
- catch {
- foreach p [glob -directory $path *] {
- openup $p
- }
- }
- }
-}
-
-proc cleanup {args} {
- foreach p ". $args" {
- set x ""
- catch {
- set x [glob -directory $p tf* td*]
- }
- foreach file $x {
- if {
- [catch {file delete -force -- $file}]
- && [testConstraint testchmod]
- } then {
- openup $file
- file delete -force -- $file
- }
- }
- }
-}
-
-if {[testConstraint unix] && [testConstraint notRoot]} {
- testConstraint execMknod [expr {![catch {exec mknod tf1 p}]}]
- cleanup
-}
-
-test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- file mkdir td1/td2/td3
- file attributes td1/td2 -permissions 0000
- file rename td1/td2/td3 td2
-} -returnCodes error -cleanup {
- file attributes td1/td2 -permissions 0755
- cleanup
-} -result {error renaming "td1/td2/td3": permission denied}
-test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- file mkdir td1/td2
- file mkdir td2
- file rename td2 td1
-} -returnCodes error -cleanup {
- cleanup
-} -result {error renaming "td2" to "td1/td2": file already exists}
-test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- file mkdir td1
- file rename td1 td1
-} -returnCodes error -cleanup {
- cleanup
-} -result {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}
-test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unix notRoot} {
- # can't make it happen
-} {}
-test unixFCmd-1.5 {TclpRenameFile: ENOENT} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- file mkdir td1
- file rename td2 td1
-} -returnCodes error -cleanup {
- cleanup
-} -result {error renaming "td2": no such file or directory}
-test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} {
- # can't make it happen
-} {}
-test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- file mkdir foo/bar
- file attr foo -perm 040555
- file rename foo/bar /tmp
-} -returnCodes error -cleanup {
- catch {file delete /tmp/bar}
- catch {file attr foo -perm 040777}
- catch {file delete -force foo}
-} -match glob -result {*: permission denied}
-test unixFCmd-1.8 {Checking EINTR Bug} {unix notRoot nonPortable} {
- testalarm
- after 2000
- list [testgotsig] [testgotsig]
-} {1 0}
-test unixFCmd-1.9 {Checking EINTR Bug} -constraints {unix notRoot nonPortable} -setup {
- cleanup
- set f [open tfalarm w]
- puts $f {
- after 2000
- puts "hello world"
- exit 0
- }
- close $f
-} -body {
- testalarm
- set pipe [open "|[info nameofexecutable] tfalarm" r+]
- set line [read $pipe 1]
- catch {close $pipe}
- list $line [testgotsig]
-} -cleanup {
- cleanup
-} -result {h 1}
-
-test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- close [open tf1 a]
- close [open tf2 a]
- file copy -force tf1 tf2
-} -cleanup {
- cleanup
-} -result {}
-test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} -setup {
- cleanup
-} -constraints {unix notRoot dontCopyLinks} -body {
- # copying links should end up with real files
- close [open tf1 a]
- file link -symbolic tf2 tf1
- file copy tf2 tf3
- file type tf3
-} -cleanup {
- cleanup
-} -result file
-test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- # copying links should end up with the links copied
- close [open tf1 a]
- file link -symbolic tf2 tf1
- file copy tf2 tf3
- file type tf3
-} -cleanup {
- cleanup
-} -result link
-test unixFCmd-2.3 {TclpCopyFile: src is block} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- set null "/dev/null"
- while {[file type $null] != "characterSpecial"} {
- set null [file join [file dirname $null] [file readlink $null]]
- }
- # file copy $null tf1
-} -result {}
-test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup {
- cleanup
-} -constraints {unix notRoot execMknod} -body {
- exec mknod tf1 p
- file copy tf1 tf2
- list [file type tf1] [file type tf2]
-} -cleanup {
- cleanup
-} -result {fifo fifo}
-test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
- cleanup
-} -constraints {unix notRoot} -body {
- close [open tf1 a]
- file attributes tf1 -permissions 0472
- file copy tf1 tf2
- file attributes tf2 -permissions
-} -cleanup {
- cleanup
-} -result 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
-
-test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unix notRoot} {
-} {}
-
-test unixFCmd-12.1 {GetGroupAttribute - file not found} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -returnCodes error -body {
- file attributes foo.test -group
-} -result {could not read "foo.test": no such file or directory}
-test unixFCmd-12.2 {GetGroupAttribute - file found} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
- close [open foo.test w]
- file attributes foo.test -group
-} -cleanup {
- file delete -force -- foo.test
-} -match glob -result *
-
-test unixFCmd-13.1 {GetOwnerAttribute - file not found} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -returnCodes error -body {
- list [catch {file attributes foo.test -group} msg] $msg
-} -result {could not read "foo.test": no such file or directory}
-test unixFCmd-13.2 {GetOwnerAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
- close [open foo.test w]
- file attributes foo.test -owner
-} -cleanup {
- file delete -force -- foo.test
-} -result $user
-
-test unixFCmd-14.1 {GetPermissionsAttribute - file not found} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -returnCodes error -body {
- file attributes foo.test -permissions
-} -result {could not read "foo.test": no such file or directory}
-test unixFCmd-14.2 {GetPermissionsAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
- close [open foo.test w]
- file attribute foo.test -permissions
-} -cleanup {
- file delete -force -- foo.test
-} -match glob -result *
-
-#groups hard to test
-test unixFCmd-15.1 {SetGroupAttribute - invalid group} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
- file attributes foo.test -group foozzz
-} -returnCodes error -cleanup {
- file delete -force -- foo.test
-} -result {could not set group for file "foo.test": group "foozzz" does not exist}
-test unixFCmd-15.2 {SetGroupAttribute - invalid file} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot foundGroup} -returnCodes error -body {
- file attributes foo.test -group $group
-} -result {could not set group for file "foo.test": no such file or directory}
-
-#changing owners hard to do
-test unixFCmd-16.1 {SetOwnerAttribute - current owner} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
- close [open foo.test w]
- list [file attributes foo.test -owner $user] \
- [file attributes foo.test -owner]
-} -cleanup {
- file delete -force -- foo.test
-} -result [list {} $user]
-test unixFCmd-16.2 {SetOwnerAttribute - invalid file} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -returnCodes error -body {
- file attributes foo.test -owner $user
-} -result {could not set owner for file "foo.test": no such file or directory}
-test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -returnCodes error -body {
- file attributes foo.test -owner foozzz
-} -result {could not set owner for file "foo.test": user "foozzz" does not exist}
-
-test unixFCmd-17.1 {SetPermissionsAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
- close [open foo.test w]
- list [file attributes foo.test -permissions 0000] \
- [file attributes foo.test -permissions]
-} -cleanup {
- file delete -force -- foo.test
-} -result {{} 00000}
-test unixFCmd-17.2 {SetPermissionsAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -returnCodes error -body {
- file attributes foo.test -permissions 0000
-} -result {could not set permissions for file "foo.test": no such file or directory}
-test unixFCmd-17.3 {SetPermissionsAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
- close [open foo.test w]
- file attributes foo.test -permissions foo
-} -cleanup {
- file delete -force -- foo.test
-} -returnCodes error -result {unknown permission string format "foo"}
-test unixFCmd-17.4 {SetPermissionsAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
- close [open foo.test w]
- file attributes foo.test -permissions ---rwx
-} -cleanup {
- file delete -force -- foo.test
-} -returnCodes error -result {unknown permission string format "---rwx"}
-
-close [open foo.test w]
-set ::i 4
-proc permcheck {testnum permstr expected} {
- test $testnum {SetPermissionsAttribute} {unix notRoot} {
- file attributes foo.test -permissions $permstr
- file attributes foo.test -permissions
- } $expected
-}
-permcheck unixFCmd-17.5 rwxrwxrwx 00777
-permcheck unixFCmd-17.6 r--r---w- 00442
-permcheck unixFCmd-17.7 0 00000
-permcheck unixFCmd-17.8 u+rwx,g+r 00740
-permcheck unixFCmd-17.9 u-w 00540
-permcheck unixFCmd-17.10 o+rwx 00547
-permcheck unixFCmd-17.11 --x--x--x 00111
-permcheck unixFCmd-17.12 a+rwx 00777
-file delete -force -- foo.test
-
-test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
- set cd [pwd]
-} -body {
- # This test is nonportable because SunOS generates a weird error
- # message when the current directory isn't readable.
- set nd $cd/tstdir
- file mkdir $nd
- cd $nd
- file attributes $nd -permissions 0000
- pwd
-} -returnCodes error -cleanup {
- cd $cd
- file attributes $nd -permissions 0755
- file delete $nd
-} -match glob -result {error getting working directory name:*}
-
-test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot readonlyAttr} -returnCodes error -body {
- file attributes foo.test -readonly
-} -result {could not read "foo.test": no such file or directory}
-test unixFCmd-19.2 {GetReadOnlyAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot readonlyAttr} -body {
- close [open foo.test w]
- file attribute foo.test -readonly
-} -cleanup {
- file delete -force -- foo.test
-} -result 0
-
-test unixFCmd-20.1 {SetReadOnlyAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot readonlyAttr} -body {
- close [open foo.test w]
- list [catch {file attributes foo.test -readonly 1} msg] $msg \
- [catch {file attribute foo.test -readonly} msg] $msg \
- [catch {file delete -force -- foo.test}] \
- [catch {file attributes foo.test -readonly 0} msg] $msg \
- [catch {file attribute foo.test -readonly} msg] $msg
-} -cleanup {
- file delete -force -- foo.test
-} -result {0 {} 0 1 1 0 {} 0 0}
-test unixFCmd-20.2 {SetReadOnlyAttribute} -setup {
- catch {file delete -force -- foo.test}
-} -constraints {unix notRoot readonlyAttr} -returnCodes error -body {
- file attributes foo.test -readonly 1
-} -result {could not read "foo.test": no such file or directory}
-
-# cleanup
-cleanup
-cd $oldcwd
-::tcltest::cleanupTests
-return
-
-# Local Variables:
-# mode: tcl
-# End:
+# This file tests the tclUnixFCmd.c file. +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1996 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: unixFCmd.test,v 1.26 2008/04/11 14:55:10 dgp Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* +} + +testConstraint testchmod [llength [info commands testchmod]] + +# These tests really need to be run from a writable directory, which +# it is assumed [temporaryDirectory] is. +set oldcwd [pwd] +cd [temporaryDirectory] + +# Several tests require need to match results against the unix username +set user {} +if {[testConstraint unix]} { + catch {set user [exec whoami]} + if {$user == ""} { + catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} + } + if {$user == ""} { + set user "root" + } +} + +# 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]} { + catch { + foreach p [glob -directory $path *] { + openup $p + } + } + } +} + +proc cleanup {args} { + foreach p ". $args" { + set x "" + catch { + set x [glob -directory $p tf* td*] + } + foreach file $x { + if { + [catch {file delete -force -- $file}] + && [testConstraint testchmod] + } then { + openup $file + file delete -force -- $file + } + } + } +} + +if {[testConstraint unix] && [testConstraint notRoot]} { + testConstraint execMknod [expr {![catch {exec mknod tf1 p}]}] + cleanup +} + +test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup { + cleanup +} -constraints {unix notRoot} -body { + file mkdir td1/td2/td3 + file attributes td1/td2 -permissions 0000 + file rename td1/td2/td3 td2 +} -returnCodes error -cleanup { + file attributes td1/td2 -permissions 0755 + cleanup +} -result {error renaming "td1/td2/td3": permission denied} +test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup { + cleanup +} -constraints {unix notRoot} -body { + file mkdir td1/td2 + file mkdir td2 + file rename td2 td1 +} -returnCodes error -cleanup { + cleanup +} -result {error renaming "td2" to "td1/td2": file already exists} +test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup { + cleanup +} -constraints {unix notRoot} -body { + file mkdir td1 + file rename td1 td1 +} -returnCodes error -cleanup { + cleanup +} -result {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself} +test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unix notRoot} { + # can't make it happen +} {} +test unixFCmd-1.5 {TclpRenameFile: ENOENT} -setup { + cleanup +} -constraints {unix notRoot} -body { + file mkdir td1 + file rename td2 td1 +} -returnCodes error -cleanup { + cleanup +} -result {error renaming "td2": no such file or directory} +test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} { + # can't make it happen +} {} +test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup { + cleanup +} -constraints {unix notRoot} -body { + file mkdir foo/bar + file attr foo -perm 040555 + file rename foo/bar /tmp +} -returnCodes error -cleanup { + catch {file delete /tmp/bar} + catch {file attr foo -perm 040777} + catch {file delete -force foo} +} -match glob -result {*: permission denied} +test unixFCmd-1.8 {Checking EINTR Bug} {unix notRoot nonPortable} { + testalarm + after 2000 + list [testgotsig] [testgotsig] +} {1 0} +test unixFCmd-1.9 {Checking EINTR Bug} -constraints {unix notRoot nonPortable} -setup { + cleanup + set f [open tfalarm w] + puts $f { + after 2000 + puts "hello world" + exit 0 + } + close $f +} -body { + testalarm + set pipe [open "|[info nameofexecutable] tfalarm" r+] + set line [read $pipe 1] + catch {close $pipe} + list $line [testgotsig] +} -cleanup { + cleanup +} -result {h 1} + +test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} -setup { + cleanup +} -constraints {unix notRoot} -body { + close [open tf1 a] + close [open tf2 a] + file copy -force tf1 tf2 +} -cleanup { + cleanup +} -result {} +test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} -setup { + cleanup +} -constraints {unix notRoot dontCopyLinks} -body { + # copying links should end up with real files + close [open tf1 a] + file link -symbolic tf2 tf1 + file copy tf2 tf3 + file type tf3 +} -cleanup { + cleanup +} -result file +test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} -setup { + cleanup +} -constraints {unix notRoot} -body { + # copying links should end up with the links copied + close [open tf1 a] + file link -symbolic tf2 tf1 + file copy tf2 tf3 + file type tf3 +} -cleanup { + cleanup +} -result link +test unixFCmd-2.3 {TclpCopyFile: src is block} -setup { + cleanup +} -constraints {unix notRoot} -body { + set null "/dev/null" + while {[file type $null] != "characterSpecial"} { + set null [file join [file dirname $null] [file readlink $null]] + } + # file copy $null tf1 +} -result {} +test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup { + cleanup +} -constraints {unix notRoot execMknod} -body { + exec mknod tf1 p + file copy tf1 tf2 + list [file type tf1] [file type tf2] +} -cleanup { + cleanup +} -result {fifo fifo} +test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup { + cleanup +} -constraints {unix notRoot} -body { + close [open tf1 a] + file attributes tf1 -permissions 0472 + file copy tf1 tf2 + file attributes tf2 -permissions +} -cleanup { + cleanup +} -result 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w- + +test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unix notRoot} { +} {} + +test unixFCmd-12.1 {GetGroupAttribute - file not found} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -returnCodes error -body { + file attributes foo.test -group +} -result {could not read "foo.test": no such file or directory} +test unixFCmd-12.2 {GetGroupAttribute - file found} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { + close [open foo.test w] + file attributes foo.test -group +} -cleanup { + file delete -force -- foo.test +} -match glob -result * + +test unixFCmd-13.1 {GetOwnerAttribute - file not found} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -returnCodes error -body { + file attributes foo.test -group +} -result {could not read "foo.test": no such file or directory} +test unixFCmd-13.2 {GetOwnerAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { + close [open foo.test w] + file attributes foo.test -owner +} -cleanup { + file delete -force -- foo.test +} -result $user + +test unixFCmd-14.1 {GetPermissionsAttribute - file not found} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -returnCodes error -body { + file attributes foo.test -permissions +} -result {could not read "foo.test": no such file or directory} +test unixFCmd-14.2 {GetPermissionsAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { + close [open foo.test w] + file attribute foo.test -permissions +} -cleanup { + file delete -force -- foo.test +} -match glob -result * + +#groups hard to test +test unixFCmd-15.1 {SetGroupAttribute - invalid group} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { + file attributes foo.test -group foozzz +} -returnCodes error -cleanup { + file delete -force -- foo.test +} -result {could not set group for file "foo.test": group "foozzz" does not exist} +test unixFCmd-15.2 {SetGroupAttribute - invalid file} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot foundGroup} -returnCodes error -body { + file attributes foo.test -group $group +} -result {could not set group for file "foo.test": no such file or directory} + +#changing owners hard to do +test unixFCmd-16.1 {SetOwnerAttribute - current owner} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { + close [open foo.test w] + list [file attributes foo.test -owner $user] \ + [file attributes foo.test -owner] +} -cleanup { + file delete -force -- foo.test +} -result [list {} $user] +test unixFCmd-16.2 {SetOwnerAttribute - invalid file} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -returnCodes error -body { + file attributes foo.test -owner $user +} -result {could not set owner for file "foo.test": no such file or directory} +test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -returnCodes error -body { + file attributes foo.test -owner foozzz +} -result {could not set owner for file "foo.test": user "foozzz" does not exist} + +test unixFCmd-17.1 {SetPermissionsAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { + close [open foo.test w] + list [file attributes foo.test -permissions 0000] \ + [file attributes foo.test -permissions] +} -cleanup { + file delete -force -- foo.test +} -result {{} 00000} +test unixFCmd-17.2 {SetPermissionsAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -returnCodes error -body { + file attributes foo.test -permissions 0000 +} -result {could not set permissions for file "foo.test": no such file or directory} +test unixFCmd-17.3 {SetPermissionsAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { + close [open foo.test w] + file attributes foo.test -permissions foo +} -cleanup { + file delete -force -- foo.test +} -returnCodes error -result {unknown permission string format "foo"} +test unixFCmd-17.4 {SetPermissionsAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { + close [open foo.test w] + file attributes foo.test -permissions ---rwx +} -cleanup { + file delete -force -- foo.test +} -returnCodes error -result {unknown permission string format "---rwx"} + +close [open foo.test w] +set ::i 4 +proc permcheck {testnum permstr expected} { + test $testnum {SetPermissionsAttribute} {unix notRoot} { + file attributes foo.test -permissions $permstr + file attributes foo.test -permissions + } $expected +} +permcheck unixFCmd-17.5 rwxrwxrwx 00777 +permcheck unixFCmd-17.6 r--r---w- 00442 +permcheck unixFCmd-17.7 0 00000 +permcheck unixFCmd-17.8 u+rwx,g+r 00740 +permcheck unixFCmd-17.9 u-w 00540 +permcheck unixFCmd-17.10 o+rwx 00547 +permcheck unixFCmd-17.11 --x--x--x 00111 +permcheck unixFCmd-17.12 a+rwx 00777 +file delete -force -- foo.test + +test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup { + set cd [pwd] +} -body { + # This test is nonportable because SunOS generates a weird error + # message when the current directory isn't readable. + set nd $cd/tstdir + file mkdir $nd + cd $nd + file attributes $nd -permissions 0000 + pwd +} -returnCodes error -cleanup { + cd $cd + file attributes $nd -permissions 0755 + file delete $nd +} -match glob -result {error getting working directory name:*} + +test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot readonlyAttr} -returnCodes error -body { + file attributes foo.test -readonly +} -result {could not read "foo.test": no such file or directory} +test unixFCmd-19.2 {GetReadOnlyAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot readonlyAttr} -body { + close [open foo.test w] + file attribute foo.test -readonly +} -cleanup { + file delete -force -- foo.test +} -result 0 + +test unixFCmd-20.1 {SetReadOnlyAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot readonlyAttr} -body { + close [open foo.test w] + list [catch {file attributes foo.test -readonly 1} msg] $msg \ + [catch {file attribute foo.test -readonly} msg] $msg \ + [catch {file delete -force -- foo.test}] \ + [catch {file attributes foo.test -readonly 0} msg] $msg \ + [catch {file attribute foo.test -readonly} msg] $msg +} -cleanup { + file delete -force -- foo.test +} -result {0 {} 0 1 1 0 {} 0 0} +test unixFCmd-20.2 {SetReadOnlyAttribute} -setup { + catch {file delete -force -- foo.test} +} -constraints {unix notRoot readonlyAttr} -returnCodes error -body { + file attributes foo.test -readonly 1 +} -result {could not read "foo.test": no such file or directory} + +# cleanup +cleanup +cd $oldcwd +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: |