| 1 |
578 |
markom |
# 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 (c) 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 |
|
|
#
|
| 12 |
|
|
# RCS: @(#) $Id: unixFCmd.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
|
| 13 |
|
|
|
| 14 |
|
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
| 15 |
|
|
|
| 16 |
|
|
if {$tcl_platform(platform) != "unix"} {
|
| 17 |
|
|
return
|
| 18 |
|
|
}
|
| 19 |
|
|
|
| 20 |
|
|
if {$user == "root"} {
|
| 21 |
|
|
puts "Skipping unixFCmd tests. They depend on not being able to write to"
|
| 22 |
|
|
puts "certain directories. It would be too dangerous to run them as root."
|
| 23 |
|
|
return
|
| 24 |
|
|
}
|
| 25 |
|
|
|
| 26 |
|
|
proc openup {path} {
|
| 27 |
|
|
testchmod 777 $path
|
| 28 |
|
|
if {[file isdirectory $path]} {
|
| 29 |
|
|
catch {
|
| 30 |
|
|
foreach p [glob [file join $path *]] {
|
| 31 |
|
|
openup $p
|
| 32 |
|
|
}
|
| 33 |
|
|
}
|
| 34 |
|
|
}
|
| 35 |
|
|
}
|
| 36 |
|
|
|
| 37 |
|
|
proc cleanup {args} {
|
| 38 |
|
|
foreach p ". $args" {
|
| 39 |
|
|
set x ""
|
| 40 |
|
|
catch {
|
| 41 |
|
|
set x [glob [file join $p tf*] [file join $p td*]]
|
| 42 |
|
|
}
|
| 43 |
|
|
foreach file $x {
|
| 44 |
|
|
if {[catch {file delete -force -- $file}]} {
|
| 45 |
|
|
openup $file
|
| 46 |
|
|
file delete -force -- $file
|
| 47 |
|
|
}
|
| 48 |
|
|
}
|
| 49 |
|
|
}
|
| 50 |
|
|
}
|
| 51 |
|
|
|
| 52 |
|
|
test unixFCmd-1.1 {TclpRenameFile: EACCES} {
|
| 53 |
|
|
cleanup
|
| 54 |
|
|
file mkdir td1/td2/td3
|
| 55 |
|
|
exec chmod 000 td1/td2
|
| 56 |
|
|
set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
|
| 57 |
|
|
exec chmod 755 td1/td2
|
| 58 |
|
|
set msg
|
| 59 |
|
|
} {1 {error renaming "td1/td2/td3": permission denied}}
|
| 60 |
|
|
test unixFCmd-1.2 {TclpRenameFile: EEXIST} {
|
| 61 |
|
|
cleanup
|
| 62 |
|
|
file mkdir td1/td2
|
| 63 |
|
|
file mkdir td2
|
| 64 |
|
|
list [catch {file rename td2 td1} msg] $msg
|
| 65 |
|
|
} {1 {error renaming "td2" to "td1/td2": file already exists}}
|
| 66 |
|
|
test unixFCmd-1.3 {TclpRenameFile: EINVAL} {
|
| 67 |
|
|
cleanup
|
| 68 |
|
|
file mkdir td1
|
| 69 |
|
|
list [catch {file rename td1 td1} msg] $msg
|
| 70 |
|
|
} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
|
| 71 |
|
|
test unixFCmd-1.4 {TclpRenameFile: EISDIR} {
|
| 72 |
|
|
# can't make it happen
|
| 73 |
|
|
} {}
|
| 74 |
|
|
test unixFCmd-1.5 {TclpRenameFile: ENOENT} {
|
| 75 |
|
|
cleanup
|
| 76 |
|
|
file mkdir td1
|
| 77 |
|
|
list [catch {file rename td2 td1} msg] $msg
|
| 78 |
|
|
} {1 {error renaming "td2": no such file or directory}}
|
| 79 |
|
|
test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {
|
| 80 |
|
|
# can't make it happen
|
| 81 |
|
|
} {}
|
| 82 |
|
|
test unixFCmd-1.7 {TclpRenameFile: EXDEV} {
|
| 83 |
|
|
cleanup
|
| 84 |
|
|
file mkdir foo/bar
|
| 85 |
|
|
file attr foo -perm 040555
|
| 86 |
|
|
set msg [list [catch {file rename foo/bar /tmp} msg] $msg]
|
| 87 |
|
|
set a1 {1 {can't unlink "foo/bar": permission denied}}
|
| 88 |
|
|
set result [expr {$msg == $a1}]
|
| 89 |
|
|
catch {file delete /tmp/bar}
|
| 90 |
|
|
catch {file attr foo -perm 040777}
|
| 91 |
|
|
catch {file delete -force foo}
|
| 92 |
|
|
set result
|
| 93 |
|
|
} {1}
|
| 94 |
|
|
test unixFCmd-1.8 {Checking EINTR Bug} nonPortable {
|
| 95 |
|
|
testalarm
|
| 96 |
|
|
after 2000
|
| 97 |
|
|
list [testgotsig] [testgotsig]
|
| 98 |
|
|
} {1 0}
|
| 99 |
|
|
test unixFCmd-1.9 {Checking EINTR Bug} nonPortable {
|
| 100 |
|
|
cleanup
|
| 101 |
|
|
set f [open tfalarm w]
|
| 102 |
|
|
puts $f {
|
| 103 |
|
|
after 2000
|
| 104 |
|
|
puts "hello world"
|
| 105 |
|
|
exit 0
|
| 106 |
|
|
}
|
| 107 |
|
|
close $f
|
| 108 |
|
|
testalarm
|
| 109 |
|
|
set pipe [open "|[info nameofexecutable] tfalarm" r+]
|
| 110 |
|
|
set line [read $pipe 1]
|
| 111 |
|
|
catch {close $pipe}
|
| 112 |
|
|
list $line [testgotsig]
|
| 113 |
|
|
} {h 1}
|
| 114 |
|
|
test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} {
|
| 115 |
|
|
cleanup
|
| 116 |
|
|
exec touch tf1
|
| 117 |
|
|
exec touch tf2
|
| 118 |
|
|
file copy -force tf1 tf2
|
| 119 |
|
|
} {}
|
| 120 |
|
|
test unixFCmd-2.2 {TclpCopyFile: src is symlink} {
|
| 121 |
|
|
cleanup
|
| 122 |
|
|
exec ln -s tf1 tf2
|
| 123 |
|
|
file copy tf2 tf3
|
| 124 |
|
|
file type tf3
|
| 125 |
|
|
} {link}
|
| 126 |
|
|
test unixFCmd-2.3 {TclpCopyFile: src is block} {
|
| 127 |
|
|
cleanup
|
| 128 |
|
|
set null "/dev/null"
|
| 129 |
|
|
while {[file type $null] != "characterSpecial"} {
|
| 130 |
|
|
set null [file join [file dirname $null] [file readlink $null]]
|
| 131 |
|
|
}
|
| 132 |
|
|
# file copy $null tf1
|
| 133 |
|
|
} {}
|
| 134 |
|
|
test unixFCmd-2.4 {TclpCopyFile: src is fifo} {
|
| 135 |
|
|
cleanup
|
| 136 |
|
|
if [catch {exec mknod tf1 p}] {
|
| 137 |
|
|
list 1
|
| 138 |
|
|
} else {
|
| 139 |
|
|
file copy tf1 tf2
|
| 140 |
|
|
expr {"[file type tf1]" == "[file type tf2]"}
|
| 141 |
|
|
}
|
| 142 |
|
|
} {1}
|
| 143 |
|
|
test unixFCmd-2.5 {TclpCopyFile: copy attributes} {
|
| 144 |
|
|
cleanup
|
| 145 |
|
|
exec touch tf1
|
| 146 |
|
|
exec chmod 472 tf1
|
| 147 |
|
|
file copy tf1 tf2
|
| 148 |
|
|
string range [exec ls -l tf2] 0 9
|
| 149 |
|
|
} {-r--rwx-w-}
|
| 150 |
|
|
|
| 151 |
|
|
test unixFCmd-3.1 {CopyFile not done} {
|
| 152 |
|
|
} {}
|
| 153 |
|
|
|
| 154 |
|
|
test unixFCmd-4.1 {TclpDeleteFile not done} {
|
| 155 |
|
|
} {}
|
| 156 |
|
|
|
| 157 |
|
|
test unixFCmd-5.1 {TclpCreateDirectory not done} {
|
| 158 |
|
|
} {}
|
| 159 |
|
|
|
| 160 |
|
|
test unixFCmd-6.1 {TclpCopyDirectory not done} {
|
| 161 |
|
|
} {}
|
| 162 |
|
|
|
| 163 |
|
|
test unixFCmd-7.1 {TclpRemoveDirectory not done} {
|
| 164 |
|
|
} {}
|
| 165 |
|
|
|
| 166 |
|
|
test unixFCmd-8.1 {TraverseUnixTree not done} {
|
| 167 |
|
|
} {}
|
| 168 |
|
|
|
| 169 |
|
|
test unixFCmd-9.1 {TraversalCopy not done} {
|
| 170 |
|
|
} {}
|
| 171 |
|
|
|
| 172 |
|
|
test unixFCmd-10.1 {TraversalDelete not done} {
|
| 173 |
|
|
} {}
|
| 174 |
|
|
|
| 175 |
|
|
test unixFCmd-11.1 {CopyFileAttrs not done} {
|
| 176 |
|
|
} {}
|
| 177 |
|
|
|
| 178 |
|
|
set testConfig(tclGroup) 0
|
| 179 |
|
|
if {[catch {exec {groups}} groupList] == 0} {
|
| 180 |
|
|
if {[lsearch $groupList tcl] != -1} {
|
| 181 |
|
|
set testConfig(tclGroup) 1
|
| 182 |
|
|
}
|
| 183 |
|
|
}
|
| 184 |
|
|
|
| 185 |
|
|
test unixFCmd-12.1 {GetGroupAttribute - file not found} {
|
| 186 |
|
|
catch {file delete -force -- foo.test}
|
| 187 |
|
|
list [catch {file attributes foo.test -group} msg] $msg
|
| 188 |
|
|
} {1 {could not stat file "foo.test": no such file or directory}}
|
| 189 |
|
|
test unixFCmd-12.2 {GetGroupAttribute - file found} {
|
| 190 |
|
|
catch {file delete -force -- foo.test}
|
| 191 |
|
|
close [open foo.test w]
|
| 192 |
|
|
list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
|
| 193 |
|
|
} {0 {}}
|
| 194 |
|
|
|
| 195 |
|
|
test unixFCmd-13.1 {GetOwnerAttribute - file not found} {
|
| 196 |
|
|
catch {file delete -force -- foo.test}
|
| 197 |
|
|
list [catch {file attributes foo.test -group} msg] $msg
|
| 198 |
|
|
} {1 {could not stat file "foo.test": no such file or directory}}
|
| 199 |
|
|
test unixFCmd-13.2 {GetOwnerAttribute} {
|
| 200 |
|
|
catch {file delete -force -- foo.test}
|
| 201 |
|
|
close [open foo.test w]
|
| 202 |
|
|
list [catch {file attributes foo.test -owner} msg] [string compare $msg $user] [file delete -force -- foo.test]
|
| 203 |
|
|
} {0 0 {}}
|
| 204 |
|
|
|
| 205 |
|
|
test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {
|
| 206 |
|
|
catch {file delete -force -- foo.test}
|
| 207 |
|
|
list [catch {file attributes foo.test -permissions} msg] $msg
|
| 208 |
|
|
} {1 {could not stat file "foo.test": no such file or directory}}
|
| 209 |
|
|
test unixFCmd-14.2 {GetPermissionsAttribute} {
|
| 210 |
|
|
catch {file delete -force -- foo.test}
|
| 211 |
|
|
close [open foo.test w]
|
| 212 |
|
|
list [catch {file attribute foo.test -permissions}] [file delete -force -- foo.test]
|
| 213 |
|
|
} {0 {}}
|
| 214 |
|
|
|
| 215 |
|
|
#groups hard to test
|
| 216 |
|
|
test unixFCmd-15.1 {SetGroupAttribute - invalid group} {
|
| 217 |
|
|
catch {file delete -force -- foo.test}
|
| 218 |
|
|
list [catch {file attributes foo.test -group foozzz} msg] $msg [file delete -force -- foo.test]
|
| 219 |
|
|
} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
|
| 220 |
|
|
test unixFCmd-15.2 {SetGroupAttribute - invalid file} {tclGroup} {
|
| 221 |
|
|
catch {file delete -force -- foo.test}
|
| 222 |
|
|
list [catch {file attributes foo.test -group tcl} msg] $msg
|
| 223 |
|
|
} {1 {could not set group for file "foo.test": no such file or directory}}
|
| 224 |
|
|
|
| 225 |
|
|
#changing owners hard to do
|
| 226 |
|
|
test unixFCmd-16.1 {SetOwnerAttribute - current owner} {
|
| 227 |
|
|
catch {file delete -force -- foo.test}
|
| 228 |
|
|
close [open foo.test w]
|
| 229 |
|
|
list [catch {file attributes foo.test -owner $user} msg] $msg [string compare [file attributes foo.test -owner] $user] [file delete -force -- foo.test]
|
| 230 |
|
|
} {0 {} 0 {}}
|
| 231 |
|
|
test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {
|
| 232 |
|
|
catch {file delete -force -- foo.test}
|
| 233 |
|
|
list [catch {file attributes foo.test -owner $user} msg] $msg
|
| 234 |
|
|
} {1 {could not set owner for file "foo.test": no such file or directory}}
|
| 235 |
|
|
test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {
|
| 236 |
|
|
catch {file delete -force -- foo.test}
|
| 237 |
|
|
list [catch {file attributes foo.test -owner foozzz} msg] $msg
|
| 238 |
|
|
} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
|
| 239 |
|
|
|
| 240 |
|
|
|
| 241 |
|
|
test unixFCmd-17.1 {SetPermissionsAttribute} {
|
| 242 |
|
|
catch {file delete -force -- foo.test}
|
| 243 |
|
|
close [open foo.test w]
|
| 244 |
|
|
list [catch {file attributes foo.test -permissions 0000} msg] $msg [file attributes foo.test -permissions] [file delete -force -- foo.test]
|
| 245 |
|
|
} {0 {} 00000 {}}
|
| 246 |
|
|
test unixFCmd-17.2 {SetPermissionsAttribute} {
|
| 247 |
|
|
catch {file delete -force -- foo.test}
|
| 248 |
|
|
list [catch {file attributes foo.test -permissions 0000} msg] $msg
|
| 249 |
|
|
} {1 {could not set permissions for file "foo.test": no such file or directory}}
|
| 250 |
|
|
test unixFCmd-17.3 {SetPermissionsAttribute} {
|
| 251 |
|
|
catch {file delete -force -- foo.test}
|
| 252 |
|
|
close [open foo.test w]
|
| 253 |
|
|
list [catch {file attributes foo.test -permissions foo} msg] $msg [file delete -force -- foo.test]
|
| 254 |
|
|
} {1 {expected integer but got "foo"} {}}
|
| 255 |
|
|
test unixFCmd-18.1 {Unix pwd} {nonPortable} {
|
| 256 |
|
|
# This test is nonportable because SunOS generates a weird error
|
| 257 |
|
|
# message when the current directory isn't readable.
|
| 258 |
|
|
set cd [pwd]
|
| 259 |
|
|
set nd $cd/tstdir
|
| 260 |
|
|
file mkdir $nd
|
| 261 |
|
|
cd $nd
|
| 262 |
|
|
exec chmod 000 $nd
|
| 263 |
|
|
set r [list [catch {pwd} res] [string range $res 0 36]];
|
| 264 |
|
|
cd $cd;
|
| 265 |
|
|
exec chmod 755 $nd
|
| 266 |
|
|
file delete $nd
|
| 267 |
|
|
set r
|
| 268 |
|
|
} {1 {error getting working directory name:}}
|
| 269 |
|
|
|
| 270 |
|
|
cleanup
|
