Lines of
example/main.tcl
from check-in 3d002d6892
that are changed by the sequence of edits moving toward
check-in e6735bc1dd:
1: #! /usr/bin/env tclsh
2:
3: package require tcltest
4:
5: tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]]
6:
7: tcltest::configure -verbose pbse
8: tcltest::configure {*}$argv
9:
10: set rootDir "//xvfs:/example"
11: set rootDirNative [file join [pwd] example]
12: #set rootDir $rootDirNative
13: set testFile "${rootDir}/foo"
14:
15: proc glob_verify {args} {
16: set rv [glob -nocomplain -directory $::rootDir {*}$args]
17: set verify [glob -nocomplain -directory $::rootDirNative {*}$args]
18:
19: if {[llength $rv] != [llength $verify]} {
20: error "VERIFY FAILED: glob ... $args ($rv versus $verify)"
21: }
22:
23: return $rv
24: }
25:
26: tcltest::customMatch boolean [list apply {{expected actual} {
27: if {!!$expected == !!$actual} {
28: return true
29: } else {
30: return false
31: }
32: }}]
33:
34: tcltest::test xvfs-seek-basic "Xvfs Seek Test" -setup {
35: set fd [open $testFile]
36: } -body {
37: seek $fd 0 end
38: seek $fd -1 current
39:
40: read $fd 1
41: } -cleanup {
42: close $fd
43: unset fd
44: } -result "\n"
45:
46: tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup {
47: set fd [open $testFile]
48: } -body {
49: seek $fd 1 end
50: } -cleanup {
51: close $fd
52: unset fd
53: } -match glob -returnCodes error -result "*: invalid argument"
54:
55: tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup {
56: set fd [open $testFile]
57: } -body {
58: seek $fd -10 current
59: } -cleanup {
60: close $fd
61: unset fd
62: } -match glob -returnCodes error -result "*: invalid argument"
63:
64: tcltest::test xvfs-seek-read-past-eof "Xvfs Seek Then Read Past EOF Test" -setup {
65: set fd [open $testFile]
66: } -body {
67: seek $fd 0 end
68:
69: read $fd 1
70: read $fd 1
71: } -cleanup {
72: close $fd
73: unset fd
74: } -result ""
75:
76: tcltest::test xvfs-basic-open-neg "Xvfs Open Non-Existant File Test" -body {
77: unset -nocomplain fd
78: set fd [open $rootDir/does-not-exist]
79: } -cleanup {
80: if {[info exists fd]} {
81: close $fd
82: unset fd
83: }
84: } -returnCodes error -result "no such file or directory"
85:
86: tcltest::test xvfs-basic-open-write "Xvfs Open For Writing Test" -body {
87: unset -nocomplain fd
88: set fd [open $rootDir/new-file w]
89: } -cleanup {
90: if {[info exists fd]} {
91: close $fd
92: unset fd
93: }
94: catch {
95: file delete $rootDir/new-file
96: }
97: } -match glob -returnCodes error -result "*read*only file*system*"
98:
99: tcltest::test xvfs-basic-open-directory "Xvfs Open Directory Test" -body {
100: unset -nocomplain fd
101: set fd [open $rootDir/lib]
102: set fd
103: } -cleanup {
104: if {[info exists fd]} {
105: close $fd
106: unset fd
107: }
108: } -match glob -returnCodes error -result "*illegal operation on a directory"
109:
110: tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup {
111: set fd1 [open $testFile]
112: set fd2 [open $testFile]
113: } -body {
114: set data1 [read $fd1]
115: close $fd1
116: set data2 [read $fd2]
117: close $fd2
118:
119: expr {$data1 eq $data2}
120: } -cleanup {
121: unset -nocomplain fd1 fd2 data1 data2
122: } -match boolean -result true
123:
124: tcltest::test xvfs-events "Xvfs Fileevent Test" -setup {
125: set fd [open $testFile]
126: seek $fd 0 end
127: set size [tell $fd]
128: seek $fd 0 start
129:
130: set done false
131: set calls 0
132: set output ""
133: } -body {
134: fileevent $fd readable [list apply {{fd} {
135: set pos [tell $fd]
136: set x [read $fd 1]
137: if {[string length $x] == 0} {
138: set ::done true
139: fileevent $fd readable ""
140: }
141:
142: lappend ::output $pos
143: incr ::calls
144: }} $fd]
145: vwait done
146:
147: list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
148: } -cleanup {
149: close $fd
150: update
151: unset -nocomplain fd size done calls output
152: } -result {1 1}
153:
154: tcltest::test xvfs-match-almost-root-neg "Xvfs Match Almost Root" -body {
155: file exists ${rootDir}_DOES_NOT_EXIST
156: } -match boolean -result false
157:
158: tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body {
159: llength [glob_verify *]
160: } -result 3
161:
162: tcltest::test xvfs-glob-files-any "Xvfs Glob Match Any File Test" -body {
163: llength [glob_verify -type f *]
164: } -result 2
165:
166: tcltest::test xvfs-glob-dir-any "Xvfs Glob On a File Test" -body {
167: glob -nocomplain -directory $testFile *
168: } -returnCodes error -result "not a directory"
169:
170: tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body {
171: llength [glob_verify f*]
172: } -result 1
173:
174: tcltest::test xvfs-glob-basic-limited-neg "Xvfs Glob Match Limited Negative Test" -body {
175: llength [glob_verify x*]
176: } -result 0
177:
178: tcltest::test xvfs-glob-basic-limited-prefixed "Xvfs Glob Match Limited But With Directory Prefix Test" -body {
179: llength [glob_verify ./f*]
180: } -result 1
181:
182: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed "Xvfs Glob Match Limited Path and Type Positive Test" -body {
183: llength [glob_verify -type f ./f*]
184: } -result 1
185:
186: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed-neg "Xvfs Glob Match Limited Path and Type Negative Test" -body {
187: llength [glob_verify -type d ./f*]
188: } -result 0
189:
190: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
191: llength [glob_verify lib/*]
192: } -result 1
193:
194: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
195: lindex [glob_verify lib/*] 0
196: } -match glob -result "$rootDir/*"
197:
198: tcltest::test xvfs-glob-no-dir "Xvfs Glob Non-Existant Directory Test" -body {
199: glob_verify libx/*
200: } -returnCodes error -result "no such file or directory"
201:
202: tcltest::test xvfs-glob-pipes "Xvfs Glob Pipes Test " -body {
203: glob_verify -types {p b c s l} lib/*
204: } -result ""
205:
206: tcltest::test xvfs-glob-writable "Xvfs Glob Writable Test " -body {
207: glob -nocomplain -directory $rootDir -types w *
208: } -result ""
209:
210: tcltest::test xvfs-glob-hidden "Xvfs Glob Hidden Test " -body {
211: glob -nocomplain -directory $rootDir -types hidden *
212: } -result ""
213:
214: tcltest::test xvfs-glob-executable "Xvfs Glob Executable Test " -body {
215: glob -nocomplain -directory $rootDir -types x *
216: } -result $rootDir/lib
217:
218: tcltest::test xvfs-access-basic-read "Xvfs acccess Read Basic Test" -body {
219: file readable $testFile
220: } -match boolean -result true
221:
222: tcltest::test xvfs-access-basic-write "Xvfs acccess Write Basic Test" -body {
223: file writable $testFile
224: } -match boolean -result false
225:
226: tcltest::test xvfs-access-basic-neg "Xvfs acccess Basic Negative Test" -body {
227: file executable $testFile
228: } -match boolean -result false
229:
230: tcltest::test xvfs-access-similar-neg "Xvfs acccess Similar Negative Test" -body {
231: file executable ${rootDir}_DOES_NOT_EXIST
232: } -match boolean -result false
233:
234: tcltest::test xvfs-exists-basic-neg "Xvfs exists Basic Negative Test" -body {
235: file exists $rootDir/does-not-exist
236: } -match boolean -result false
237:
238: tcltest::test xvfs-stat-basic-file "Xvfs stat Basic File Test" -body {
239: file stat $testFile fileInfo
240: set fileInfo(type)
241: } -cleanup {
242: unset -nocomplain fileInfo
243: } -result file
244:
245: tcltest::test xvfs-stat-basic-file-neg "Xvfs stat Basic File Negative Test" -body {
246: file stat $rootDir/does-not-exist fileInfo
247: } -cleanup {
248: unset -nocomplain fileInfo
249: } -match glob -returnCodes error -result "*no such file or directory"
250:
251: tcltest::test xvfs-stat-basic-dir "Xvfs stat Basic Directory Test" -body {
252: file stat $rootDir/lib fileInfo
253: set fileInfo(type)
254: } -cleanup {
255: unset -nocomplain fileInfo
256: } -result directory
257:
258: # Broken in Tcl 8.6 and earlier
259: tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
260: llength [glob //xvfs:/example/*]
261: } -constraints tcl87 -result 3
262:
263: tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
264: lindex [glob -directory [file dirname $testFile] *] 0
265: } -constraints tcl87 -match glob -result "$rootDir/*"
266:
267: tcltest::test xvfs-cwd-1 "Xvfs Can Be cwd" -setup {
268: set startDir [pwd]
269: } -body {
270: cd $rootDir
271: pwd
272: } -cleanup {
273: cd $startDir
274: unset startDir
275: } -constraints tcl87 -result $rootDir
276:
277: tcltest::test xvfs-cwd-2 "Xvfs Can Be cwd" -setup {
278: set startDir [pwd]
279: } -body {
280: cd $rootDir
281: cd lib
282: lindex [glob *] 0
283: } -cleanup {
284: cd $startDir
285: unset startDir
286: } -constraints tcl87 -result "hello"
287:
288: # Currently broken
289: tcltest::test xvfs-package "Xvfs Can Be Package Directory" -setup {
290: set startAutoPath $auto_path
291: lappend auto_path ${rootDir}/lib
292: } -body {
293: package require hello
294: set auto_path
295: } -cleanup {
296: set auto_path $startAutoPath
297: unset startAutoPath
298: } -constraints knownBug -result ""
299:
300: # Output results
301: if {$::tcltest::numTests(Failed) != 0} {
3d002d6892 2019-09-16 302: set format "| %20s | %20s | %20s | %20s |"
3d002d6892 2019-09-16 303: puts [string repeat - [string length [format $format - - - -]]]
3d002d6892 2019-09-16 304: puts [format $format "Passed" "Failed" "Skipped" "Total"]
3d002d6892 2019-09-16 305: puts [format $format \
3d002d6892 2019-09-16 306: $::tcltest::numTests(Passed) \
3d002d6892 2019-09-16 307: $::tcltest::numTests(Failed) \
3d002d6892 2019-09-16 308: $::tcltest::numTests(Skipped) \
3d002d6892 2019-09-16 309: $::tcltest::numTests(Total) \
3d002d6892 2019-09-16 310: ]
3d002d6892 2019-09-16 311: puts [string repeat - [string length [format $format - - - -]]]
3d002d6892 2019-09-16 312:
313: if {[info exists ::env(XVFS_TEST_EXIT_ON_FAILURE)]} {
314: exit $::env(XVFS_TEST_EXIT_ON_FAILURE)
315: }
316: exit 1
317: }
318:
319: puts "ALL TESTS PASSED"
320:
321: if {[info exists ::env(XVFS_TEST_EXIT_ON_SUCCESS)]} {
322: exit $::env(XVFS_TEST_EXIT_ON_SUCCESS)
323: }
324: exit 0