diff options
Diffstat (limited to 'tests/unixFCmd.test')
| -rw-r--r-- | tests/unixFCmd.test | 168 |
1 files changed, 99 insertions, 69 deletions
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 76febd0..d026aa3 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -9,18 +9,22 @@ # 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.5 1998/09/14 18:40:14 stanton Exp $ +# RCS: @(#) $Id: unixFCmd.test,v 1.6 1999/04/16 00:47:35 stanton Exp $ -if {[string compare test [info procs test]] == 1} then {source defs} - -if {$tcl_platform(platform) != "unix"} { - return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {$user == "root"} { - puts "Skipping unixFCmd tests. They depend on not being able to write to" - puts "certain directories. It would be too dangerous to run them as root." - return +# Several tests require need to match results against the unix username +set user {} +if {$tcl_platform(platform) == "unix"} { + catch {set user [exec whoami]} + if {$user == ""} { + catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} + } + if {$user == ""} { + set user "root" + } } proc openup {path} { @@ -49,7 +53,7 @@ proc cleanup {args} { } } -test unixFCmd-1.1 {TclpRenameFile: EACCES} { +test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} { cleanup file mkdir td1/td2/td3 exec chmod 000 td1/td2 @@ -57,46 +61,45 @@ test unixFCmd-1.1 {TclpRenameFile: EACCES} { exec chmod 755 td1/td2 set msg } {1 {error renaming "td1/td2/td3": permission denied}} -test unixFCmd-1.2 {TclpRenameFile: EEXIST} { +test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly 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} { +test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly 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} { +test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unixOnly notRoot} { # can't make it happen } {} -test unixFCmd-1.5 {TclpRenameFile: ENOENT} { +test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unixOnly 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} { +test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unixOnly notRoot} { # can't make it happen } {} -test unixFCmd-1.7 {TclpRenameFile: EXDEV} { +test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly notRoot} { cleanup file mkdir foo/bar file attr foo -perm 040555 - set msg [list [catch {file rename foo/bar /tmp} msg] $msg] - set a1 {1 {can't unlink "foo/bar": permission denied}} - set result [expr {$msg == $a1}] + 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} - set result -} {1} -test unixFCmd-1.8 {Checking EINTR Bug} nonPortable { + list $catchResult $msg +} {1 { permission denied}} +test unixFCmd-1.8 {Checking EINTR Bug} {unixOnly notRoot nonPortable} { testalarm after 2000 list [testgotsig] [testgotsig] } {1 0} -test unixFCmd-1.9 {Checking EINTR Bug} nonPortable { +test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} { cleanup set f [open tfalarm w] puts $f { @@ -111,19 +114,20 @@ test unixFCmd-1.9 {Checking EINTR Bug} nonPortable { catch {close $pipe} list $line [testgotsig] } {h 1} -test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} { +test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \ + {unixOnly notRoot} { cleanup exec touch tf1 exec touch tf2 file copy -force tf1 tf2 } {} -test unixFCmd-2.2 {TclpCopyFile: src is symlink} { +test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} { cleanup exec ln -s tf1 tf2 file copy tf2 tf3 file type tf3 } {link} -test unixFCmd-2.3 {TclpCopyFile: src is block} { +test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} { cleanup set null "/dev/null" while {[file type $null] != "characterSpecial"} { @@ -131,7 +135,7 @@ test unixFCmd-2.3 {TclpCopyFile: src is block} { } # file copy $null tf1 } {} -test unixFCmd-2.4 {TclpCopyFile: src is fifo} { +test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} { cleanup if [catch {exec mknod tf1 p}] { list 1 @@ -140,7 +144,7 @@ test unixFCmd-2.4 {TclpCopyFile: src is fifo} { expr {"[file type tf1]" == "[file type tf2]"} } } {1} -test unixFCmd-2.5 {TclpCopyFile: copy attributes} { +test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} { cleanup exec touch tf1 exec chmod 472 tf1 @@ -148,111 +152,122 @@ test unixFCmd-2.5 {TclpCopyFile: copy attributes} { string range [exec ls -l tf2] 0 9 } {-r--rwx-w-} -test unixFCmd-3.1 {CopyFile not done} { +test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} { } {} -test unixFCmd-4.1 {TclpDeleteFile not done} { +test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} { } {} -test unixFCmd-5.1 {TclpCreateDirectory not done} { +test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} { } {} -test unixFCmd-6.1 {TclpCopyDirectory not done} { +test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} { } {} -test unixFCmd-7.1 {TclpRemoveDirectory not done} { +test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} { } {} -test unixFCmd-8.1 {TraverseUnixTree not done} { +test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} { } {} -test unixFCmd-9.1 {TraversalCopy not done} { +test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} { } {} -test unixFCmd-10.1 {TraversalDelete not done} { +test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} { } {} -test unixFCmd-11.1 {CopyFileAttrs not done} { +test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} { } {} -set testConfig(tclGroup) 0 -if {[catch {exec {groups}} groupList] == 0} { - if {[lsearch $groupList tcl] != -1} { - set testConfig(tclGroup) 1 - } -} - -test unixFCmd-12.1 {GetGroupAttribute - file not found} { +test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -group} msg] $msg -} {1 {could not stat file "foo.test": no such file or directory}} -test unixFCmd-12.2 {GetGroupAttribute - file found} { +} {1 {could not read "foo.test": no such file or directory}} +test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly 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} { +test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -group} msg] $msg -} {1 {could not stat file "foo.test": no such file or directory}} -test unixFCmd-13.2 {GetOwnerAttribute} { +} {1 {could not read "foo.test": no such file or directory}} +test unixFCmd-13.2 {GetOwnerAttribute} {unixOnly 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] + 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} { +test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} { catch {file delete -force -- foo.test} list [catch {file attributes foo.test -permissions} msg] $msg -} {1 {could not stat file "foo.test": no such file or directory}} -test unixFCmd-14.2 {GetPermissionsAttribute} { +} {1 {could not read "foo.test": no such file or directory}} +test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} { catch {file delete -force -- foo.test} close [open foo.test w] - list [catch {file attribute foo.test -permissions}] [file delete -force -- foo.test] + list [catch {file attribute foo.test -permissions}] \ + [file delete -force -- foo.test] } {0 {}} +# Find a group that exists on this system, or else skip tests that require +# groups +set ::tcltest::testConfig(foundGroup) 0 +catch { + set groupList [exec groups] + set group [lindex $groupList 0] + set ::tcltest::testConfig(foundGroup) 1 +} + #groups hard to test -test unixFCmd-15.1 {SetGroupAttribute - invalid group} { +test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} { catch {file delete -force -- foo.test} - list [catch {file attributes foo.test -group foozzz} msg] $msg [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} {tclGroup} { +test unixFCmd-15.2 {SetGroupAttribute - invalid file} \ + {unixOnly notRoot foundGroup} { catch {file delete -force -- foo.test} - list [catch {file attributes foo.test -group tcl} msg] $msg + 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} { +test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unixOnly 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] + 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} { +test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unixOnly 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} { +test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unixOnly 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} { +test unixFCmd-17.1 {SetPermissionsAttribute} {unixOnly 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] + 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} { +test unixFCmd-17.2 {SetPermissionsAttribute} {unixOnly 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} { +test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly 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] + list [catch {file attributes foo.test -permissions foo} msg] $msg \ + [file delete -force -- foo.test] } {1 {expected integer but got "foo"} {}} -test unixFCmd-18.1 {Unix pwd} {nonPortable} { +test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} { # This test is nonportable because SunOS generates a weird error # message when the current directory isn't readable. set cd [pwd] @@ -267,4 +282,19 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable} { set r } {1 {error getting working directory name:}} +# cleanup cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + |