os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/unixFCmd.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/unixFCmd.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,332 @@
1.4 +# This file tests the tclUnixFCmd.c file.
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1996 Sun Microsystems, Inc.
1.11 +#
1.12 +# See the file "license.terms" for information on usage and redistribution
1.13 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.14 +#
1.15 +# RCS: @(#) $Id: unixFCmd.test,v 1.17.2.1 2003/04/14 15:45:57 vincentdarley Exp $
1.16 +
1.17 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.18 + package require tcltest
1.19 + namespace import -force ::tcltest::*
1.20 +}
1.21 +
1.22 +# These tests really need to be run from a writable directory, which
1.23 +# it is assumed [temporaryDirectory] is.
1.24 +set oldcwd [pwd]
1.25 +cd [temporaryDirectory]
1.26 +
1.27 +# Several tests require need to match results against the unix username
1.28 +set user {}
1.29 +if {$tcl_platform(platform) == "unix"} {
1.30 + catch {set user [exec whoami]}
1.31 + if {$user == ""} {
1.32 + catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
1.33 + }
1.34 + if {$user == ""} {
1.35 + set user "root"
1.36 + }
1.37 +}
1.38 +
1.39 +proc openup {path} {
1.40 + testchmod 777 $path
1.41 + if {[file isdirectory $path]} {
1.42 + catch {
1.43 + foreach p [glob -directory $path *] {
1.44 + openup $p
1.45 + }
1.46 + }
1.47 + }
1.48 +}
1.49 +
1.50 +proc cleanup {args} {
1.51 + foreach p ". $args" {
1.52 + set x ""
1.53 + catch {
1.54 + set x [glob -directory $p tf* td*]
1.55 + }
1.56 + foreach file $x {
1.57 + if {[catch {file delete -force -- $file}]} {
1.58 + openup $file
1.59 + file delete -force -- $file
1.60 + }
1.61 + }
1.62 + }
1.63 +}
1.64 +
1.65 +test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} {
1.66 + cleanup
1.67 + file mkdir td1/td2/td3
1.68 + file attributes td1/td2 -permissions 0000
1.69 + set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
1.70 + file attributes td1/td2 -permissions 0755
1.71 + set msg
1.72 +} {1 {error renaming "td1/td2/td3": permission denied}}
1.73 +test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} {
1.74 + cleanup
1.75 + file mkdir td1/td2
1.76 + file mkdir td2
1.77 + list [catch {file rename td2 td1} msg] $msg
1.78 +} {1 {error renaming "td2" to "td1/td2": file already exists}}
1.79 +test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly notRoot} {
1.80 + cleanup
1.81 + file mkdir td1
1.82 + list [catch {file rename td1 td1} msg] $msg
1.83 +} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
1.84 +test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unixOnly notRoot} {
1.85 + # can't make it happen
1.86 +} {}
1.87 +test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unixOnly notRoot} {
1.88 + cleanup
1.89 + file mkdir td1
1.90 + list [catch {file rename td2 td1} msg] $msg
1.91 +} {1 {error renaming "td2": no such file or directory}}
1.92 +test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unixOnly notRoot} {
1.93 + # can't make it happen
1.94 +} {}
1.95 +test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly notRoot} {
1.96 + cleanup
1.97 + file mkdir foo/bar
1.98 + file attr foo -perm 040555
1.99 + set catchResult [catch {file rename foo/bar /tmp} msg]
1.100 + set msg [lindex [split $msg :] end]
1.101 + catch {file delete /tmp/bar}
1.102 + catch {file attr foo -perm 040777}
1.103 + catch {file delete -force foo}
1.104 + list $catchResult $msg
1.105 +} {1 { permission denied}}
1.106 +test unixFCmd-1.8 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
1.107 + testalarm
1.108 + after 2000
1.109 + list [testgotsig] [testgotsig]
1.110 +} {1 0}
1.111 +test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
1.112 + cleanup
1.113 + set f [open tfalarm w]
1.114 + puts $f {
1.115 + after 2000
1.116 + puts "hello world"
1.117 + exit 0
1.118 + }
1.119 + close $f
1.120 + testalarm
1.121 + set pipe [open "|[info nameofexecutable] tfalarm" r+]
1.122 + set line [read $pipe 1]
1.123 + catch {close $pipe}
1.124 + list $line [testgotsig]
1.125 +} {h 1}
1.126 +test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
1.127 + {unixOnly notRoot} {
1.128 + cleanup
1.129 + close [open tf1 a]
1.130 + close [open tf2 a]
1.131 + file copy -force tf1 tf2
1.132 +} {}
1.133 +test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} {unixOnly notRoot dontCopyLinks} {
1.134 + # copying links should end up with real files
1.135 + cleanup
1.136 + close [open tf1 a]
1.137 + file link -symbolic tf2 tf1
1.138 + file copy tf2 tf3
1.139 + file type tf3
1.140 +} {file}
1.141 +test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {
1.142 + # copying links should end up with the links copied
1.143 + cleanup
1.144 + close [open tf1 a]
1.145 + file link -symbolic tf2 tf1
1.146 + file copy tf2 tf3
1.147 + file type tf3
1.148 +} {link}
1.149 +test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} {
1.150 + cleanup
1.151 + set null "/dev/null"
1.152 + while {[file type $null] != "characterSpecial"} {
1.153 + set null [file join [file dirname $null] [file readlink $null]]
1.154 + }
1.155 + # file copy $null tf1
1.156 +} {}
1.157 +test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} {
1.158 + cleanup
1.159 + if [catch {exec mknod tf1 p}] {
1.160 + list 1
1.161 + } else {
1.162 + file copy tf1 tf2
1.163 + expr {"[file type tf1]" == "[file type tf2]"}
1.164 + }
1.165 +} {1}
1.166 +test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} {
1.167 + cleanup
1.168 + close [open tf1 a]
1.169 + file attributes tf1 -permissions 0472
1.170 + file copy tf1 tf2
1.171 + file attributes tf2 -permissions
1.172 +} 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
1.173 +
1.174 +test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} {
1.175 +} {}
1.176 +
1.177 +test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} {
1.178 +} {}
1.179 +
1.180 +test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} {
1.181 +} {}
1.182 +
1.183 +test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} {
1.184 +} {}
1.185 +
1.186 +test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} {
1.187 +} {}
1.188 +
1.189 +test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} {
1.190 +} {}
1.191 +
1.192 +test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} {
1.193 +} {}
1.194 +
1.195 +test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} {
1.196 +} {}
1.197 +
1.198 +test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} {
1.199 +} {}
1.200 +
1.201 +test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} {
1.202 + catch {file delete -force -- foo.test}
1.203 + list [catch {file attributes foo.test -group} msg] $msg
1.204 +} {1 {could not read "foo.test": no such file or directory}}
1.205 +test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} {
1.206 + catch {file delete -force -- foo.test}
1.207 + close [open foo.test w]
1.208 + list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
1.209 +} {0 {}}
1.210 +
1.211 +test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} {
1.212 + catch {file delete -force -- foo.test}
1.213 + list [catch {file attributes foo.test -group} msg] $msg
1.214 +} {1 {could not read "foo.test": no such file or directory}}
1.215 +test unixFCmd-13.2 {GetOwnerAttribute} {unixOnly notRoot} {
1.216 + catch {file delete -force -- foo.test}
1.217 + close [open foo.test w]
1.218 + list [catch {file attributes foo.test -owner} msg] \
1.219 + [string compare $msg $user] [file delete -force -- foo.test]
1.220 +} {0 0 {}}
1.221 +
1.222 +test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} {
1.223 + catch {file delete -force -- foo.test}
1.224 + list [catch {file attributes foo.test -permissions} msg] $msg
1.225 +} {1 {could not read "foo.test": no such file or directory}}
1.226 +test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} {
1.227 + catch {file delete -force -- foo.test}
1.228 + close [open foo.test w]
1.229 + list [catch {file attribute foo.test -permissions}] \
1.230 + [file delete -force -- foo.test]
1.231 +} {0 {}}
1.232 +
1.233 +# Find a group that exists on this system, or else skip tests that require
1.234 +# groups
1.235 +set ::tcltest::testConstraints(foundGroup) 0
1.236 +if {$tcl_platform(platform) == "unix"} {
1.237 + catch {
1.238 + set groupList [exec groups]
1.239 + set group [lindex $groupList 0]
1.240 + set ::tcltest::testConstraints(foundGroup) 1
1.241 + }
1.242 +}
1.243 +
1.244 +#groups hard to test
1.245 +test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} {
1.246 + catch {file delete -force -- foo.test}
1.247 + list [catch {file attributes foo.test -group foozzz} msg] \
1.248 + $msg [file delete -force -- foo.test]
1.249 +} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
1.250 +test unixFCmd-15.2 {SetGroupAttribute - invalid file} \
1.251 + {unixOnly notRoot foundGroup} {
1.252 + catch {file delete -force -- foo.test}
1.253 + list [catch {file attributes foo.test -group $group} msg] $msg
1.254 +} {1 {could not set group for file "foo.test": no such file or directory}}
1.255 +
1.256 +#changing owners hard to do
1.257 +test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unixOnly notRoot} {
1.258 + catch {file delete -force -- foo.test}
1.259 + close [open foo.test w]
1.260 + list [catch {file attributes foo.test -owner $user} msg] \
1.261 + $msg [string compare [file attributes foo.test -owner] $user] \
1.262 + [file delete -force -- foo.test]
1.263 +} {0 {} 0 {}}
1.264 +test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unixOnly notRoot} {
1.265 + catch {file delete -force -- foo.test}
1.266 + list [catch {file attributes foo.test -owner $user} msg] $msg
1.267 +} {1 {could not set owner for file "foo.test": no such file or directory}}
1.268 +test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unixOnly notRoot} {
1.269 + catch {file delete -force -- foo.test}
1.270 + list [catch {file attributes foo.test -owner foozzz} msg] $msg
1.271 +} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
1.272 +
1.273 +
1.274 +test unixFCmd-17.1 {SetPermissionsAttribute} {unixOnly notRoot} {
1.275 + catch {file delete -force -- foo.test}
1.276 + close [open foo.test w]
1.277 + list [catch {file attributes foo.test -permissions 0000} msg] \
1.278 + $msg [file attributes foo.test -permissions] \
1.279 + [file delete -force -- foo.test]
1.280 +} {0 {} 00000 {}}
1.281 +test unixFCmd-17.2 {SetPermissionsAttribute} {unixOnly notRoot} {
1.282 + catch {file delete -force -- foo.test}
1.283 + list [catch {file attributes foo.test -permissions 0000} msg] $msg
1.284 +} {1 {could not set permissions for file "foo.test": no such file or directory}}
1.285 +test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
1.286 + catch {file delete -force -- foo.test}
1.287 + close [open foo.test w]
1.288 + list [catch {file attributes foo.test -permissions foo} msg] $msg \
1.289 + [file delete -force -- foo.test]
1.290 +} {1 {unknown permission string format "foo"} {}}
1.291 +test unixFCmd-17.4 {SetPermissionsAttribute} {unixOnly notRoot} {
1.292 + catch {file delete -force -- foo.test}
1.293 + close [open foo.test w]
1.294 + list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \
1.295 + [file delete -force -- foo.test]
1.296 +} {1 {unknown permission string format "---rwx"} {}}
1.297 +
1.298 +close [open foo.test w]
1.299 +set ::i 4
1.300 +proc permcheck {testnum permstr expected} {
1.301 + test $testnum {SetPermissionsAttribute} {unixOnly notRoot} {
1.302 + file attributes foo.test -permissions $permstr
1.303 + file attributes foo.test -permissions
1.304 + } $expected
1.305 +}
1.306 +permcheck unixFCmd-17.5 rwxrwxrwx 00777
1.307 +permcheck unixFCmd-17.6 r--r---w- 00442
1.308 +permcheck unixFCmd-17.7 0 00000
1.309 +permcheck unixFCmd-17.8 u+rwx,g+r 00740
1.310 +permcheck unixFCmd-17.9 u-w 00540
1.311 +permcheck unixFCmd-17.10 o+rwx 00547
1.312 +permcheck unixFCmd-17.11 --x--x--x 00111
1.313 +permcheck unixFCmd-17.12 a+rwx 00777
1.314 +file delete -force -- foo.test
1.315 +
1.316 +test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
1.317 + # This test is nonportable because SunOS generates a weird error
1.318 + # message when the current directory isn't readable.
1.319 + set cd [pwd]
1.320 + set nd $cd/tstdir
1.321 + file mkdir $nd
1.322 + cd $nd
1.323 + file attributes $nd -permissions 0000
1.324 + set r [list [catch {pwd} res] [string range $res 0 36]];
1.325 + cd $cd;
1.326 + file attributes $nd -permissions 0755
1.327 + file delete $nd
1.328 + set r
1.329 +} {1 {error getting working directory name:}}
1.330 +
1.331 +# cleanup
1.332 +cleanup
1.333 +cd $oldcwd
1.334 +::tcltest::cleanupTests
1.335 +return