1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443
|
# 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 © 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 tcl::test [info patchlevel]]
testConstraint testchmod [llength [info commands testchmod]]
# File permissions broken on wsl without some "exotic" wsl configuration
testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]
# 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 notWsl} -body {
file mkdir td1/td2/td3
file attributes td1/td2 -permissions 0
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 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 notWsl} -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 notWsl} -body {
close [open tf1 a]
file attributes tf1 -permissions 0o472
file copy tf1 tf2
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 notWsl} -body {
close [open foo.test w]
list [file attributes foo.test -permissions 0] \
[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 0
} -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 notWsl} {
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 0o777
permcheck unixFCmd-17.6 r--r---w- 0o442
permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547}
permcheck unixFCmd-17.11 --x--x--x 0o111
permcheck unixFCmd-17.12 {0 a+rwx} {00000 0o777}
file delete -force -- foo.test
test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
set cd [pwd]
} -body {
# This test is non-portable 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 0
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:
|