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