Lines of
example/main.tcl
from check-in e786b9e07b
that are changed by the sequence of edits moving toward
check-in 3d002d6892:
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-basic-limited "Xvfs Glob Match Limited Test" -body {
163: llength [glob_verify f*]
164: } -result 1
165:
166: tcltest::test xvfs-glob-basic-limited-neg "Xvfs Glob Match Limited Negative Test" -body {
167: llength [glob_verify x*]
168: } -result 0
169:
170: tcltest::test xvfs-glob-basic-limited-prefixed "Xvfs Glob Match Limited But With Directory Prefix Test" -body {
171: llength [glob_verify ./f*]
172: } -result 1
173:
174: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed "Xvfs Glob Match Limited Path and Type Positive Test" -body {
175: llength [glob_verify -type f ./f*]
176: } -result 1
177:
178: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed-neg "Xvfs Glob Match Limited Path and Type Negative Test" -body {
179: llength [glob_verify -type d ./f*]
180: } -result 0
181:
182: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
183: llength [glob_verify lib/*]
184: } -result 1
185:
186: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
187: lindex [glob_verify lib/*] 0
188: } -match glob -result "$rootDir/*"
189:
190: tcltest::test xvfs-access-basic-read "Xvfs acccess Read Basic Test" -body {
191: file readable $testFile
192: } -match boolean -result true
193:
194: tcltest::test xvfs-access-basic-write "Xvfs acccess Write Basic Test" -body {
195: file writable $testFile
196: } -match boolean -result false
197:
198: tcltest::test xvfs-access-basic-neg "Xvfs acccess Basic Negative Test" -body {
199: file executable $testFile
200: } -match boolean -result false
201:
202: tcltest::test xvfs-exists-basic-neg "Xvfs exists Basic Negative Test" -body {
203: file exists $rootDir/does-not-exist
204: } -match boolean -result false
205:
206: tcltest::test xvfs-stat-basic-file "Xvfs stat Basic File Test" -body {
207: file stat $testFile fileInfo
208: set fileInfo(type)
209: } -cleanup {
210: unset -nocomplain fileInfo
211: } -result file
212:
213: tcltest::test xvfs-stat-basic-file-neg "Xvfs stat Basic File Negative Test" -body {
214: file stat $rootDir/does-not-exist fileInfo
215: } -cleanup {
216: unset -nocomplain fileInfo
217: } -match glob -returnCodes error -result "*no such file or directory"
218:
219: tcltest::test xvfs-stat-basic-dir "Xvfs stat Basic Directory Test" -body {
220: file stat $rootDir/lib fileInfo
221: set fileInfo(type)
222: } -cleanup {
223: unset -nocomplain fileInfo
224: } -result directory
225:
226: # Broken in Tcl 8.6 and earlier
227: tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
228: llength [glob //xvfs:/example/*]
229: } -constraints tcl87 -result 3
230:
231: tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
232: lindex [glob -directory [file dirname $testFile] *] 0
233: } -constraints tcl87 -match glob -result "$rootDir/*"
234:
235: tcltest::test xvfs-cwd-1 "Xvfs Can Be cwd" -setup {
236: set startDir [pwd]
237: } -body {
238: cd $rootDir
239: pwd
240: } -cleanup {
241: cd $startDir
242: unset startDir
243: } -constraints tcl87 -result $rootDir
244:
245: tcltest::test xvfs-cwd-2 "Xvfs Can Be cwd" -setup {
246: set startDir [pwd]
247: } -body {
248: cd $rootDir
249: cd lib
250: lindex [glob *] 0
251: } -cleanup {
252: cd $startDir
253: unset startDir
254: } -constraints tcl87 -result "hello"
255:
256: # Currently broken
257: tcltest::test xvfs-package "Xvfs Can Be Package Directory" -setup {
258: set startAutoPath $auto_path
259: lappend auto_path ${rootDir}/lib
260: } -body {
261: package require hello
262: set auto_path
263: } -cleanup {
264: set auto_path $startAutoPath
265: unset startAutoPath
266: } -constraints knownBug -result ""
267:
268: # Output results
269: if {$::tcltest::numTests(Failed) != 0} {
270: set format "| %20s | %20s | %20s | %20s |"
271: puts [string repeat - [string length [format $format - - - -]]]
272: puts [format $format "Passed" "Failed" "Skipped" "Total"]
273: puts [format $format \
274: $::tcltest::numTests(Passed) \
275: $::tcltest::numTests(Failed) \
276: $::tcltest::numTests(Skipped) \
277: $::tcltest::numTests(Total) \
278: ]
279: puts [string repeat - [string length [format $format - - - -]]]
280:
281: if {[info exists ::env(XVFS_TEST_EXIT_ON_FAILURE)]} {
282: exit $::env(XVFS_TEST_EXIT_ON_FAILURE)
283: }
284: exit 1
285: }
286:
287: puts "ALL TESTS PASSED"
288:
289: if {[info exists ::env(XVFS_TEST_EXIT_ON_SUCCESS)]} {
290: exit $::env(XVFS_TEST_EXIT_ON_SUCCESS)
291: }
292: exit 0