diff options
Diffstat (limited to 'tests/unixFCmd.test')
| -rw-r--r-- | tests/unixFCmd.test | 434 |
1 files changed, 287 insertions, 147 deletions
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index b06977c..e4613ed 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -8,17 +8,25 @@ # # 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.9 1999/07/01 17:36:20 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import ::tcltest::* + package require tcltest 2 + namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + +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 {$tcl_platform(platform) == "unix"} { +if {[testConstraint unix]} { catch {set user [exec whoami]} if {$user == ""} { catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} @@ -28,11 +36,33 @@ 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]} { catch { - foreach p [glob [file join $path *]] { + foreach p [glob -directory $path *] { openup $p } } @@ -43,10 +73,13 @@ proc cleanup {args} { foreach p ". $args" { set x "" catch { - set x [glob [file join $p tf*] [file join $p td*]] + set x [glob -directory $p tf* td*] } foreach file $x { - if {[catch {file delete -force -- $file}]} { + if { + [catch {file delete -force -- $file}] + && [testConstraint testchmod] + } then { openup $file file delete -force -- $file } @@ -54,53 +87,69 @@ proc cleanup {args} { } } -test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} { +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 - exec chmod 000 td1/td2 - set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg] - exec chmod 755 td1/td2 - set msg -} {1 {error renaming "td1/td2/td3": permission denied}} -test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} { + 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 - list [catch {file rename td2 td1} msg] $msg -} {1 {error renaming "td2" to "td1/td2": file already exists}} -test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly notRoot} { + 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 - 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 unixOnly notRoot} { + 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} {unixOnly notRoot} { +test unixFCmd-1.5 {TclpRenameFile: ENOENT} -setup { cleanup +} -constraints {unix notRoot} -body { 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 unixOnly notRoot} { + 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} {unixOnly notRoot} { +test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup { cleanup +} -constraints {unix notRoot} -body { file mkdir foo/bar file attr foo -perm 040555 - set catchResult [catch {file rename foo/bar /tmp} msg] - set msg [lindex [split $msg :] end] + file rename foo/bar /tmp +} -returnCodes error -cleanup { 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} {unixOnly notRoot nonPortable} { - testalarm +} -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} {unixOnly notRoot nonPortable} { +test unixFCmd-1.9 {Checking EINTR Bug} -constraints {unix notRoot nonPortable} -setup { cleanup set f [open tfalarm w] puts $f { @@ -109,193 +158,284 @@ test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} { exit 0 } close $f - testalarm +} -body { + 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} \ - {unixOnly notRoot} { +} -cleanup { + cleanup +} -result {h 1} + +test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} -setup { cleanup - exec touch tf1 - exec touch tf2 +} -constraints {unix notRoot} -body { + close [open tf1 a] + close [open tf2 a] file copy -force tf1 tf2 -} {} -test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} { +} -cleanup { cleanup - exec ln -s tf1 tf2 +} -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 -} {link} -test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} { +} -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 -} {} -test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} { +} -result {} +test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup { 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} {unixOnly notRoot} { +} -constraints {unix notRoot execMknod} -body { + exec mknod tf1 p + file copy tf1 tf2 + list [file type tf1] [file type tf2] +} -cleanup { cleanup - exec touch tf1 - exec chmod 472 tf1 +} -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 - string range [exec ls -l tf2] 0 9 -} {-r--rwx-w-} + 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 unixOnly notRoot} { +test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} { } {} -test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} { +test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unix notRoot} { } {} -test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} { +test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unix notRoot} { } {} -test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} { +test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unix notRoot} { } {} -test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} { +test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unix notRoot} { } {} -test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} { +test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unix notRoot} { } {} -test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} { +test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unix notRoot} { } {} -test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} { +test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unix notRoot} { } {} -test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} { +test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unix notRoot} { } {} -test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} { +test unixFCmd-12.1 {GetGroupAttribute - file not found} -setup { 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} {unixOnly notRoot} { +} -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] - list [catch {file attributes foo.test -group}] [file delete -force -- foo.test] -} {0 {}} + file attributes foo.test -group +} -cleanup { + file delete -force -- foo.test +} -match glob -result * -test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} { +test unixFCmd-13.1 {GetOwnerAttribute - file not found} -setup { 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} {unixOnly notRoot} { +} -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] - list [catch {file attributes foo.test -owner} msg] \ - [string compare $msg $user] [file delete -force -- foo.test] -} {0 0 {}} + file attributes foo.test -owner +} -cleanup { + file delete -force -- foo.test +} -result $user -test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} { +test unixFCmd-14.1 {GetPermissionsAttribute - file not found} -setup { 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} {unixOnly notRoot} { +} -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] - 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::testConstraints(foundGroup) 0 -catch { - set groupList [exec groups] - set group [lindex $groupList 0] - set ::tcltest::testConstraints(foundGroup) 1 -} + 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} {unixOnly notRoot} { +test unixFCmd-15.1 {SetGroupAttribute - invalid group} -setup { 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} \ - {unixOnly notRoot foundGroup} { +} -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} - list [catch {file attributes foo.test -group $group} msg] $msg -} {1 {could not set group for file "foo.test": no such file or directory}} +} -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} {unixOnly notRoot} { +test unixFCmd-16.1 {SetOwnerAttribute - current owner} -setup { catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { 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} {unixOnly notRoot} { + 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} - 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} {unixOnly notRoot} { +} -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} - list [catch {file attributes foo.test -owner foozzz} msg] $msg -} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}} +} -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} {unixOnly notRoot} { +test unixFCmd-17.1 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} +} -constraints {unix notRoot} -body { 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} {unixOnly notRoot} { + 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} - 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} {unixOnly notRoot} { +} -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] - 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 unixOnly notRoot} { + 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 permList expected} { + test $testnum {SetPermissionsAttribute} {unix notRoot} { + set result {} + foreach permstr $permList { + file attributes foo.test -permissions $permstr + lappend result [file attributes foo.test -permissions] + } + set result + } $expected +} +permcheck unixFCmd-17.5 rwxrwxrwx 00777 +permcheck unixFCmd-17.6 r--r---w- 00442 +permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 00740 00540 00547} +permcheck unixFCmd-17.11 --x--x--x 00111 +permcheck unixFCmd-17.12 {0 a+rwx} {00000 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 cd [pwd] set nd $cd/tstdir file mkdir $nd cd $nd - exec chmod 000 $nd - set r [list [catch {pwd} res] [string range $res 0 36]]; - cd $cd; - exec chmod 755 $nd + file attributes $nd -permissions 0000 + pwd +} -returnCodes error -cleanup { + cd $cd + file attributes $nd -permissions 0755 file delete $nd - set r -} {1 {error getting working directory name:}} +} -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: |