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