diff options
Diffstat (limited to 'tests/unixFCmd.test')
| -rw-r--r-- | tests/unixFCmd.test | 300 |
1 files changed, 0 insertions, 300 deletions
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test deleted file mode 100644 index d026aa3..0000000 --- a/tests/unixFCmd.test +++ /dev/null @@ -1,300 +0,0 @@ -# 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.6 1999/04/16 00:47:35 stanton Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} - -# 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} { - testchmod 777 $path - if {[file isdirectory $path]} { - catch { - foreach p [glob [file join $path *]] { - openup $p - } - } - } -} - -proc cleanup {args} { - foreach p ". $args" { - set x "" - catch { - set x [glob [file join $p tf*] [file join $p td*]] - } - foreach file $x { - if {[catch {file delete -force -- $file}]} { - openup $file - file delete -force -- $file - } - } - } -} - -test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} { - cleanup - 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} { - 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} {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} {emptyTest unixOnly notRoot} { - # can't make it happen -} {} -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} {emptyTest unixOnly notRoot} { - # can't make it happen -} {} -test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly 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} {unixOnly notRoot nonPortable} { - testalarm - after 2000 - list [testgotsig] [testgotsig] -} {1 0} -test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly 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} \ - {unixOnly notRoot} { - cleanup - exec touch tf1 - exec touch tf2 - file copy -force tf1 tf2 -} {} -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} {unixOnly 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} {unixOnly 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} {unixOnly notRoot} { - cleanup - exec touch tf1 - exec chmod 472 tf1 - file copy tf1 tf2 - string range [exec ls -l tf2] 0 9 -} {-r--rwx-w-} - -test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} { -} {} - -test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} { -} {} - -test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} { -} {} - -test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} { -} {} - -test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} { -} {} - -test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} { -} {} - -test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} { -} {} - -test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} { -} {} - -test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} { -} {} - -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 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} {unixOnly 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} {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] -} {0 0 {}} - -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 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] -} {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} {unixOnly 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} \ - {unixOnly 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} {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] -} {0 {} 0 {}} -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} {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} {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] -} {0 {} 00000 {}} -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} {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] -} {1 {expected integer but got "foo"} {}} -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] - 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 delete $nd - set r -} {1 {error getting working directory name:}} - -# cleanup -cleanup -::tcltest::cleanupTests -return - - - - - - - - - - - - |