442 lines
14 KiB
Plaintext
442 lines
14 KiB
Plaintext
|
# 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.
|
||
|
|
|
||
|
|
if {"::tcltest" ni [namespace children]} {
|
||
|
|
package require tcltest 2.5
|
||
|
|
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 {[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 0o777 $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 0o000
|
||
|
|
file rename td1/td2/td3 td2
|
||
|
|
} -returnCodes error -cleanup {
|
||
|
|
file attributes td1/td2 -permissions 0o755
|
||
|
|
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 0o40555
|
||
|
|
file rename foo/bar /tmp
|
||
|
|
} -returnCodes error -cleanup {
|
||
|
|
catch {file delete /tmp/bar}
|
||
|
|
catch {file attr foo -perm 0o40777}
|
||
|
|
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 0o472
|
||
|
|
file copy tf1 tf2
|
||
|
|
format 0o%03o [file attributes tf2 -permissions]
|
||
|
|
} -cleanup {
|
||
|
|
cleanup
|
||
|
|
} -result 0o472 ;# 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 0o000] \
|
||
|
|
[format 0o%03o [file attributes foo.test -permissions]]
|
||
|
|
} -cleanup {
|
||
|
|
file delete -force -- foo.test
|
||
|
|
} -result {{} 0o000}
|
||
|
|
test unixFCmd-17.2 {SetPermissionsAttribute} -setup {
|
||
|
|
catch {file delete -force -- foo.test}
|
||
|
|
} -constraints {unix notRoot} -returnCodes error -body {
|
||
|
|
file attributes foo.test -permissions 0o000
|
||
|
|
} -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 permList expected} {
|
||
|
|
test $testnum {SetPermissionsAttribute} {unix notRoot} {
|
||
|
|
set result {}
|
||
|
|
foreach permstr $permList {
|
||
|
|
file attributes foo.test -permissions $permstr
|
||
|
|
lappend result [format 0o%03o [file attributes foo.test -permissions]]
|
||
|
|
}
|
||
|
|
set result
|
||
|
|
} $expected
|
||
|
|
}
|
||
|
|
permcheck unixFCmd-17.5 rwxrwxrwx 0o777
|
||
|
|
permcheck unixFCmd-17.6 r--r---w- 0o442
|
||
|
|
permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {0o000 0o740 0o540 0o547}
|
||
|
|
permcheck unixFCmd-17.11 --x--x--x 0o111
|
||
|
|
permcheck unixFCmd-17.12 {0 a+rwx} {0o000 0o777}
|
||
|
|
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 0o000
|
||
|
|
pwd
|
||
|
|
} -returnCodes error -cleanup {
|
||
|
|
cd $cd
|
||
|
|
file attributes $nd -permissions 0o755
|
||
|
|
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:
|