Test improvements (tcltest2, clarify)

1 files changed, 439 insertions, 379 deletions

diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 20afe69..db57b9f 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -1,379 +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.24 2006/03/21 11:12:29 dkf Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    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
-	    }
-	}
-    }
-}
-
-test unixFCmd-1.1 {TclpRenameFile: EACCES} {unix notRoot} {
-    cleanup
-    file mkdir td1/td2/td3
-    file attributes td1/td2 -permissions 0000
-    set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
-    file attributes td1/td2 -permissions 0755
-    set msg
-} {1 {error renaming "td1/td2/td3": permission denied}}
-test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unix notRoot} {
-    cleanup
-    file mkdir td1/td2
-    file mkdir td2
-    list [catch {file rename td2 td1} msg] $msg
-} {1 {error renaming "td2" to "td1/td2": file already exists}}
-test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unix notRoot} {
-    cleanup
-    file mkdir td1
-    list [catch {file rename td1 td1} msg] $msg
-} {1 {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} {unix notRoot} {
-    cleanup
-    file mkdir td1
-    list [catch {file rename td2 td1} msg] $msg
-} {1 {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} {unix notRoot} {
-    cleanup
-    file mkdir foo/bar
-    file attr foo -perm 040555
-    set catchResult [catch {file rename foo/bar /tmp} msg]
-    set msg [lindex [split $msg :] end]
-    catch {file delete /tmp/bar}
-    catch {file attr foo -perm 040777}
-    catch {file delete -force foo}
-    list $catchResult $msg
-} {1 { 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} {unix notRoot nonPortable} {
-    cleanup
-    set f [open tfalarm w]
-    puts $f {
-	after 2000
-	puts "hello world"
-	exit 0
-    }
-    close $f
-    testalarm 
-    set pipe [open "|[info nameofexecutable] tfalarm" r+]
-    set line [read $pipe 1]
-    catch {close $pipe}
-    list $line [testgotsig]
-} {h 1}
-
-test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
-	{unix notRoot} {
-    cleanup
-    close [open tf1 a]
-    close [open tf2 a]
-    file copy -force tf1 tf2
-} {}
-test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} {unix notRoot dontCopyLinks} {
-    # copying links should end up with real files
-    cleanup
-    close [open tf1 a]
-    file link -symbolic tf2 tf1
-    file copy tf2 tf3
-    file type tf3
-} {file}
-test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} {unix notRoot} {
-    # copying links should end up with the links copied
-    cleanup
-    close [open tf1 a]
-    file link -symbolic tf2 tf1
-    file copy tf2 tf3
-    file type tf3
-} {link}
-test unixFCmd-2.3 {TclpCopyFile: src is block} {unix notRoot} {
-    cleanup
-    set null "/dev/null"
-    while {[file type $null] != "characterSpecial"} {
-	set null [file join [file dirname $null] [file readlink $null]]
-    }
-    # file copy $null tf1
-} {}
-test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unix notRoot} {
-    cleanup
-    if [catch {exec mknod tf1 p}] {
-	list 1
-    } else {
-	file copy tf1 tf2
-	expr {"[file type tf1]" == "[file type tf2]"}
-    }
-} {1}
-test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unix notRoot} {
-    cleanup
-    close [open tf1 a]
-    file attributes tf1 -permissions 0472
-    file copy tf1 tf2
-    file attributes tf2 -permissions
-} 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} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-12.2 {GetGroupAttribute - file found} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
-} {0 {}}
-
-test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-13.2 {GetOwnerAttribute} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    list [catch {file attributes foo.test -owner} msg] \
-	    [string compare $msg $user] [file delete -force -- foo.test]
-} {0 0 {}}
-
-test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -permissions} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-14.2 {GetPermissionsAttribute} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    list [catch {file attribute foo.test -permissions}] \
-	    [file delete -force -- foo.test]
-} {0 {}}
-
-#groups hard to test
-test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -group foozzz} msg] \
-	    $msg [file delete -force -- foo.test]
-} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
-test unixFCmd-15.2 {SetGroupAttribute - invalid file} \
-	{unix notRoot foundGroup} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -group $group} msg] $msg
-} {1 {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} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    list [catch {file attributes foo.test -owner $user} msg] \
-	    $msg [string compare [file attributes foo.test -owner] $user] \
-	    [file delete -force -- foo.test]
-} {0 {} 0 {}}
-test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -owner $user} msg] $msg
-} {1 {could not set owner for file "foo.test": no such file or directory}}
-test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -owner foozzz} msg] $msg
-} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
-
-
-test unixFCmd-17.1 {SetPermissionsAttribute} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    list [catch {file attributes foo.test -permissions 0000} msg] \
-	    $msg [file attributes foo.test -permissions] \
-	    [file delete -force -- foo.test]
-} {0 {} 00000 {}}
-test unixFCmd-17.2 {SetPermissionsAttribute} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -permissions 0000} msg] $msg
-} {1 {could not set permissions for file "foo.test": no such file or directory}}
-test unixFCmd-17.3 {SetPermissionsAttribute} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    list [catch {file attributes foo.test -permissions foo} msg] $msg \
-	    [file delete -force -- foo.test]
-} {1 {unknown permission string format "foo"} {}}
-test unixFCmd-17.4 {SetPermissionsAttribute} {unix notRoot} {
-    catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \
-	    [file delete -force -- foo.test]
-} {1 {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} {nonPortable unix notRoot} {
-    # This test is nonportable because SunOS generates a weird error
-    # message when the current directory isn't readable.
-    set cd [pwd]
-    set nd $cd/tstdir
-    file mkdir $nd
-    cd $nd
-    file attributes $nd -permissions 0000
-    set r [list [catch {pwd} res] [string range $res 0 36]];
-    cd $cd;
-    file attributes $nd -permissions 0755
-    file delete $nd
-    set r
-} {1 {error getting working directory name:}}
-
-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
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-19.2 {GetReadOnlyAttribute} {unix notRoot readonlyAttr} {
-    catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    list [catch {file attribute foo.test -readonly} msg] $msg \
-	    [file delete -force -- foo.test]
-} {0 0 {}}
-
-test unixFCmd-20.1 {SetReadOnlyAttribute} {unix notRoot readonlyAttr} {
-    catch {file delete -force -- foo.test}
-    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 \
-	    [file delete -force -- foo.test]
-} {0 {} 0 1 1 0 {} 0 0 {}}
-test unixFCmd-20.2 {SetReadOnlyAttribute} {unix notRoot readonlyAttr} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -readonly 1} msg] $msg
-} {1 {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.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: