|
sl@0
|
1 |
# This file tests the tclUnixFCmd.c file.
|
|
sl@0
|
2 |
#
|
|
sl@0
|
3 |
# This file contains a collection of tests for one or more of the Tcl
|
|
sl@0
|
4 |
# built-in commands. Sourcing this file into Tcl runs the tests and
|
|
sl@0
|
5 |
# generates output for errors. No output means no errors were found.
|
|
sl@0
|
6 |
#
|
|
sl@0
|
7 |
# Copyright (c) 1996 Sun Microsystems, Inc.
|
|
sl@0
|
8 |
#
|
|
sl@0
|
9 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
10 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
11 |
#
|
|
sl@0
|
12 |
# RCS: @(#) $Id: unixFCmd.test,v 1.17.2.1 2003/04/14 15:45:57 vincentdarley Exp $
|
|
sl@0
|
13 |
|
|
sl@0
|
14 |
if {[lsearch [namespace children] ::tcltest] == -1} {
|
|
sl@0
|
15 |
package require tcltest
|
|
sl@0
|
16 |
namespace import -force ::tcltest::*
|
|
sl@0
|
17 |
}
|
|
sl@0
|
18 |
|
|
sl@0
|
19 |
# These tests really need to be run from a writable directory, which
|
|
sl@0
|
20 |
# it is assumed [temporaryDirectory] is.
|
|
sl@0
|
21 |
set oldcwd [pwd]
|
|
sl@0
|
22 |
cd [temporaryDirectory]
|
|
sl@0
|
23 |
|
|
sl@0
|
24 |
# Several tests require need to match results against the unix username
|
|
sl@0
|
25 |
set user {}
|
|
sl@0
|
26 |
if {$tcl_platform(platform) == "unix"} {
|
|
sl@0
|
27 |
catch {set user [exec whoami]}
|
|
sl@0
|
28 |
if {$user == ""} {
|
|
sl@0
|
29 |
catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
|
|
sl@0
|
30 |
}
|
|
sl@0
|
31 |
if {$user == ""} {
|
|
sl@0
|
32 |
set user "root"
|
|
sl@0
|
33 |
}
|
|
sl@0
|
34 |
}
|
|
sl@0
|
35 |
|
|
sl@0
|
36 |
proc openup {path} {
|
|
sl@0
|
37 |
testchmod 777 $path
|
|
sl@0
|
38 |
if {[file isdirectory $path]} {
|
|
sl@0
|
39 |
catch {
|
|
sl@0
|
40 |
foreach p [glob -directory $path *] {
|
|
sl@0
|
41 |
openup $p
|
|
sl@0
|
42 |
}
|
|
sl@0
|
43 |
}
|
|
sl@0
|
44 |
}
|
|
sl@0
|
45 |
}
|
|
sl@0
|
46 |
|
|
sl@0
|
47 |
proc cleanup {args} {
|
|
sl@0
|
48 |
foreach p ". $args" {
|
|
sl@0
|
49 |
set x ""
|
|
sl@0
|
50 |
catch {
|
|
sl@0
|
51 |
set x [glob -directory $p tf* td*]
|
|
sl@0
|
52 |
}
|
|
sl@0
|
53 |
foreach file $x {
|
|
sl@0
|
54 |
if {[catch {file delete -force -- $file}]} {
|
|
sl@0
|
55 |
openup $file
|
|
sl@0
|
56 |
file delete -force -- $file
|
|
sl@0
|
57 |
}
|
|
sl@0
|
58 |
}
|
|
sl@0
|
59 |
}
|
|
sl@0
|
60 |
}
|
|
sl@0
|
61 |
|
|
sl@0
|
62 |
test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} {
|
|
sl@0
|
63 |
cleanup
|
|
sl@0
|
64 |
file mkdir td1/td2/td3
|
|
sl@0
|
65 |
file attributes td1/td2 -permissions 0000
|
|
sl@0
|
66 |
set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
|
|
sl@0
|
67 |
file attributes td1/td2 -permissions 0755
|
|
sl@0
|
68 |
set msg
|
|
sl@0
|
69 |
} {1 {error renaming "td1/td2/td3": permission denied}}
|
|
sl@0
|
70 |
test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} {
|
|
sl@0
|
71 |
cleanup
|
|
sl@0
|
72 |
file mkdir td1/td2
|
|
sl@0
|
73 |
file mkdir td2
|
|
sl@0
|
74 |
list [catch {file rename td2 td1} msg] $msg
|
|
sl@0
|
75 |
} {1 {error renaming "td2" to "td1/td2": file already exists}}
|
|
sl@0
|
76 |
test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly notRoot} {
|
|
sl@0
|
77 |
cleanup
|
|
sl@0
|
78 |
file mkdir td1
|
|
sl@0
|
79 |
list [catch {file rename td1 td1} msg] $msg
|
|
sl@0
|
80 |
} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
|
|
sl@0
|
81 |
test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
82 |
# can't make it happen
|
|
sl@0
|
83 |
} {}
|
|
sl@0
|
84 |
test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unixOnly notRoot} {
|
|
sl@0
|
85 |
cleanup
|
|
sl@0
|
86 |
file mkdir td1
|
|
sl@0
|
87 |
list [catch {file rename td2 td1} msg] $msg
|
|
sl@0
|
88 |
} {1 {error renaming "td2": no such file or directory}}
|
|
sl@0
|
89 |
test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
90 |
# can't make it happen
|
|
sl@0
|
91 |
} {}
|
|
sl@0
|
92 |
test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly notRoot} {
|
|
sl@0
|
93 |
cleanup
|
|
sl@0
|
94 |
file mkdir foo/bar
|
|
sl@0
|
95 |
file attr foo -perm 040555
|
|
sl@0
|
96 |
set catchResult [catch {file rename foo/bar /tmp} msg]
|
|
sl@0
|
97 |
set msg [lindex [split $msg :] end]
|
|
sl@0
|
98 |
catch {file delete /tmp/bar}
|
|
sl@0
|
99 |
catch {file attr foo -perm 040777}
|
|
sl@0
|
100 |
catch {file delete -force foo}
|
|
sl@0
|
101 |
list $catchResult $msg
|
|
sl@0
|
102 |
} {1 { permission denied}}
|
|
sl@0
|
103 |
test unixFCmd-1.8 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
|
|
sl@0
|
104 |
testalarm
|
|
sl@0
|
105 |
after 2000
|
|
sl@0
|
106 |
list [testgotsig] [testgotsig]
|
|
sl@0
|
107 |
} {1 0}
|
|
sl@0
|
108 |
test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
|
|
sl@0
|
109 |
cleanup
|
|
sl@0
|
110 |
set f [open tfalarm w]
|
|
sl@0
|
111 |
puts $f {
|
|
sl@0
|
112 |
after 2000
|
|
sl@0
|
113 |
puts "hello world"
|
|
sl@0
|
114 |
exit 0
|
|
sl@0
|
115 |
}
|
|
sl@0
|
116 |
close $f
|
|
sl@0
|
117 |
testalarm
|
|
sl@0
|
118 |
set pipe [open "|[info nameofexecutable] tfalarm" r+]
|
|
sl@0
|
119 |
set line [read $pipe 1]
|
|
sl@0
|
120 |
catch {close $pipe}
|
|
sl@0
|
121 |
list $line [testgotsig]
|
|
sl@0
|
122 |
} {h 1}
|
|
sl@0
|
123 |
test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
|
|
sl@0
|
124 |
{unixOnly notRoot} {
|
|
sl@0
|
125 |
cleanup
|
|
sl@0
|
126 |
close [open tf1 a]
|
|
sl@0
|
127 |
close [open tf2 a]
|
|
sl@0
|
128 |
file copy -force tf1 tf2
|
|
sl@0
|
129 |
} {}
|
|
sl@0
|
130 |
test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} {unixOnly notRoot dontCopyLinks} {
|
|
sl@0
|
131 |
# copying links should end up with real files
|
|
sl@0
|
132 |
cleanup
|
|
sl@0
|
133 |
close [open tf1 a]
|
|
sl@0
|
134 |
file link -symbolic tf2 tf1
|
|
sl@0
|
135 |
file copy tf2 tf3
|
|
sl@0
|
136 |
file type tf3
|
|
sl@0
|
137 |
} {file}
|
|
sl@0
|
138 |
test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {
|
|
sl@0
|
139 |
# copying links should end up with the links copied
|
|
sl@0
|
140 |
cleanup
|
|
sl@0
|
141 |
close [open tf1 a]
|
|
sl@0
|
142 |
file link -symbolic tf2 tf1
|
|
sl@0
|
143 |
file copy tf2 tf3
|
|
sl@0
|
144 |
file type tf3
|
|
sl@0
|
145 |
} {link}
|
|
sl@0
|
146 |
test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} {
|
|
sl@0
|
147 |
cleanup
|
|
sl@0
|
148 |
set null "/dev/null"
|
|
sl@0
|
149 |
while {[file type $null] != "characterSpecial"} {
|
|
sl@0
|
150 |
set null [file join [file dirname $null] [file readlink $null]]
|
|
sl@0
|
151 |
}
|
|
sl@0
|
152 |
# file copy $null tf1
|
|
sl@0
|
153 |
} {}
|
|
sl@0
|
154 |
test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} {
|
|
sl@0
|
155 |
cleanup
|
|
sl@0
|
156 |
if [catch {exec mknod tf1 p}] {
|
|
sl@0
|
157 |
list 1
|
|
sl@0
|
158 |
} else {
|
|
sl@0
|
159 |
file copy tf1 tf2
|
|
sl@0
|
160 |
expr {"[file type tf1]" == "[file type tf2]"}
|
|
sl@0
|
161 |
}
|
|
sl@0
|
162 |
} {1}
|
|
sl@0
|
163 |
test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} {
|
|
sl@0
|
164 |
cleanup
|
|
sl@0
|
165 |
close [open tf1 a]
|
|
sl@0
|
166 |
file attributes tf1 -permissions 0472
|
|
sl@0
|
167 |
file copy tf1 tf2
|
|
sl@0
|
168 |
file attributes tf2 -permissions
|
|
sl@0
|
169 |
} 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
|
|
sl@0
|
170 |
|
|
sl@0
|
171 |
test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
172 |
} {}
|
|
sl@0
|
173 |
|
|
sl@0
|
174 |
test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
175 |
} {}
|
|
sl@0
|
176 |
|
|
sl@0
|
177 |
test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
178 |
} {}
|
|
sl@0
|
179 |
|
|
sl@0
|
180 |
test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
181 |
} {}
|
|
sl@0
|
182 |
|
|
sl@0
|
183 |
test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
184 |
} {}
|
|
sl@0
|
185 |
|
|
sl@0
|
186 |
test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
187 |
} {}
|
|
sl@0
|
188 |
|
|
sl@0
|
189 |
test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
190 |
} {}
|
|
sl@0
|
191 |
|
|
sl@0
|
192 |
test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
193 |
} {}
|
|
sl@0
|
194 |
|
|
sl@0
|
195 |
test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} {
|
|
sl@0
|
196 |
} {}
|
|
sl@0
|
197 |
|
|
sl@0
|
198 |
test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} {
|
|
sl@0
|
199 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
200 |
list [catch {file attributes foo.test -group} msg] $msg
|
|
sl@0
|
201 |
} {1 {could not read "foo.test": no such file or directory}}
|
|
sl@0
|
202 |
test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} {
|
|
sl@0
|
203 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
204 |
close [open foo.test w]
|
|
sl@0
|
205 |
list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
|
|
sl@0
|
206 |
} {0 {}}
|
|
sl@0
|
207 |
|
|
sl@0
|
208 |
test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} {
|
|
sl@0
|
209 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
210 |
list [catch {file attributes foo.test -group} msg] $msg
|
|
sl@0
|
211 |
} {1 {could not read "foo.test": no such file or directory}}
|
|
sl@0
|
212 |
test unixFCmd-13.2 {GetOwnerAttribute} {unixOnly notRoot} {
|
|
sl@0
|
213 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
214 |
close [open foo.test w]
|
|
sl@0
|
215 |
list [catch {file attributes foo.test -owner} msg] \
|
|
sl@0
|
216 |
[string compare $msg $user] [file delete -force -- foo.test]
|
|
sl@0
|
217 |
} {0 0 {}}
|
|
sl@0
|
218 |
|
|
sl@0
|
219 |
test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} {
|
|
sl@0
|
220 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
221 |
list [catch {file attributes foo.test -permissions} msg] $msg
|
|
sl@0
|
222 |
} {1 {could not read "foo.test": no such file or directory}}
|
|
sl@0
|
223 |
test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} {
|
|
sl@0
|
224 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
225 |
close [open foo.test w]
|
|
sl@0
|
226 |
list [catch {file attribute foo.test -permissions}] \
|
|
sl@0
|
227 |
[file delete -force -- foo.test]
|
|
sl@0
|
228 |
} {0 {}}
|
|
sl@0
|
229 |
|
|
sl@0
|
230 |
# Find a group that exists on this system, or else skip tests that require
|
|
sl@0
|
231 |
# groups
|
|
sl@0
|
232 |
set ::tcltest::testConstraints(foundGroup) 0
|
|
sl@0
|
233 |
if {$tcl_platform(platform) == "unix"} {
|
|
sl@0
|
234 |
catch {
|
|
sl@0
|
235 |
set groupList [exec groups]
|
|
sl@0
|
236 |
set group [lindex $groupList 0]
|
|
sl@0
|
237 |
set ::tcltest::testConstraints(foundGroup) 1
|
|
sl@0
|
238 |
}
|
|
sl@0
|
239 |
}
|
|
sl@0
|
240 |
|
|
sl@0
|
241 |
#groups hard to test
|
|
sl@0
|
242 |
test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} {
|
|
sl@0
|
243 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
244 |
list [catch {file attributes foo.test -group foozzz} msg] \
|
|
sl@0
|
245 |
$msg [file delete -force -- foo.test]
|
|
sl@0
|
246 |
} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
|
|
sl@0
|
247 |
test unixFCmd-15.2 {SetGroupAttribute - invalid file} \
|
|
sl@0
|
248 |
{unixOnly notRoot foundGroup} {
|
|
sl@0
|
249 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
250 |
list [catch {file attributes foo.test -group $group} msg] $msg
|
|
sl@0
|
251 |
} {1 {could not set group for file "foo.test": no such file or directory}}
|
|
sl@0
|
252 |
|
|
sl@0
|
253 |
#changing owners hard to do
|
|
sl@0
|
254 |
test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unixOnly notRoot} {
|
|
sl@0
|
255 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
256 |
close [open foo.test w]
|
|
sl@0
|
257 |
list [catch {file attributes foo.test -owner $user} msg] \
|
|
sl@0
|
258 |
$msg [string compare [file attributes foo.test -owner] $user] \
|
|
sl@0
|
259 |
[file delete -force -- foo.test]
|
|
sl@0
|
260 |
} {0 {} 0 {}}
|
|
sl@0
|
261 |
test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unixOnly notRoot} {
|
|
sl@0
|
262 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
263 |
list [catch {file attributes foo.test -owner $user} msg] $msg
|
|
sl@0
|
264 |
} {1 {could not set owner for file "foo.test": no such file or directory}}
|
|
sl@0
|
265 |
test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unixOnly notRoot} {
|
|
sl@0
|
266 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
267 |
list [catch {file attributes foo.test -owner foozzz} msg] $msg
|
|
sl@0
|
268 |
} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
|
|
sl@0
|
269 |
|
|
sl@0
|
270 |
|
|
sl@0
|
271 |
test unixFCmd-17.1 {SetPermissionsAttribute} {unixOnly notRoot} {
|
|
sl@0
|
272 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
273 |
close [open foo.test w]
|
|
sl@0
|
274 |
list [catch {file attributes foo.test -permissions 0000} msg] \
|
|
sl@0
|
275 |
$msg [file attributes foo.test -permissions] \
|
|
sl@0
|
276 |
[file delete -force -- foo.test]
|
|
sl@0
|
277 |
} {0 {} 00000 {}}
|
|
sl@0
|
278 |
test unixFCmd-17.2 {SetPermissionsAttribute} {unixOnly notRoot} {
|
|
sl@0
|
279 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
280 |
list [catch {file attributes foo.test -permissions 0000} msg] $msg
|
|
sl@0
|
281 |
} {1 {could not set permissions for file "foo.test": no such file or directory}}
|
|
sl@0
|
282 |
test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
|
|
sl@0
|
283 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
284 |
close [open foo.test w]
|
|
sl@0
|
285 |
list [catch {file attributes foo.test -permissions foo} msg] $msg \
|
|
sl@0
|
286 |
[file delete -force -- foo.test]
|
|
sl@0
|
287 |
} {1 {unknown permission string format "foo"} {}}
|
|
sl@0
|
288 |
test unixFCmd-17.4 {SetPermissionsAttribute} {unixOnly notRoot} {
|
|
sl@0
|
289 |
catch {file delete -force -- foo.test}
|
|
sl@0
|
290 |
close [open foo.test w]
|
|
sl@0
|
291 |
list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \
|
|
sl@0
|
292 |
[file delete -force -- foo.test]
|
|
sl@0
|
293 |
} {1 {unknown permission string format "---rwx"} {}}
|
|
sl@0
|
294 |
|
|
sl@0
|
295 |
close [open foo.test w]
|
|
sl@0
|
296 |
set ::i 4
|
|
sl@0
|
297 |
proc permcheck {testnum permstr expected} {
|
|
sl@0
|
298 |
test $testnum {SetPermissionsAttribute} {unixOnly notRoot} {
|
|
sl@0
|
299 |
file attributes foo.test -permissions $permstr
|
|
sl@0
|
300 |
file attributes foo.test -permissions
|
|
sl@0
|
301 |
} $expected
|
|
sl@0
|
302 |
}
|
|
sl@0
|
303 |
permcheck unixFCmd-17.5 rwxrwxrwx 00777
|
|
sl@0
|
304 |
permcheck unixFCmd-17.6 r--r---w- 00442
|
|
sl@0
|
305 |
permcheck unixFCmd-17.7 0 00000
|
|
sl@0
|
306 |
permcheck unixFCmd-17.8 u+rwx,g+r 00740
|
|
sl@0
|
307 |
permcheck unixFCmd-17.9 u-w 00540
|
|
sl@0
|
308 |
permcheck unixFCmd-17.10 o+rwx 00547
|
|
sl@0
|
309 |
permcheck unixFCmd-17.11 --x--x--x 00111
|
|
sl@0
|
310 |
permcheck unixFCmd-17.12 a+rwx 00777
|
|
sl@0
|
311 |
file delete -force -- foo.test
|
|
sl@0
|
312 |
|
|
sl@0
|
313 |
test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
|
|
sl@0
|
314 |
# This test is nonportable because SunOS generates a weird error
|
|
sl@0
|
315 |
# message when the current directory isn't readable.
|
|
sl@0
|
316 |
set cd [pwd]
|
|
sl@0
|
317 |
set nd $cd/tstdir
|
|
sl@0
|
318 |
file mkdir $nd
|
|
sl@0
|
319 |
cd $nd
|
|
sl@0
|
320 |
file attributes $nd -permissions 0000
|
|
sl@0
|
321 |
set r [list [catch {pwd} res] [string range $res 0 36]];
|
|
sl@0
|
322 |
cd $cd;
|
|
sl@0
|
323 |
file attributes $nd -permissions 0755
|
|
sl@0
|
324 |
file delete $nd
|
|
sl@0
|
325 |
set r
|
|
sl@0
|
326 |
} {1 {error getting working directory name:}}
|
|
sl@0
|
327 |
|
|
sl@0
|
328 |
# cleanup
|
|
sl@0
|
329 |
cleanup
|
|
sl@0
|
330 |
cd $oldcwd
|
|
sl@0
|
331 |
::tcltest::cleanupTests
|
|
sl@0
|
332 |
return
|