1# This file tests the tclUnixFCmd.c file. 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright © 1996 Sun Microsystems, Inc. 8# 9# See the file "license.terms" for information on usage and redistribution 10# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 12if {"::tcltest" ni [namespace children]} { 13 package require tcltest 2.5 14 namespace import -force ::tcltest::* 15} 16 17::tcltest::loadTestedCommands 18catch [list package require -exact tcl::test [info patchlevel]] 19 20testConstraint testchmod [llength [info commands testchmod]] 21 22# These tests really need to be run from a writable directory, which 23# it is assumed [temporaryDirectory] is. 24set oldcwd [pwd] 25cd [temporaryDirectory] 26 27# Several tests require need to match results against the unix username 28set user {} 29if {[testConstraint unix]} { 30 catch {set user [exec whoami]} 31 if {$user == ""} { 32 catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user} 33 } 34 if {$user == ""} { 35 set user "root" 36 } 37} 38 39# Find a group that exists on this system, or else skip tests that require 40# groups 41testConstraint foundGroup 0 42if {[testConstraint unix]} { 43 catch { 44 set groupList [exec groups] 45 set group [lindex $groupList 0] 46 testConstraint foundGroup 1 47 } 48} 49 50# check whether -readonly attribute is supported 51testConstraint readonlyAttr 0 52if {[testConstraint unix]} { 53 set f [makeFile "whatever" probe] 54 catch { 55 file attributes $f -readonly 56 testConstraint readonlyAttr 1 57 } 58 removeFile probe 59} 60 61proc openup {path} { 62 testchmod 0o777 $path 63 if {[file isdirectory $path]} { 64 catch { 65 foreach p [glob -directory $path *] { 66 openup $p 67 } 68 } 69 } 70} 71 72proc cleanup {args} { 73 foreach p ". $args" { 74 set x "" 75 catch { 76 set x [glob -directory $p tf* td*] 77 } 78 foreach file $x { 79 if { 80 [catch {file delete -force -- $file}] 81 && [testConstraint testchmod] 82 } then { 83 openup $file 84 file delete -force -- $file 85 } 86 } 87 } 88} 89 90if {[testConstraint unix] && [testConstraint notRoot]} { 91 testConstraint execMknod [expr {![catch {exec mknod tf1 p}]}] 92 cleanup 93} 94 95test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup { 96 cleanup 97} -constraints {unix notRoot} -body { 98 file mkdir td1/td2/td3 99 file attributes td1/td2 -permissions 0 100 file rename td1/td2/td3 td2 101} -returnCodes error -cleanup { 102 file attributes td1/td2 -permissions 0o755 103 cleanup 104} -result {error renaming "td1/td2/td3": permission denied} 105test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup { 106 cleanup 107} -constraints {unix notRoot} -body { 108 file mkdir td1/td2 109 file mkdir td2 110 file rename td2 td1 111} -returnCodes error -cleanup { 112 cleanup 113} -result {error renaming "td2" to "td1/td2": file already exists} 114test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup { 115 cleanup 116} -constraints {unix notRoot} -body { 117 file mkdir td1 118 file rename td1 td1 119} -returnCodes error -cleanup { 120 cleanup 121} -result {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself} 122test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unix notRoot} { 123 # can't make it happen 124} {} 125test unixFCmd-1.5 {TclpRenameFile: ENOENT} -setup { 126 cleanup 127} -constraints {unix notRoot} -body { 128 file mkdir td1 129 file rename td2 td1 130} -returnCodes error -cleanup { 131 cleanup 132} -result {error renaming "td2": no such file or directory} 133test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} { 134 # can't make it happen 135} {} 136test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup { 137 cleanup 138} -constraints {unix notRoot} -body { 139 file mkdir foo/bar 140 file attr foo -perm 0o40555 141 file rename foo/bar /tmp 142} -returnCodes error -cleanup { 143 catch {file delete /tmp/bar} 144 catch {file attr foo -perm 0o40777} 145 catch {file delete -force foo} 146} -match glob -result {*: permission denied} 147test unixFCmd-1.8 {Checking EINTR Bug} {unix notRoot nonPortable} { 148 testalarm 149 after 2000 150 list [testgotsig] [testgotsig] 151} {1 0} 152test unixFCmd-1.9 {Checking EINTR Bug} -constraints {unix notRoot nonPortable} -setup { 153 cleanup 154 set f [open tfalarm w] 155 puts $f { 156 after 2000 157 puts "hello world" 158 exit 0 159 } 160 close $f 161} -body { 162 testalarm 163 set pipe [open "|[info nameofexecutable] tfalarm" r+] 164 set line [read $pipe 1] 165 catch {close $pipe} 166 list $line [testgotsig] 167} -cleanup { 168 cleanup 169} -result {h 1} 170 171test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} -setup { 172 cleanup 173} -constraints {unix notRoot} -body { 174 close [open tf1 a] 175 close [open tf2 a] 176 file copy -force tf1 tf2 177} -cleanup { 178 cleanup 179} -result {} 180test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} -setup { 181 cleanup 182} -constraints {unix notRoot dontCopyLinks} -body { 183 # copying links should end up with real files 184 close [open tf1 a] 185 file link -symbolic tf2 tf1 186 file copy tf2 tf3 187 file type tf3 188} -cleanup { 189 cleanup 190} -result file 191test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} -setup { 192 cleanup 193} -constraints {unix notRoot} -body { 194 # copying links should end up with the links copied 195 close [open tf1 a] 196 file link -symbolic tf2 tf1 197 file copy tf2 tf3 198 file type tf3 199} -cleanup { 200 cleanup 201} -result link 202test unixFCmd-2.3 {TclpCopyFile: src is block} -setup { 203 cleanup 204} -constraints {unix notRoot} -body { 205 set null "/dev/null" 206 while {[file type $null] != "characterSpecial"} { 207 set null [file join [file dirname $null] [file readlink $null]] 208 } 209 # file copy $null tf1 210} -result {} 211test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup { 212 cleanup 213} -constraints {unix notRoot execMknod} -body { 214 exec mknod tf1 p 215 file copy tf1 tf2 216 list [file type tf1] [file type tf2] 217} -cleanup { 218 cleanup 219} -result {fifo fifo} 220test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup { 221 cleanup 222} -constraints {unix notRoot} -body { 223 close [open tf1 a] 224 file attributes tf1 -permissions 0o472 225 file copy tf1 tf2 226 file attributes tf2 -permissions 227} -cleanup { 228 cleanup 229} -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w- 230 231test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} { 232} {} 233 234test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unix notRoot} { 235} {} 236 237test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unix notRoot} { 238} {} 239 240test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unix notRoot} { 241} {} 242 243test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unix notRoot} { 244} {} 245 246test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unix notRoot} { 247} {} 248 249test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unix notRoot} { 250} {} 251 252test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unix notRoot} { 253} {} 254 255test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unix notRoot} { 256} {} 257 258test unixFCmd-12.1 {GetGroupAttribute - file not found} -setup { 259 catch {file delete -force -- foo.test} 260} -constraints {unix notRoot} -returnCodes error -body { 261 file attributes foo.test -group 262} -result {could not read "foo.test": no such file or directory} 263test unixFCmd-12.2 {GetGroupAttribute - file found} -setup { 264 catch {file delete -force -- foo.test} 265} -constraints {unix notRoot} -body { 266 close [open foo.test w] 267 file attributes foo.test -group 268} -cleanup { 269 file delete -force -- foo.test 270} -match glob -result * 271 272test unixFCmd-13.1 {GetOwnerAttribute - file not found} -setup { 273 catch {file delete -force -- foo.test} 274} -constraints {unix notRoot} -returnCodes error -body { 275 file attributes foo.test -group 276} -result {could not read "foo.test": no such file or directory} 277test unixFCmd-13.2 {GetOwnerAttribute} -setup { 278 catch {file delete -force -- foo.test} 279} -constraints {unix notRoot} -body { 280 close [open foo.test w] 281 file attributes foo.test -owner 282} -cleanup { 283 file delete -force -- foo.test 284} -result $user 285 286test unixFCmd-14.1 {GetPermissionsAttribute - file not found} -setup { 287 catch {file delete -force -- foo.test} 288} -constraints {unix notRoot} -returnCodes error -body { 289 file attributes foo.test -permissions 290} -result {could not read "foo.test": no such file or directory} 291test unixFCmd-14.2 {GetPermissionsAttribute} -setup { 292 catch {file delete -force -- foo.test} 293} -constraints {unix notRoot} -body { 294 close [open foo.test w] 295 file attribute foo.test -permissions 296} -cleanup { 297 file delete -force -- foo.test 298} -match glob -result * 299 300#groups hard to test 301test unixFCmd-15.1 {SetGroupAttribute - invalid group} -setup { 302 catch {file delete -force -- foo.test} 303} -constraints {unix notRoot} -body { 304 file attributes foo.test -group foozzz 305} -returnCodes error -cleanup { 306 file delete -force -- foo.test 307} -result {could not set group for file "foo.test": group "foozzz" does not exist} 308test unixFCmd-15.2 {SetGroupAttribute - invalid file} -setup { 309 catch {file delete -force -- foo.test} 310} -constraints {unix notRoot foundGroup} -returnCodes error -body { 311 file attributes foo.test -group $group 312} -result {could not set group for file "foo.test": no such file or directory} 313 314#changing owners hard to do 315test unixFCmd-16.1 {SetOwnerAttribute - current owner} -setup { 316 catch {file delete -force -- foo.test} 317} -constraints {unix notRoot} -body { 318 close [open foo.test w] 319 list [file attributes foo.test -owner $user] \ 320 [file attributes foo.test -owner] 321} -cleanup { 322 file delete -force -- foo.test 323} -result [list {} $user] 324test unixFCmd-16.2 {SetOwnerAttribute - invalid file} -setup { 325 catch {file delete -force -- foo.test} 326} -constraints {unix notRoot} -returnCodes error -body { 327 file attributes foo.test -owner $user 328} -result {could not set owner for file "foo.test": no such file or directory} 329test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} -setup { 330 catch {file delete -force -- foo.test} 331} -constraints {unix notRoot} -returnCodes error -body { 332 file attributes foo.test -owner foozzz 333} -result {could not set owner for file "foo.test": user "foozzz" does not exist} 334 335test unixFCmd-17.1 {SetPermissionsAttribute} -setup { 336 catch {file delete -force -- foo.test} 337} -constraints {unix notRoot} -body { 338 close [open foo.test w] 339 list [file attributes foo.test -permissions 0] \ 340 [file attributes foo.test -permissions] 341} -cleanup { 342 file delete -force -- foo.test 343} -result {{} 00000} 344test unixFCmd-17.2 {SetPermissionsAttribute} -setup { 345 catch {file delete -force -- foo.test} 346} -constraints {unix notRoot} -returnCodes error -body { 347 file attributes foo.test -permissions 0 348} -result {could not set permissions for file "foo.test": no such file or directory} 349test unixFCmd-17.3 {SetPermissionsAttribute} -setup { 350 catch {file delete -force -- foo.test} 351} -constraints {unix notRoot} -body { 352 close [open foo.test w] 353 file attributes foo.test -permissions foo 354} -cleanup { 355 file delete -force -- foo.test 356} -returnCodes error -result {unknown permission string format "foo"} 357test unixFCmd-17.4 {SetPermissionsAttribute} -setup { 358 catch {file delete -force -- foo.test} 359} -constraints {unix notRoot} -body { 360 close [open foo.test w] 361 file attributes foo.test -permissions ---rwx 362} -cleanup { 363 file delete -force -- foo.test 364} -returnCodes error -result {unknown permission string format "---rwx"} 365 366close [open foo.test w] 367set ::i 4 368proc permcheck {testnum permList expected} { 369 test $testnum {SetPermissionsAttribute} {unix notRoot} { 370 set result {} 371 foreach permstr $permList { 372 file attributes foo.test -permissions $permstr 373 lappend result [file attributes foo.test -permissions] 374 } 375 set result 376 } $expected 377} 378permcheck unixFCmd-17.5 rwxrwxrwx 0o777 379permcheck unixFCmd-17.6 r--r---w- 0o442 380permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547} 381permcheck unixFCmd-17.11 --x--x--x 0o111 382permcheck unixFCmd-17.12 {0 a+rwx} {00000 0o777} 383file delete -force -- foo.test 384 385test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup { 386 set cd [pwd] 387} -body { 388 # This test is nonPortable because SunOS generates a weird error 389 # message when the current directory isn't readable. 390 set nd $cd/tstdir 391 file mkdir $nd 392 cd $nd 393 file attributes $nd -permissions 0 394 pwd 395} -returnCodes error -cleanup { 396 cd $cd 397 file attributes $nd -permissions 0o755 398 file delete $nd 399} -match glob -result {error getting working directory name:*} 400 401test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} -setup { 402 catch {file delete -force -- foo.test} 403} -constraints {unix notRoot readonlyAttr} -returnCodes error -body { 404 file attributes foo.test -readonly 405} -result {could not read "foo.test": no such file or directory} 406test unixFCmd-19.2 {GetReadOnlyAttribute} -setup { 407 catch {file delete -force -- foo.test} 408} -constraints {unix notRoot readonlyAttr} -body { 409 close [open foo.test w] 410 file attribute foo.test -readonly 411} -cleanup { 412 file delete -force -- foo.test 413} -result 0 414 415test unixFCmd-20.1 {SetReadOnlyAttribute} -setup { 416 catch {file delete -force -- foo.test} 417} -constraints {unix notRoot readonlyAttr} -body { 418 close [open foo.test w] 419 list [catch {file attributes foo.test -readonly 1} msg] $msg \ 420 [catch {file attribute foo.test -readonly} msg] $msg \ 421 [catch {file delete -force -- foo.test}] \ 422 [catch {file attributes foo.test -readonly 0} msg] $msg \ 423 [catch {file attribute foo.test -readonly} msg] $msg 424} -cleanup { 425 file delete -force -- foo.test 426} -result {0 {} 0 1 1 0 {} 0 0} 427test unixFCmd-20.2 {SetReadOnlyAttribute} -setup { 428 catch {file delete -force -- foo.test} 429} -constraints {unix notRoot readonlyAttr} -returnCodes error -body { 430 file attributes foo.test -readonly 1 431} -result {could not read "foo.test": no such file or directory} 432 433# cleanup 434cleanup 435cd $oldcwd 436::tcltest::cleanupTests 437return 438 439# Local Variables: 440# mode: tcl 441# End: 442