Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/fileName.test @ 47

Last change on this file since 47 was 25, checked in by landauf, 17 years ago

added tcl to libs
File size: 52.4 KB
Line 
1# This file tests the filename manipulation routines.
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) 1995-1996 Sun Microsystems, Inc.
8# Copyright (c) 1999 by Scriptics Corporation.
9#
10# See the file "license.terms" for information on usage and redistribution
11# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12#
13# RCS: @(#) $Id: fileName.test,v 1.51 2006/03/21 11:12:29 dkf Exp $
14
15if {[lsearch [namespace children] ::tcltest] == -1} {
16    package require tcltest
17    namespace import -force ::tcltest::*
18}
19
20testConstraint testsetplatform [llength [info commands testsetplatform]]
21testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
22testConstraint linkDirectory 1
23testConstraint symbolicLinkFile 1
24if {[testConstraint win]} {
25    if {[string index $tcl_platform(osVersion) 0] < 5 \
26            || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
27        testConstraint linkDirectory 0
28    }
29    testConstraint symbolicLinkFile 0
30}
31
32global env
33if {[testConstraint testsetplatform]} {
34    set platform [testgetplatform]
35}
36
37# Caution: when using 'testsetplatform' to test different file
38# name platform descriptions in this file, one must be very
39# careful not to combine such platform manipulation with
40# commands like 'cd', 'pwd'.  That is because the latter commands
41# operate on the real filesystem but will potentially have their
42# logic routed through the wrong generic code paths if we've
43# used 'testsetplatform'.  This can lead to serious problems,
44# even crashes.
45test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} {
46    testsetplatform unix
47    file pathtype /
48} absolute
49test filename-1.2 {Tcl_GetPathType: unix} {testsetplatform} {
50    testsetplatform unix
51    file pathtype /foo
52} absolute
53test filename-1.3 {Tcl_GetPathType: unix} {testsetplatform} {
54    testsetplatform unix
55    file pathtype foo
56} relative
57test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} {
58    testsetplatform unix
59    file pathtype c:/foo
60} relative
61test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} {
62    testsetplatform unix
63    file pathtype ~
64} absolute
65test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} {
66    testsetplatform unix
67    file pathtype ~/foo
68} absolute
69test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} {
70    testsetplatform unix
71    file pathtype ~foo
72} absolute
73test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} {
74    testsetplatform unix
75    file pathtype ./~foo
76} relative
77
78test filename-3.1 {Tcl_GetPathType: windows} {testsetplatform} {
79    testsetplatform windows
80    file pathtype /
81} volumerelative
82test filename-3.2 {Tcl_GetPathType: windows} {testsetplatform} {
83    testsetplatform windows
84    file pathtype \\
85} volumerelative
86test filename-3.3 {Tcl_GetPathType: windows} {testsetplatform} {
87    testsetplatform windows
88    file pathtype /foo
89} volumerelative
90test filename-3.4 {Tcl_GetPathType: windows} {testsetplatform} {
91    testsetplatform windows
92    file pathtype \\foo
93} volumerelative
94test filename-3.5 {Tcl_GetPathType: windows} {testsetplatform} {
95    testsetplatform windows
96    file pathtype c:/
97} absolute
98test filename-3.6 {Tcl_GetPathType: windows} {testsetplatform} {
99    testsetplatform windows
100    file pathtype c:\\
101} absolute
102test filename-3.7 {Tcl_GetPathType: windows} {testsetplatform} {
103    testsetplatform windows
104    file pathtype c:/foo
105} absolute
106test filename-3.8 {Tcl_GetPathType: windows} {testsetplatform} {
107    testsetplatform windows
108    file pathtype c:\\foo
109} absolute
110test filename-3.9 {Tcl_GetPathType: windows} {testsetplatform} {
111    testsetplatform windows
112    file pathtype c:
113} volumerelative
114test filename-3.10 {Tcl_GetPathType: windows} {testsetplatform} {
115    testsetplatform windows
116    file pathtype c:foo
117} volumerelative
118test filename-3.11 {Tcl_GetPathType: windows} {testsetplatform} {
119    testsetplatform windows
120    file pathtype foo
121} relative
122test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} {
123    testsetplatform windows
124    file pathtype //foo/bar
125} absolute
126test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} {
127    testsetplatform windows
128    file pathtype ~foo
129} absolute
130test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} {
131    testsetplatform windows
132    file pathtype ~
133} absolute
134test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} {
135    testsetplatform windows
136    file pathtype ~/foo
137} absolute
138test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} {
139    testsetplatform windows
140    file pathtype ./~foo
141} relative
142
143test filename-4.1 {Tcl_SplitPath: unix} {testsetplatform} {
144    testsetplatform unix
145    file split /
146} {/}
147test filename-4.2 {Tcl_SplitPath: unix} {testsetplatform} {
148    testsetplatform unix
149    file split /foo
150} {/ foo}
151test filename-4.3 {Tcl_SplitPath: unix} {testsetplatform} {
152    testsetplatform unix
153    file split /foo/bar
154} {/ foo bar}
155test filename-4.4 {Tcl_SplitPath: unix} {testsetplatform} {
156    testsetplatform unix
157    file split /foo/bar/baz
158} {/ foo bar baz}
159test filename-4.5 {Tcl_SplitPath: unix} {testsetplatform} {
160    testsetplatform unix
161    file split foo/bar
162} {foo bar}
163test filename-4.6 {Tcl_SplitPath: unix} {testsetplatform} {
164    testsetplatform unix
165    file split ./foo/bar
166} {. foo bar}
167test filename-4.7 {Tcl_SplitPath: unix} {testsetplatform} {
168    testsetplatform unix
169    file split /foo/../././foo/bar
170} {/ foo .. . . foo bar}
171test filename-4.8 {Tcl_SplitPath: unix} {testsetplatform} {
172    testsetplatform unix
173    file split ../foo/bar
174} {.. foo bar}
175test filename-4.9 {Tcl_SplitPath: unix} {testsetplatform} {
176    testsetplatform unix
177    file split {}
178} {}
179test filename-4.10 {Tcl_SplitPath: unix} {testsetplatform} {
180    testsetplatform unix
181    file split .
182} {.}
183test filename-4.11 {Tcl_SplitPath: unix} {testsetplatform} {
184    testsetplatform unix
185    file split ../
186} {..}
187test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} {
188    testsetplatform unix
189    file split ../..
190} {.. ..}
191test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} {
192    testsetplatform unix
193    file split //foo
194} {/ foo}
195test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} {
196    testsetplatform unix
197    file split foo//bar
198} {foo bar}
199test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} {
200    testsetplatform unix
201    file split ~foo
202} {~foo}
203test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} {
204    testsetplatform unix
205    file split ~foo/~bar
206} {~foo ./~bar}
207test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} {
208    testsetplatform unix
209    file split ~foo/~bar/~baz
210} {~foo ./~bar ./~baz}
211test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} {
212    testsetplatform unix
213    file split foo/bar~/baz
214} {foo bar~ baz}
215
216if {[testConstraint testsetplatform]} {
217    testsetplatform $platform
218}
219
220test filename-4.19 {Tcl_SplitPath} {
221    set oldDir [pwd]
222    set res [catch {
223        cd [temporaryDirectory]
224        file mkdir tildetmp
225        set nastydir [file join tildetmp ./~tilde]
226        file mkdir $nastydir
227        set norm [file normalize $nastydir]
228        cd tildetmp
229        cd ./~tilde
230        glob -nocomplain *
231        set idx [string first tildetmp $norm]
232        set norm [string range $norm $idx end]
233        # fix path away so all platforms are the same
234        regsub {(.*):$} $norm {\1} norm
235        regsub -all ":" $norm "/" norm
236        # make sure we can delete the directory we created
237        cd $oldDir
238        file delete -force $nastydir
239        set norm
240    } err]
241    cd $oldDir
242    catch {file delete -force [file join [temporaryDirectory] tildetmp]}
243    list $res $err
244} {0 tildetmp/~tilde}
245
246test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} {
247    testsetplatform win
248    file split /
249} {/}
250test filename-6.2 {Tcl_SplitPath: win} {testsetplatform} {
251    testsetplatform win
252    file split /foo
253} {/ foo}
254test filename-6.3 {Tcl_SplitPath: win} {testsetplatform} {
255    testsetplatform win
256    file split /foo/bar
257} {/ foo bar}
258test filename-6.4 {Tcl_SplitPath: win} {testsetplatform} {
259    testsetplatform win
260    file split /foo/bar/baz
261} {/ foo bar baz}
262test filename-6.5 {Tcl_SplitPath: win} {testsetplatform} {
263    testsetplatform win
264    file split foo/bar
265} {foo bar}
266test filename-6.6 {Tcl_SplitPath: win} {testsetplatform} {
267    testsetplatform win
268    file split ./foo/bar
269} {. foo bar}
270test filename-6.7 {Tcl_SplitPath: win} {testsetplatform} {
271    testsetplatform win
272    file split /foo/../././foo/bar
273} {/ foo .. . . foo bar}
274test filename-6.8 {Tcl_SplitPath: win} {testsetplatform} {
275    testsetplatform win
276    file split ../foo/bar
277} {.. foo bar}
278test filename-6.9 {Tcl_SplitPath: win} {testsetplatform} {
279    testsetplatform win
280    file split {}
281} {}
282test filename-6.10 {Tcl_SplitPath: win} {testsetplatform} {
283    testsetplatform win
284    file split .
285} {.}
286test filename-6.11 {Tcl_SplitPath: win} {testsetplatform} {
287    testsetplatform win
288    file split ../
289} {..}
290test filename-6.12 {Tcl_SplitPath: win} {testsetplatform} {
291    testsetplatform win
292    file split ../..
293} {.. ..}
294test filename-6.13 {Tcl_SplitPath: win} {testsetplatform} {
295    testsetplatform win
296    file split //foo
297} {/ foo}
298test filename-6.14 {Tcl_SplitPath: win} {testsetplatform} {
299    testsetplatform win
300    file split foo//bar
301} {foo bar}
302test filename-6.15 {Tcl_SplitPath: win} {testsetplatform} {
303    testsetplatform win
304    file split /\\/foo//bar
305} {//foo/bar}
306test filename-6.16 {Tcl_SplitPath: win} {testsetplatform} {
307    testsetplatform win
308    file split /\\/foo//bar
309} {//foo/bar}
310test filename-6.17 {Tcl_SplitPath: win} {testsetplatform} {
311    testsetplatform win
312    file split /\\/foo//bar
313} {//foo/bar}
314test filename-6.18 {Tcl_SplitPath: win} {testsetplatform} {
315    testsetplatform win
316    file split \\\\foo\\bar
317} {//foo/bar}
318test filename-6.19 {Tcl_SplitPath: win} {testsetplatform} {
319    testsetplatform win
320    file split \\\\foo\\bar/baz
321} {//foo/bar baz}
322test filename-6.20 {Tcl_SplitPath: win} {testsetplatform} {
323    testsetplatform win
324    file split c:/foo
325} {c:/ foo}
326test filename-6.21 {Tcl_SplitPath: win} {testsetplatform} {
327    testsetplatform win
328    file split c:foo
329} {c: foo}
330test filename-6.22 {Tcl_SplitPath: win} {testsetplatform} {
331    testsetplatform win
332    file split c:
333} {c:}
334test filename-6.23 {Tcl_SplitPath: win} {testsetplatform} {
335    testsetplatform win
336    file split c:\\
337} {c:/}
338test filename-6.24 {Tcl_SplitPath: win} {testsetplatform} {
339    testsetplatform win
340    file split c:/
341} {c:/}
342test filename-6.25 {Tcl_SplitPath: win} {testsetplatform} {
343    testsetplatform win
344    file split c:/./..
345} {c:/ . ..}
346test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} {
347    testsetplatform win
348    file split ~foo
349} {~foo}
350test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} {
351    testsetplatform win
352    file split ~foo/~bar
353} {~foo ./~bar}
354test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} {
355    testsetplatform win
356    file split ~foo/~bar/~baz
357} {~foo ./~bar ./~baz}
358test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} {
359    testsetplatform win
360    file split foo/bar~/baz
361} {foo bar~ baz}
362test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} {
363    testsetplatform win
364    file split c:~foo
365} {c: ./~foo}
366
367test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} {
368    testsetplatform unix
369    file join / a
370} {/a}
371test filename-7.2 {Tcl_JoinPath: unix} {testsetplatform} {
372    testsetplatform unix
373    file join a b
374} {a/b}
375test filename-7.3 {Tcl_JoinPath: unix} {testsetplatform} {
376    testsetplatform unix
377    file join /a c /b d
378} {/b/d}
379test filename-7.4 {Tcl_JoinPath: unix} {testsetplatform} {
380    testsetplatform unix
381    file join /
382} {/}
383test filename-7.5 {Tcl_JoinPath: unix} {testsetplatform} {
384    testsetplatform unix
385    file join a
386} {a}
387test filename-7.6 {Tcl_JoinPath: unix} {testsetplatform} {
388    testsetplatform unix
389    file join {}
390} {}
391test filename-7.7 {Tcl_JoinPath: unix} {testsetplatform} {
392    testsetplatform unix
393    file join /a/ b
394} {/a/b}
395test filename-7.8 {Tcl_JoinPath: unix} {testsetplatform} {
396    testsetplatform unix
397    file join /a// b
398} {/a/b}
399test filename-7.9 {Tcl_JoinPath: unix} {testsetplatform} {
400    testsetplatform unix
401    file join /a/./../. b
402} {/a/./.././b}
403test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} {
404    testsetplatform unix
405    file join ~ a
406} {~/a}
407test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} {
408    testsetplatform unix
409    file join ~a ~b
410} {~b}
411test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} {
412    testsetplatform unix
413    file join ./~a b
414} {./~a/b}
415test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} {
416    testsetplatform unix
417    file join ./~a ~b
418} {~b}
419test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} {
420    testsetplatform unix
421    file join ./~a ./~b
422} {./~a/~b}
423test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} {
424    testsetplatform unix
425    file join a . b
426} {a/./b}
427test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} {
428    testsetplatform unix
429    file join a . ./~b
430} {a/./~b}
431test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} {
432    testsetplatform unix
433    file join //a b
434} {/a/b}
435test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} {
436    testsetplatform unix
437    file join /// a b
438} {/a/b}
439
440
441test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
442    testsetplatform win
443    file join a b
444} {a/b}
445test filename-9.2 {Tcl_JoinPath: win} {testsetplatform} {
446    testsetplatform win
447    file join /a b
448} {/a/b}
449test filename-9.3 {Tcl_JoinPath: win} {testsetplatform} {
450    testsetplatform win
451    file join /a /b
452} {/b}
453test filename-9.4 {Tcl_JoinPath: win} {testsetplatform} {
454    testsetplatform win
455    file join c: foo
456} {c:foo}
457test filename-9.5 {Tcl_JoinPath: win} {testsetplatform} {
458    testsetplatform win
459    file join c:/ foo
460} {c:/foo}
461test filename-9.6 {Tcl_JoinPath: win} {testsetplatform} {
462    testsetplatform win
463    file join c:\\bar foo
464} {c:/bar/foo}
465test filename-9.7 {Tcl_JoinPath: win} {testsetplatform} {
466    testsetplatform win
467    file join /foo c:bar
468} {c:bar}
469test filename-9.8 {Tcl_JoinPath: win} {testsetplatform} {
470    testsetplatform win
471    file join ///host//share dir
472} {//host/share/dir}
473test filename-9.9 {Tcl_JoinPath: win} {testsetplatform} {
474    testsetplatform win
475    file join ~ foo
476} {~/foo}
477test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} {
478    testsetplatform win
479    file join ~/~foo
480} {~/~foo}
481test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} {
482    testsetplatform win
483    file join ~ ./~foo
484} {~/~foo}
485test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} {
486    testsetplatform win
487    file join / ~foo
488} {~foo}
489test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} {
490    testsetplatform win
491    file join ./a/ b c
492} {./a/b/c}
493test filename-9.14 {Tcl_JoinPath: win} {testsetplatform} {
494    testsetplatform win
495    file join ./~a/ b c
496} {./~a/b/c}
497test filename-9.15 {Tcl_JoinPath: win} {testsetplatform} {
498    testsetplatform win
499    file join // host share path
500} {/host/share/path}
501test filename-9.16 {Tcl_JoinPath: win} {testsetplatform} {
502    testsetplatform win
503    file join foo . bar
504} {foo/./bar}
505test filename-9.17 {Tcl_JoinPath: win} {testsetplatform} {
506    testsetplatform win
507    file join foo .. bar
508} {foo/../bar}
509test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} {
510    testsetplatform win
511    file join foo/./bar
512} {foo/./bar}
513test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} {
514    testsetplatform win
515    set res {}
516    lappend res \
517      [file join {C:\foo\bar}] \
518      [file join C:/blah {C:\foo\bar}] \
519      [file join C:/blah C:/blah {C:\foo\bar}]
520} {C:/foo/bar C:/foo/bar C:/foo/bar}
521test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} {
522    testsetplatform win
523    set res {}
524    lappend res \
525      [file join {foo\bar}] \
526      [file join C:/blah {foo\bar}] \
527      [file join C:/blah C:/blah {foo\bar}]
528} {foo/bar C:/blah/foo/bar C:/blah/foo/bar}
529test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform win} {
530    testsetplatform win
531    set res {}
532    lappend res \
533      [file join {foo\bar}] \
534      [file join [pwd] {foo\bar}] \
535      [file join [pwd] [pwd] {foo\bar}]
536    set nres {}
537    foreach elt $res {
538        lappend nres [string map [list [pwd] pwd] $elt]
539    }
540    set nres
541} {foo/bar pwd/foo/bar pwd/foo/bar}
542test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} {
543    testsetplatform unix
544    set res {}
545    lappend res \
546      [file join {/foo/bar}] \
547      [file join /x {/foo/bar}] \
548      [file join /x /x {/foo/bar}]
549} {/foo/bar /foo/bar /foo/bar}
550test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} {
551    testsetplatform win
552    set res {}
553    lappend res \
554      [file join {foo\bar}] \
555      [file join C:/blah {foo\bar}] \
556      [file join C:/blah C:/blah {foo\bar}]
557    string map [list C:/blah ""] $res
558} {foo/bar /foo/bar /foo/bar}
559test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} {
560    testsetplatform unix
561    set res {}
562    lappend res \
563      [file join {foo/bar}] \
564      [file join /x {foo/bar}] \
565      [file join /x /x {foo/bar}]
566    string map [list /x ""] $res
567} {foo/bar /foo/bar /foo/bar}
568
569test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} {
570    testsetplatform unix
571    list [catch {testtranslatefilename foo} msg] $msg
572} {0 foo}
573test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} {
574    testsetplatform windows
575    list [catch {testtranslatefilename {c:/foo}} msg] $msg
576} {0 {c:\foo}}
577test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} {
578    testsetplatform windows
579    list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg
580} {0 {c:\foo}}
581test filename-10.3.1 {Tcl_TranslateFileName} {testsetplatform} {
582    testsetplatform windows
583    list [catch {testtranslatefilename {c://///}} msg] $msg
584} {0 c:\\}
585test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} {
586    global env
587    set temp $env(HOME)
588    set env(HOME) "/home/test"
589    testsetplatform unix
590    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
591    set env(HOME) $temp
592    set result
593} {0 /home/test/foo}
594test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} {
595    global env
596    set temp $env(HOME)
597    unset env(HOME)
598    testsetplatform unix
599    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
600    set env(HOME) $temp
601    set result
602} {1 {couldn't find HOME environment variable to expand path}}
603test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} {
604    global env
605    set temp $env(HOME)
606    set env(HOME) "/home/test"
607    testsetplatform unix
608    set result [list [catch {testtranslatefilename ~} msg] $msg]
609    set env(HOME) $temp
610    set result
611} {0 /home/test}
612test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} {
613    global env
614    set temp $env(HOME)
615    set env(HOME) "/home/test/"
616    testsetplatform unix
617    set result [list [catch {testtranslatefilename ~} msg] $msg]
618    set env(HOME) $temp
619    set result
620} {0 /home/test}
621test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} {
622    global env
623    set temp $env(HOME)
624    set env(HOME) "/home/test/"
625    testsetplatform unix
626    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
627    set env(HOME) $temp
628    set result
629} {0 /home/test/foo}
630test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} {
631    global env
632    set temp $env(HOME)
633    set env(HOME) "\\home\\"
634    testsetplatform windows
635    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
636    set env(HOME) $temp
637    set result
638} {0 {\home\foo}}
639test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} {
640    global env
641    set temp $env(HOME)
642    set env(HOME) "\\home\\"
643    testsetplatform windows
644    set result [list [catch {testtranslatefilename ~/foo\\bar} msg] $msg]
645    set env(HOME) $temp
646    set result
647} {0 {\home\foo\bar}}
648test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} {
649    global env
650    set temp $env(HOME)
651    set env(HOME) "c:"
652    testsetplatform windows
653    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
654    set env(HOME) $temp
655    set result
656} {0 c:foo}
657test filename-10.20 {Tcl_TranslateFileName} {testtranslatefilename} {
658    list [catch {testtranslatefilename ~blorp/foo} msg] $msg
659} {1 {user "blorp" doesn't exist}}
660test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} {
661    global env
662    set temp $env(HOME)
663    set env(HOME) "c:\\"
664    testsetplatform windows
665    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
666    set env(HOME) $temp
667    set result
668} {0 {c:\foo}}
669test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} {
670    testsetplatform windows
671    list [catch {testtranslatefilename foo//bar} msg] $msg
672} {0 {foo\bar}}
673
674if {[testConstraint testsetplatform]} {
675    testsetplatform $platform
676}
677
678test filename-10.23 {Tcl_TranslateFileName} {nonPortable} {
679    # this test fails if ~ouster is not /home/ouster
680    list [catch {testtranslatefilename ~ouster} msg] $msg
681} {0 /home/ouster}
682test filename-10.24 {Tcl_TranslateFileName} {nonPortable} {
683    # this test fails if ~ouster is not /home/ouster
684    list [catch {testtranslatefilename ~ouster/foo} msg] $msg
685} {0 /home/ouster/foo}
686
687
688test filename-11.1 {Tcl_GlobCmd} {
689    list [catch {glob} msg] $msg
690} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
691test filename-11.2 {Tcl_GlobCmd} {
692    list [catch {glob -gorp} msg] $msg
693} {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
694test filename-11.3 {Tcl_GlobCmd} {
695    list [catch {glob -nocomplai} msg] $msg
696} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
697test filename-11.4 {Tcl_GlobCmd} {
698    list [catch {glob -nocomplain} msg] $msg
699} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
700test filename-11.5 {Tcl_GlobCmd} {
701    list [catch {glob -nocomplain * ~xyqrszzz} msg] $msg
702} {1 {user "xyqrszzz" doesn't exist}}
703test filename-11.6 {Tcl_GlobCmd} {
704    list [catch {glob ~xyqrszzz} msg] $msg
705} {1 {user "xyqrszzz" doesn't exist}}
706test filename-11.7 {Tcl_GlobCmd} {
707    list [catch {glob -- -nocomplain} msg] $msg
708} {1 {no files matched glob pattern "-nocomplain"}}
709test filename-11.8 {Tcl_GlobCmd} {
710    list [catch {glob -nocomplain -- -nocomplain} msg] $msg
711} {0 {}}
712test filename-11.9 {Tcl_GlobCmd} {testsetplatform} {
713    testsetplatform unix
714    list [catch {glob ~\\xyqrszzz/bar} msg] $msg
715} {1 {user "\xyqrszzz" doesn't exist}}
716test filename-11.10 {Tcl_GlobCmd} {testsetplatform} {
717    testsetplatform unix
718    list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg
719} {1 {user "\xyqrszzz" doesn't exist}}
720test filename-11.11 {Tcl_GlobCmd} {testsetplatform} {
721    testsetplatform unix
722    list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg
723} {1 {user "xyqrszzz" doesn't exist}}
724test filename-11.12 {Tcl_GlobCmd} {testsetplatform} {
725    testsetplatform unix
726    set home $env(HOME)
727    unset env(HOME)
728    set x [list [catch {glob ~/*} msg] $msg]
729    set env(HOME) $home
730    set x
731} {1 {couldn't find HOME environment variable to expand path}}
732
733if {[testConstraint testsetplatform]} {
734    testsetplatform $platform
735}
736
737test filename-11.13 {Tcl_GlobCmd} {
738    list [catch {file join [lindex [glob ~] 0]} msg] $msg
739} [list 0 [file join $env(HOME)]]
740
741set oldpwd [pwd]
742set oldhome $env(HOME)
743cd [temporaryDirectory]
744set env(HOME) [pwd]
745file delete -force globTest
746file mkdir globTest/a1/b1
747file mkdir globTest/a1/b2
748file mkdir globTest/a2/b3
749file mkdir globTest/a3
750close [open globTest/x1.c w]
751close [open globTest/y1.c w]
752close [open globTest/z1.c w]
753close [open "globTest/weird name.c" w]
754close [open globTest/a1/b1/x2.c w]
755close [open globTest/a1/b2/y2.c w]
756
757catch {close [open globTest/.1 w]}
758catch {close [open globTest/x,z1.c w]}
759
760test filename-11.14 {Tcl_GlobCmd} {
761    list [catch {glob ~/globTest} msg] $msg
762} [list 0 [list [file join $env(HOME) globTest]]]
763test filename-11.15 {Tcl_GlobCmd} {
764    list [catch {glob ~\\/globTest} msg] $msg
765} [list 0 [list [file join $env(HOME) globTest]]]
766test filename-11.16 {Tcl_GlobCmd} {
767    list [catch {glob globTest} msg] $msg
768} {0 globTest}
769
770set globname "globTest"
771set horribleglobname "glob\[\{Test"
772
773test filename-11.17 {Tcl_GlobCmd} {unix} {
774    list [catch {lsort [glob -directory $globname *]} msg] $msg
775} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
776        [file join $globname a3]\
777        [file join $globname "weird name.c"]\
778        [file join $globname x,z1.c]\
779        [file join $globname x1.c]\
780        [file join $globname y1.c] [file join $globname z1.c]]]]
781test filename-11.17.1 {Tcl_GlobCmd} {win} {
782    list [catch {lsort [glob -directory $globname *]} msg] $msg
783} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
784        [file join $globname .1]\
785        [file join $globname a3]\
786        [file join $globname "weird name.c"]\
787        [file join $globname x,z1.c]\
788        [file join $globname x1.c]\
789        [file join $globname y1.c] [file join $globname z1.c]]]]
790test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} {
791    set dir [pwd]
792    set ret "error in test"
793    if {[catch {
794        cd $globname
795        file link -symbolic link a1
796        cd $dir
797        set ret [list [catch {
798            lsort [glob -directory $globname -join * b1]
799        } msg] $msg]
800    }]} {
801        cd $dir
802    }
803    file delete [file join $globname link]
804    set ret
805} [list 0 [lsort [list [file join $globname a1 b1] \
806  [file join $globname link b1]]]]
807# Simpler version of the above test to illustrate a given bug.
808test filename-11.17.3 {Tcl_GlobCmd} {notRoot linkDirectory} {
809    set dir [pwd]
810    set ret "error in test"
811    if {[catch {
812        cd $globname
813        file link -symbolic link a1
814        cd $dir
815        set ret [list [catch {
816            lsort [glob -directory $globname -type d *]
817        } msg] $msg]
818    }]} {
819        cd $dir
820    }
821    file delete [file join $globname link]
822    set ret
823} [list 0 [lsort [list [file join $globname a1] \
824  [file join $globname a2] \
825  [file join $globname a3] \
826  [file join $globname link]]]]
827# Make sure the bugfix isn't too simple.  We don't want
828# to break 'glob -type l'.
829test filename-11.17.4 {Tcl_GlobCmd} {notRoot linkDirectory} {
830    set dir [pwd]
831    set ret "error in test"
832    if {[catch {
833        cd $globname
834        file link -symbolic link a1
835        cd $dir
836        set ret [list [catch {
837            lsort [glob -directory $globname -type l *]
838        } msg] $msg]
839    }]} {
840        cd $dir
841    }
842    file delete [file join $globname link]
843    set ret
844} [list 0 [list [file join $globname link]]]
845test filename-11.17.5 {Tcl_GlobCmd} {
846    list [catch {lsort [glob -directory $globname -tails *.c]} msg] $msg
847} [list 0 [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
848test filename-11.17.6 {Tcl_GlobCmd} {
849    list [catch {lsort [glob -directory $globname -tails *.c *.c]} msg] $msg
850} [list 0 [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
851  [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]]
852test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} {linkDirectory} {
853    set dir [pwd]
854    set ret "error in test"
855    if {[catch {
856        cd $globname
857        file mkdir nonexistent
858        file link -symbolic link nonexistent
859        file delete nonexistent
860        cd $dir
861        set ret [list [catch {
862            lsort [glob -nocomplain -directory $globname -type l *]
863        } msg] $msg]
864    }]} {
865        cd $dir
866    }
867    file delete [file join $globname link]
868    set ret
869} [list 0 [list [file join $globname link]]]
870test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} {symbolicLinkFile} {
871    set dir [pwd]
872    set ret "error in test"
873    if {[catch {
874        cd $globname
875        close [open "nonexistent" w]
876        file link -symbolic link nonexistent
877        file delete nonexistent
878        cd $dir
879        set ret [list [catch {
880            lsort [glob -nocomplain -directory $globname -type l *]
881        } msg] $msg]
882    }]} {
883        cd $dir
884    }
885    file delete [file join $globname link]
886    set ret
887} [list 0 [list [file join $globname link]]]
888test filename-11.18 {Tcl_GlobCmd} {unix} {
889    list [catch {lsort [glob -path $globname/ *]} msg] $msg
890} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
891        [file join $globname a3]\
892        [file join $globname "weird name.c"]\
893        [file join $globname x,z1.c]\
894        [file join $globname x1.c]\
895        [file join $globname y1.c] [file join $globname z1.c]]]]
896test filename-11.18.1 {Tcl_GlobCmd} {win} {
897    list [catch {lsort [glob -path $globname/ *]} msg] $msg
898} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
899        [file join $globname .1]\
900        [file join $globname a3]\
901        [file join $globname "weird name.c"]\
902        [file join $globname x,z1.c]\
903        [file join $globname x1.c]\
904        [file join $globname y1.c] [file join $globname z1.c]]]]
905test filename-11.19 {Tcl_GlobCmd} {unix} {
906    list [catch {lsort [glob -join -path \
907            [string range $globname 0 5] * *]} msg] $msg
908} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
909        [file join $globname a3]\
910        [file join $globname "weird name.c"]\
911        [file join $globname x,z1.c]\
912        [file join $globname x1.c]\
913        [file join $globname y1.c] [file join $globname z1.c]]]]
914test filename-11.19.1 {Tcl_GlobCmd} {win} {
915    list [catch {lsort [glob -join -path \
916            [string range $globname 0 5] * *]} msg] $msg
917} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
918        [file join $globname .1]\
919        [file join $globname a3]\
920        [file join $globname "weird name.c"]\
921        [file join $globname x,z1.c]\
922        [file join $globname x1.c]\
923        [file join $globname y1.c] [file join $globname z1.c]]]]
924test filename-11.20 {Tcl_GlobCmd} {
925    list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
926} [list 0 [lsort [list [file join $globname a1]\
927        [file join $globname a2]\
928        [file join $globname a3]]]]
929test filename-11.21 {Tcl_GlobCmd} {
930    list [catch {lsort [glob -type d -path $globname *]} msg] $msg
931} [list 0 [lsort [list $globname]]]
932
933test filename-11.21.1 {Tcl_GlobCmd} {
934    close [open {[tcl].testremains} w]
935    set res [list [catch {lsort [glob -path {[tcl]} *]} msg] $msg]
936    file delete -force {[tcl].testremains}
937    set res
938} [list 0 {{[tcl].testremains}}]
939
940# Get rid of file/dir if it exists, since it will have
941# been left behind by a previous failed run.
942if {[file exists $horribleglobname]} {
943    file delete -force $horribleglobname
944}
945file rename globTest $horribleglobname
946set globname $horribleglobname
947
948test filename-11.22 {Tcl_GlobCmd} {unix} {
949    list [catch {lsort [glob -dir $globname *]} msg] $msg
950} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
951        [file join $globname a3]\
952        [file join $globname "weird name.c"]\
953        [file join $globname x,z1.c]\
954        [file join $globname x1.c]\
955        [file join $globname y1.c] [file join $globname z1.c]]]]
956test filename-11.22.1 {Tcl_GlobCmd} {win} {
957    list [catch {lsort [glob -dir $globname *]} msg] $msg
958} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
959        [file join $globname .1]\
960        [file join $globname a3]\
961        [file join $globname "weird name.c"]\
962        [file join $globname x,z1.c]\
963        [file join $globname x1.c]\
964        [file join $globname y1.c] [file join $globname z1.c]]]]
965test filename-11.23 {Tcl_GlobCmd} {unix} {
966    list [catch {lsort [glob -path $globname/ *]} msg] $msg
967} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
968        [file join $globname a3]\
969        [file join $globname "weird name.c"]\
970        [file join $globname x,z1.c]\
971        [file join $globname x1.c]\
972        [file join $globname y1.c] [file join $globname z1.c]]]]
973test filename-11.23.1 {Tcl_GlobCmd} {win} {
974    list [catch {lsort [glob -path $globname/ *]} msg] $msg
975} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
976        [file join $globname .1]\
977        [file join $globname a3]\
978        [file join $globname "weird name.c"]\
979        [file join $globname x,z1.c]\
980        [file join $globname x1.c]\
981        [file join $globname y1.c] [file join $globname z1.c]]]]
982test filename-11.24 {Tcl_GlobCmd} {unix} {
983    list [catch {lsort [glob -join -path \
984            [string range $globname 0 5] * *]} msg] $msg
985} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
986        [file join $globname a3]\
987        [file join $globname "weird name.c"]\
988        [file join $globname x,z1.c]\
989        [file join $globname x1.c]\
990        [file join $globname y1.c] [file join $globname z1.c]]]]
991test filename-11.24.1 {Tcl_GlobCmd} {win} {
992    list [catch {lsort [glob -join -path \
993            [string range $globname 0 5] * *]} msg] $msg
994} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
995        [file join $globname .1]\
996        [file join $globname a3]\
997        [file join $globname "weird name.c"]\
998        [file join $globname x,z1.c]\
999        [file join $globname x1.c]\
1000        [file join $globname y1.c] [file join $globname z1.c]]]]
1001test filename-11.25 {Tcl_GlobCmd} {
1002    list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
1003} [list 0 [lsort [list [file join $globname a1]\
1004        [file join $globname a2]\
1005        [file join $globname a3]]]]
1006test filename-11.25.1 {Tcl_GlobCmd} {
1007    list [catch {lsort [glob -type {d r} -dir $globname *]} msg] $msg
1008} [list 0 [lsort [list [file join $globname a1]\
1009  [file join $globname a2]\
1010  [file join $globname a3]]]]
1011test filename-11.25.2 {Tcl_GlobCmd} {
1012    list [catch {lsort [glob -type {d r w} -dir $globname *]} msg] $msg
1013} [list 0 [lsort [list [file join $globname a1]\
1014  [file join $globname a2]\
1015  [file join $globname a3]]]]
1016test filename-11.26 {Tcl_GlobCmd} {
1017    list [catch {glob -type d -path $globname *} msg] $msg
1018} [list 0 [list $globname]]
1019test filename-11.27 {Tcl_GlobCmd} {
1020    list [catch {glob -types abcde *} msg] $msg
1021} {1 {bad argument to "-types": abcde}}
1022test filename-11.28 {Tcl_GlobCmd} {
1023    list [catch {glob -types z *} msg] $msg
1024} {1 {bad argument to "-types": z}}
1025test filename-11.29 {Tcl_GlobCmd} {
1026    list [catch {glob -types {abcd efgh} *} msg] $msg
1027} {1 {only one MacOS type or creator argument to "-types" allowed}}
1028test filename-11.30 {Tcl_GlobCmd} {
1029    list [catch {glob -types {{macintosh type TEXT} \
1030            {macintosh creator ALFA} efgh} *} msg] $msg
1031} {1 {only one MacOS type or creator argument to "-types" allowed}}
1032test filename-11.31 {Tcl_GlobCmd} {
1033    list [catch {glob -types} msg] $msg
1034} {1 {missing argument to "-types"}}
1035test filename-11.32 {Tcl_GlobCmd} {
1036    list [catch {glob -path hello -dir hello *} msg] $msg
1037} {1 {"-directory" cannot be used with "-path"}}
1038test filename-11.33 {Tcl_GlobCmd} {
1039    list [catch {glob -path} msg] $msg
1040} {1 {missing argument to "-path"}}
1041test filename-11.34 {Tcl_GlobCmd} {
1042    list [catch {glob -direct} msg] $msg
1043} {1 {missing argument to "-directory"}}
1044test filename-11.35 {Tcl_GlobCmd} {
1045    list [catch {glob -paths *} msg] $msg
1046} {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
1047# Test '-tails' flag to glob.
1048test filename-11.36 {Tcl_GlobCmd} {
1049    list [catch {glob -tails *} msg] $msg
1050} {1 {"-tails" must be used with either "-directory" or "-path"}}
1051test filename-11.37 {Tcl_GlobCmd} {
1052    list [catch {glob -type d -tails -path $globname *} msg] $msg
1053} [list 0 [list $globname]]
1054test filename-11.38 {Tcl_GlobCmd} {
1055    list [catch {glob -tails -path $globname *} msg] $msg
1056} [list 0 [list $globname]]
1057test filename-11.39 {Tcl_GlobCmd} {
1058    list [catch {glob -tails -join -path $globname *} msg] $msg
1059} [list 0 [list $globname]]
1060test filename-11.40 {Tcl_GlobCmd} {
1061    expr {[glob -dir [pwd] -tails *] == [glob *]}
1062} {1}
1063test filename-11.41 {Tcl_GlobCmd} {
1064    expr {[glob -dir [pwd] -tails *] != [glob -dir [pwd] *]}
1065} {1}
1066test filename-11.42 {Tcl_GlobCmd} {
1067    set res [list]
1068    foreach f [glob -dir [pwd] *] {
1069        lappend res [file tail $f]
1070    }
1071    expr {$res == [glob *]}
1072} {1}
1073test filename-11.43 {Tcl_GlobCmd} {
1074    list [catch {glob -t *} msg] $msg
1075} {1 {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
1076test filename-11.44 {Tcl_GlobCmd} {
1077    list [catch {glob -tails -path hello -directory hello *} msg] $msg
1078} {1 {"-directory" cannot be used with "-path"}}
1079test filename-11.45 {Tcl_GlobCmd on root volume} {
1080    set res1 ""
1081    set res2 ""
1082    catch {
1083        set res1 [glob -dir [lindex [file volumes] 0] -tails *]
1084    }
1085    catch {
1086        set tmpd [pwd]
1087        cd [lindex [file volumes] 0]
1088        set res2 [glob *]
1089        cd $tmpd
1090    }
1091    set res [expr {$res1 == $res2}]
1092    if {!$res} {
1093        lappend res $res1 $res2
1094    }
1095    set res
1096} {1}
1097test filename-11.46 {Tcl_GlobCmd} {
1098    list [catch {glob -types abcde -dir foo *} msg] $msg
1099} {1 {bad argument to "-types": abcde}}
1100test filename-11.47 {Tcl_GlobCmd} {
1101    list [catch {glob -types abcde -path foo *} msg] $msg
1102} {1 {bad argument to "-types": abcde}}
1103test filename-11.48 {Tcl_GlobCmd} {
1104    list [catch {glob -types abcde -dir foo -join * *} msg] $msg
1105} {1 {bad argument to "-types": abcde}}
1106test filename-11.49 {Tcl_GlobCmd} {
1107    list [catch {glob -types abcde -path foo -join * *} msg] $msg
1108} {1 {bad argument to "-types": abcde}}
1109
1110file rename $horribleglobname globTest
1111set globname globTest
1112unset horribleglobname
1113
1114test filename-12.1 {simple globbing} {unixOrPc} {
1115    list [catch {glob {}} msg] $msg
1116} {0 .}
1117test filename-12.1.1 {simple globbing} {unixOrPc} {
1118    list [catch {glob -types f {}} msg] $msg
1119} {1 {no files matched glob pattern ""}}
1120test filename-12.1.2 {simple globbing} {unixOrPc} {
1121    list [catch {glob -types d {}} msg] $msg
1122} {0 .}
1123test filename-12.1.3 {simple globbing} {unix} {
1124    list [catch {glob -types hidden {}} msg] $msg
1125} {0 .}
1126test filename-12.1.4 {simple globbing} {win} {
1127    list [catch {glob -types hidden {}} msg] $msg
1128} {1 {no files matched glob pattern ""}}
1129test filename-12.1.5 {simple globbing} {win} {
1130    list [catch {glob -types hidden c:/} msg] $msg
1131} {1 {no files matched glob pattern "c:/"}}
1132test filename-12.1.6 {simple globbing} {win} {
1133    list [catch {glob c:/} msg] $msg
1134} {0 c:/}
1135test filename-12.3 {simple globbing} {
1136    list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
1137} {0 {}}
1138
1139set globPreResult globTest/
1140set x1 x1.c
1141set y1 y1.c
1142test filename-12.4 {simple globbing} {unixOrPc} {
1143    lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
1144} "$globPreResult$x1 $globPreResult$y1"
1145test filename-12.5 {simple globbing} {
1146    list [catch {glob globTest\\/x1.c} msg] $msg
1147} "0 $globPreResult$x1"
1148test filename-12.6 {simple globbing} {
1149    list [catch {glob globTest\\/\\x1.c} msg] $msg
1150} "0 $globPreResult$x1"
1151test filename-12.7 {globbing at filesystem root} {unix} {
1152    set res1 [glob -nocomplain /*]
1153    set res2 [glob -path / *]
1154    set equal [string equal $res1 $res2]
1155    if {!$equal} {
1156        lappend equal "not equal" $res1 $res2
1157    }
1158    set equal
1159} {1}
1160test filename-12.8 {globbing at filesystem root} {unix} {
1161    set dir [lindex [glob -type d /*] 0]
1162    set first [string range $dir 0 1]
1163    set res1 [glob -nocomplain ${first}*]
1164    set res2 [glob -path $first *]
1165    set equal [string equal $res1 $res2]
1166    if {!$equal} {
1167        lappend equal "not equal" $res1 $res2
1168    }
1169    set equal
1170} {1}
1171test filename-12.9 {globbing at filesystem root} {win} {
1172    # Can't grab just anything from 'file volumes' because we need a dir
1173    # that has subdirs - assume that C:/ exists across Windows machines.
1174    set dir [lindex [glob -type d C:/*] 0]
1175    set first [string range $dir 0 3]
1176    set res1 [glob -nocomplain ${first}*]
1177    set res2 [glob -path $first *]
1178    set equal [string equal $res1 $res2]
1179    if {!$equal} {
1180        lappend equal "not equal" $res1 $res2
1181    }
1182    set equal
1183} {1}
1184
1185test filename-12.10 {globbing with volume relative paths} {win} {
1186    set dir [lindex [glob -type d C:/*] 0]
1187    set pwd [pwd]
1188    cd C:/
1189    set res1 [glob -nocomplain [string range $dir 2 end]]
1190    cd $pwd
1191    set res2 [list $dir]
1192    set equal [string equal $res1 $res2]
1193    if {!$equal} {
1194        lappend equal "not equal" $res1 $res2
1195    }
1196    set equal
1197} {1}
1198
1199test filename-13.1 {globbing with brace substitution} {
1200    list [catch {glob globTest/\{\}} msg] $msg
1201} "0 $globPreResult"
1202test filename-13.2 {globbing with brace substitution} {
1203    list [catch {glob globTest/\{} msg] $msg
1204} {1 {unmatched open-brace in file name}}
1205test filename-13.3 {globbing with brace substitution} {
1206    list [catch {glob globTest/\{\\\}} msg] $msg
1207} {1 {unmatched open-brace in file name}}
1208test filename-13.4 {globbing with brace substitution} {
1209    list [catch {glob globTest/\{\\} msg] $msg
1210} {1 {unmatched open-brace in file name}}
1211test filename-13.5 {globbing with brace substitution} {
1212    list [catch {glob globTest/\}} msg] $msg
1213} {1 {unmatched close-brace in file name}}
1214test filename-13.6 {globbing with brace substitution} {
1215    list [catch {glob globTest/\{\}x1.c} msg] $msg
1216} "0 $globPreResult$x1"
1217test filename-13.7 {globbing with brace substitution} {
1218    list [catch {glob globTest/\{x\}1.c} msg] $msg
1219} "0 $globPreResult$x1"
1220test filename-13.8 {globbing with brace substitution} {
1221    list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg
1222} "0 $globPreResult$x1"
1223test filename-13.9 {globbing with brace substitution} {
1224    list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg
1225} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
1226test filename-13.10 {globbing with brace substitution} {
1227    list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
1228} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
1229test filename-13.11 {globbing with brace substitution} {unixOrPc} {
1230    list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
1231} {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
1232test filename-13.13 {globbing with brace substitution} {
1233    lsort [glob globTest/{a,b,x,y}1.c]
1234} [list $globPreResult$x1 $globPreResult$y1]
1235test filename-13.14 {globbing with brace substitution} {unixOrPc} {
1236    lsort [glob {globTest/{x1,y2,weird name}.c}]
1237} {{globTest/weird name.c} globTest/x1.c}
1238test filename-13.16 {globbing with brace substitution} {unixOrPc} {
1239    lsort [glob globTest/{x1.c,a1/*}]
1240} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
1241test filename-13.18 {globbing with brace substitution} {unixOrPc} {
1242    lsort [glob globTest/{x1.c,{a},a1/*}]
1243} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
1244test filename-13.20 {globbing with brace substitution} {unixOrPc} {
1245    lsort [glob globTest/{a,x}1/*/{x,y}*]
1246} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
1247test filename-13.22 {globbing with brace substitution} {
1248    list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
1249} {1 {unmatched open-brace in file name}}
1250
1251test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
1252    lsort [glob glo*/*.c]
1253} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
1254test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
1255    lsort [glob globTest/?1.c]
1256} {globTest/x1.c globTest/y1.c globTest/z1.c}
1257
1258# The current directory could be anywhere; do this to stop spurious matches
1259file mkdir globTestContext
1260file rename globTest [file join globTestContext globTest]
1261set savepwd [pwd]
1262cd globTestContext
1263
1264test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} {
1265    lsort [glob */*/*/*.c]
1266} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
1267
1268# Reset to where we were
1269cd $savepwd
1270file rename [file join globTestContext globTest] globTest
1271file delete globTestContext
1272
1273test filename-14.7 {asterisks, question marks, and brackets} {unix} {
1274    lsort [glob globTest/*]
1275} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
1276test filename-14.7.1 {asterisks, question marks, and brackets} {win} {
1277    lsort [glob globTest/*]
1278} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
1279test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} {
1280    lsort [glob globTest/.*]
1281} {globTest/. globTest/.. globTest/.1}
1282test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} {
1283    lsort [glob globTest/*/*]
1284} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
1285test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} {
1286    lsort [glob {globTest/[xyab]1.*}]
1287} {globTest/x1.c globTest/y1.c}
1288test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} {
1289    lsort [glob globTest/*/]
1290} {globTest/a1/ globTest/a2/ globTest/a3/}
1291test filename-14.17 {asterisks, question marks, and brackets} {
1292    global env
1293    set temp $env(HOME)
1294    set env(HOME) [file join $env(HOME) globTest]
1295    set result [list [catch {glob ~/z*} msg] $msg]
1296    set env(HOME) $temp
1297    set result
1298} [list 0 [list [file join $env(HOME) globTest z1.c]]]
1299test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} {
1300    list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
1301} {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
1302test filename-14.20 {asterisks, question marks, and brackets} {
1303    list [catch {glob -nocomplain goo/*} msg] $msg
1304} {0 {}}
1305test filename-14.21 {asterisks, question marks, and brackets} {
1306    list [catch {glob globTest/*/gorp} msg] $msg
1307} {1 {no files matched glob pattern "globTest/*/gorp"}}
1308test filename-14.22 {asterisks, question marks, and brackets} {
1309    list [catch {glob goo/* x*z foo?q} msg] $msg
1310} {1 {no files matched glob patterns "goo/* x*z foo?q"}}
1311test filename-14.23 {slash globbing} {unix} {
1312    glob /
1313} /
1314test filename-14.23.2 {slash globbing} {win} {
1315    glob /
1316} [file norm /]
1317test filename-14.24 {slash globbing} {win} {
1318    glob {\\}
1319} [file norm /]
1320test filename-14.25 {type specific globbing} {unix} {
1321    list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
1322} [list 0 [lsort [list \
1323        [file join $globname "weird name.c"]\
1324        [file join $globname x,z1.c]\
1325        [file join $globname x1.c]\
1326        [file join $globname y1.c] [file join $globname z1.c]]]]
1327test filename-14.25.1 {type specific globbing} {win} {
1328    list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
1329} [list 0 [lsort [list \
1330        [file join $globname .1]\
1331        [file join $globname "weird name.c"]\
1332        [file join $globname x,z1.c]\
1333        [file join $globname x1.c]\
1334        [file join $globname y1.c] [file join $globname z1.c]]]]
1335test filename-14.26 {type specific globbing} {
1336    list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg
1337} [list 0 {}]
1338
1339unset globname
1340
1341# The following tests are only valid for Unix systems.
1342# On some systems, like AFS, "000" protection doesn't prevent
1343# access by owner, so the following test is not portable.
1344
1345catch {file attributes globTest/a1 -permissions 0000}
1346test filename-15.1 {unix specific globbing} {unix nonPortable} {
1347    string tolower [list [catch {glob globTest/a1/*} msg]  $msg $errorCode]
1348} {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
1349test filename-15.2 {unix specific no complain: no errors} {unix nonPortable} {
1350    glob -nocomplain globTest/a1/*
1351} {}
1352test filename-15.3 {unix specific no complain: no errors, good result} \
1353        {unix nonPortable} {
1354    # test fails because if an error occur , the interp's result
1355    # is reset...
1356    glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
1357} {globTest/a2 globTest/a3}
1358
1359catch {file attributes globTest/a1 -permissions 0755}
1360test filename-15.4 {unix specific no complain: no errors, good result} \
1361        {unix nonPortable} {
1362    # test fails because if an error occurs, the interp's result
1363    # is reset... or you don't run at scriptics where the
1364    # outser and welch users exists
1365    glob -nocomplain ~ouster ~foo ~welch
1366} {/home/ouster /home/welch}
1367test filename-15.4.1 {no complain: errors, sequencing} {
1368    # test used to fail because if an error occurs, the interp's result
1369    # is reset... But, the sequence means we throw a different error
1370    # first.
1371    concat \
1372      [list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1] \
1373      [list [catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2]
1374} {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}}
1375test filename-15.4.2 {no complain: errors, sequencing} {
1376    # test used to fail because if an error occurs, the interp's result
1377    # is reset...
1378    string equal \
1379      [list [catch {glob -nocomplain ~wontexist *} res1] $res1] \
1380      [list [catch {glob -nocomplain * ~wontexist} res2] $res2]
1381} {1}
1382test filename-15.5 {unix specific globbing} {unix nonPortable} {
1383    glob ~ouster/.csh*
1384} "/home/ouster/.cshrc"
1385catch {close [open globTest/odd\\\[\]*?\{\}name w]}
1386test filename-15.6 {unix specific globbing} {unix} {
1387    global env
1388    set temp $env(HOME)
1389    set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
1390    set result [list [catch {glob ~} msg] $msg]
1391    set env(HOME) $temp
1392    set result
1393} [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]]
1394catch {file delete -force globTest/odd\\\[\]*?\{\}name}
1395test filename-15.7 {win specific globbing} {win} {
1396    if {[string index [glob ~] end] == "/"} {
1397        set res "glob ~ is [glob ~] but shouldn't end in a separator"
1398    } else {
1399        set res "ok"
1400    }
1401} {ok}
1402test filename-15.8 {win and unix specific globbing} {unixOrWin} {
1403    global env
1404    set temp $env(HOME)
1405    catch {close [open $env(HOME)/globTest/anyname w]} err
1406    set env(HOME) $env(HOME)/globTest/anyname
1407    set result [list [catch {glob ~} msg] $msg]
1408    set env(HOME) $temp
1409    catch {file delete -force $env(HOME)/globTest/anyname}
1410    set result
1411} [list 0 [list [lindex [glob ~] 0]/globTest/anyname]]
1412
1413# The following tests are only valid for Windows systems.
1414set oldDir [pwd]
1415if {[testConstraint win]} {
1416    cd c:/
1417    file delete -force globTest
1418    file mkdir globTest
1419    close [open globTest/x1.BAT w]
1420    close [open globTest/y1.Bat w]
1421    close [open globTest/z1.bat w]
1422}
1423
1424test filename-16.1 {windows specific globbing} {win} {
1425    lsort [glob globTest/*.bat]
1426} {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
1427test filename-16.2 {windows specific globbing} {win} {
1428    list [catch {glob c:} res] $res
1429} {0 c:}
1430test filename-16.2.1 {windows specific globbing} {win} {
1431    set dir [pwd]
1432    cd C:/
1433    set res [list [catch {glob c:} err] $err]
1434    cd $dir
1435    set res
1436} {0 c:}
1437test filename-16.3 {windows specific globbing} {win} {
1438    glob -nocomplain c:\\\\
1439} c:/
1440test filename-16.4 {windows specific globbing} {win} {
1441    glob -nocomplain c:/
1442} c:/
1443test filename-16.5 {windows specific globbing} {win} {
1444    glob -nocomplain c:*bTest
1445} c:globTest
1446test filename-16.6 {windows specific globbing} {win} {
1447    glob -nocomplain c:\\\\*bTest
1448} c:/globTest
1449test filename-16.7 {windows specific globbing} {win} {
1450    glob -nocomplain c:/*bTest
1451} c:/globTest
1452test filename-16.8 {windows specific globbing} {win} {
1453    lsort [glob -nocomplain c:globTest/*.bat]
1454} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
1455test filename-16.9 {windows specific globbing} {win} {
1456    lsort [glob -nocomplain c:/globTest/*.bat]
1457} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
1458test filename-16.10 {windows specific globbing} {win} {
1459    lsort [glob -nocomplain c:globTest\\\\*.bat]
1460} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
1461test filename-16.11 {windows specific globbing} {win} {
1462    lsort [glob -nocomplain c:\\\\globTest\\\\*.bat]
1463} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
1464
1465# some tests require a shared C drive
1466
1467if {[testConstraint win]} {
1468    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
1469}
1470
1471test filename-16.12 {windows specific globbing} {win sharedCdrive} {
1472    cd //[info hostname]/c
1473    glob //[info hostname]/c/*Test
1474} //[info hostname]/c/globTest
1475test filename-16.13 {windows specific globbing} {win sharedCdrive} {
1476    cd //[info hostname]/c
1477    glob "\\\\\\\\[info hostname]\\\\c\\\\*Test"
1478} //[info hostname]/c/globTest
1479test filename-16.14 {windows specific globbing} {win} {
1480    cd [lindex [glob -types d -dir C:/ *] 0]
1481    expr {[lsearch -exact [glob {{.,*}*}] ".."] != -1}
1482} {1}
1483test filename-16.15 {windows specific globbing} {win} {
1484    cd [lindex [glob -types d -dir C:/ *] 0]
1485    glob ..
1486} {..}
1487test filename-16.16 {windows specific globbing} {win} {
1488    file tail [lindex [glob -nocomplain "[lindex [glob -types d -dir C:/ *] 0]/.."] 0]
1489} {..}
1490test filename-16.17 {windows specific globbing} {win} {
1491    cd C:/
1492    # Ensure correct trimming of tails with absolute and
1493    # volume relative globbing.
1494    set res1 [glob -nocomplain -tails -dir C:/ *]
1495    set res2 [glob -nocomplain -tails -dir C: *]
1496    if {$res1 eq $res2} {
1497        concat ok
1498    } else {
1499        concat $res1 ne $res2
1500    }
1501} {ok}
1502
1503test filename-17.1 {windows specific special files} {testsetplatform} {
1504    testsetplatform win
1505    list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \
1506      [file pathtype prn] [file pathtype nul] [file pathtype aux] \
1507      [file pathtype foo]
1508} {absolute absolute absolute absolute absolute absolute relative}
1509if {[testConstraint testsetplatform]} {
1510    testsetplatform $platform
1511}
1512
1513test filename-17.2 {windows specific glob with executable} {win} {
1514    makeDirectory execglob
1515    makeFile contents execglob/abc.exe
1516    makeFile contents execglob/abc.notexecutable
1517    set res [glob -nocomplain -dir [temporaryDirectory]/execglob \
1518      -tails -types x *]
1519    removeFile execglob/abc.exe
1520    removeFile execglob/abc.notexecutable
1521    removeDirectory execglob
1522    set res
1523} {abc.exe}
1524
1525test fileName-18.1 {windows - split ADS name correctly} {win} {
1526    # bug 1194458
1527    set x [file split c:/c:d]
1528    set y [eval [linsert $x 0 file join]]
1529    list $x $y
1530} {{c:/ ./c:d} c:/c:d}
1531
1532test fileName-19.1 {ensure that [Bug 1325099] stays fixed} {
1533    # Any non-crashing result is OK
1534    list [file exists ~//.nonexistant_file] [file exists ~///.nonexistant_file]
1535} {0 0}
1536
1537# cleanup
1538catch {file delete -force C:/globTest}
1539cd [temporaryDirectory]
1540file delete -force globTest
1541cd $oldpwd
1542set env(HOME) $oldhome
1543if {[testConstraint testsetplatform]} {
1544    testsetplatform $platform
1545    catch {unset platform}
1546}
1547catch {unset oldhome temp result globPreResult}
1548::tcltest::cleanupTests
1549return
Note: See TracBrowser for help on using the repository browser.