Lines of
example/main.tcl
from check-in 10f67b2ced
that are changed by the sequence of edits moving toward
check-in e786b9e07b:
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:
10f67b2ced 2019-09-16 76: tcltest::test xvfs-basic-open-write "Xvfs Open For Writing Test" -setup {
10f67b2ced 2019-09-16 77: unset -nocomplain fd
10f67b2ced 2019-09-16 78: } -body {
10f67b2ced 2019-09-16 79: set fd [open $rootDir/new-file w]
10f67b2ced 2019-09-16 80: close $fd
81: } -cleanup {
82: if {[info exists fd]} {
83: close $fd
84: unset fd
85: }
86: catch {
87: file delete $rootDir/new-file
88: }
89: } -match glob -returnCodes error -result "*read*only file*system*"
90:
91: tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup {
92: set fd1 [open $testFile]
93: set fd2 [open $testFile]
94: } -body {
95: set data1 [read $fd1]
96: close $fd1
97: set data2 [read $fd2]
98: close $fd2
99:
100: expr {$data1 eq $data2}
101: } -cleanup {
102: unset -nocomplain fd1 fd2 data1 data2
103: } -match boolean -result true
104:
105: tcltest::test xvfs-events "Xvfs Fileevent Test" -setup {
106: set fd [open $testFile]
107: seek $fd 0 end
108: set size [tell $fd]
109: seek $fd 0 start
110:
111: set done false
112: set calls 0
113: set output ""
114: } -body {
115: fileevent $fd readable [list apply {{fd} {
116: set pos [tell $fd]
117: set x [read $fd 1]
118: if {[string length $x] == 0} {
119: set ::done true
120: fileevent $fd readable ""
121: }
122:
123: lappend ::output $pos
124: incr ::calls
125: }} $fd]
126: vwait done
127:
128: list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
129: } -cleanup {
130: close $fd
131: update
132: unset -nocomplain fd size done calls output
133: } -result {1 1}
134:
135: tcltest::test xvfs-match-almost-root-neg "Xvfs Match Almost Root" -body {
136: file exists ${rootDir}_DOES_NOT_EXIST
137: } -match boolean -result false
138:
139: tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body {
140: llength [glob_verify *]
141: } -result 3
142:
143: tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body {
144: llength [glob_verify f*]
145: } -result 1
146:
147: tcltest::test xvfs-glob-basic-limited-neg "Xvfs Glob Match Limited Negative Test" -body {
148: llength [glob_verify x*]
149: } -result 0
150:
151: tcltest::test xvfs-glob-basic-limited-prefixed "Xvfs Glob Match Limited But With Directory Prefix Test" -body {
152: llength [glob_verify ./f*]
153: } -result 1
154:
155: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed "Xvfs Glob Match Limited Path and Type Positive Test" -body {
156: llength [glob_verify -type f ./f*]
157: } -result 1
158:
159: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed-neg "Xvfs Glob Match Limited Path and Type Negative Test" -body {
160: llength [glob_verify -type d ./f*]
161: } -result 0
162:
163: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
164: llength [glob_verify lib/*]
165: } -result 1
166:
167: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
168: lindex [glob_verify lib/*] 0
169: } -match glob -result "$rootDir/*"
170:
171: tcltest::test xvfs-access-basic-read "Xvfs acccess Read Basic Test" -body {
172: file readable $testFile
173: } -match boolean -result true
174:
175: tcltest::test xvfs-access-basic-write "Xvfs acccess Write Basic Test" -body {
176: file writable $testFile
177: } -match boolean -result false
178:
179: tcltest::test xvfs-access-basic-neg "Xvfs acccess Basic Negative Test" -body {
180: file executable $testFile
181: } -match boolean -result false
182:
183: tcltest::test xvfs-exists-basic-neg "Xvfs exists Basic Negative Test" -body {
184: file exists $rootDir/does-not-exist
185: } -match boolean -result false
186:
187: tcltest::test xvfs-stat-basic-file "Xvfs stat Basic File Test" -body {
188: file stat $testFile fileInfo
189: set fileInfo(type)
190: } -cleanup {
191: unset -nocomplain fileInfo
192: } -result file
193:
194: tcltest::test xvfs-stat-basic-dir "Xvfs stat Basic Directory Test" -body {
195: file stat $rootDir/lib fileInfo
196: set fileInfo(type)
197: } -cleanup {
198: unset -nocomplain fileInfo
199: } -result directory
200:
201: # Broken in Tcl 8.6 and earlier
202: tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
203: llength [glob //xvfs:/example/*]
204: } -constraints tcl87 -result 3
205:
206: tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
207: lindex [glob -directory [file dirname $testFile] *] 0
208: } -constraints tcl87 -match glob -result "$rootDir/*"
209:
210: tcltest::test xvfs-cwd-1 "Xvfs Can Be cwd" -setup {
211: set startDir [pwd]
212: } -body {
213: cd $rootDir
214: pwd
215: } -cleanup {
216: cd $startDir
217: unset startDir
218: } -constraints tcl87 -result $rootDir
219:
220: tcltest::test xvfs-cwd-2 "Xvfs Can Be cwd" -setup {
221: set startDir [pwd]
222: } -body {
223: cd $rootDir
224: cd lib
225: lindex [glob *] 0
226: } -cleanup {
227: cd $startDir
228: unset startDir
229: } -constraints tcl87 -result "hello"
230:
231: # Currently broken
232: tcltest::test xvfs-package "Xvfs Can Be Package Directory" -setup {
233: set startAutoPath $auto_path
234: lappend auto_path ${rootDir}/lib
235: } -body {
236: package require hello
237: set auto_path
238: } -cleanup {
239: set auto_path $startAutoPath
240: unset startAutoPath
241: } -constraints knownBug -result ""
242:
243: # Output results
244: if {$::tcltest::numTests(Failed) != 0} {
245: set format "| %20s | %20s | %20s | %20s |"
246: puts [string repeat - [string length [format $format - - - -]]]
247: puts [format $format "Passed" "Failed" "Skipped" "Total"]
248: puts [format $format \
249: $::tcltest::numTests(Passed) \
250: $::tcltest::numTests(Failed) \
251: $::tcltest::numTests(Skipped) \
252: $::tcltest::numTests(Total) \
253: ]
254: puts [string repeat - [string length [format $format - - - -]]]
255:
256: if {[info exists ::env(XVFS_TEST_EXIT_ON_FAILURE)]} {
257: exit $::env(XVFS_TEST_EXIT_ON_FAILURE)
258: }
259: exit 1
260: }
261:
262: puts "ALL TESTS PASSED"
263:
264: if {[info exists ::env(XVFS_TEST_EXIT_ON_SUCCESS)]} {
265: exit $::env(XVFS_TEST_EXIT_ON_SUCCESS)
266: }
267: exit 0