1
2
3
4
5
6
7
8
9
10
11
|
1
2
3
4
5
6
7
8
9
10
11
12
13
|
+
+
|
#! /usr/bin/env tclsh
package require tcltest
tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]]
tcltest::configure -verbose pbse
tcltest::configure {*}$argv
set rootDir "//xvfs:/example"
set rootDirNative [file join [pwd] example]
#set rootDir $rootDirNative
set testFile "${rootDir}/foo"
|
| ︙ | | |
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
if {!!$expected == !!$actual} {
return true
} else {
return false
}
}}]
tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]]
-seek "Xvfs Seek Test" -setup {
|
| ︙ | | |
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
+
+
+
+
+
|
incr ::calls
}} $fd]
vwait done
list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
} -cleanup {
close $fd
update
unset -nocomplain fd size done calls output
} -result {1 1}
tcltest::test xvfs-match-almost-root-neg "Xvfs Match Almost Root" -body {
file exists ${rootDir}_DOES_NOT_EXIST
} -match boolean -result false
tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body {
llength [glob_verify *]
} -result 3
tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body {
llength [glob_verify f*]
|
| ︙ | | |
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
llength [glob_verify lib/*]
} -result 1
tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
lindex [glob_verify lib/*] 0
} -match glob -result "$rootDir/*"
tcltest::test xvfs-access-basic-read "Xvfs acccess Read Basic Test" -body {
file readable $testFile
} -match boolean -result true
tcltest::test xvfs-access-basic-write "Xvfs acccess Write Basic Test" -body {
file writable $testFile
} -match boolean -result false
tcltest::test xvfs-access-basic-neg "Xvfs acccess Basic Negative Test" -body {
file executable $testFile
} -match boolean -result false
tcltest::test xvfs-exists-basic-neg "Xvfs exists Basic Negative Test" -body {
file exists $rootDir/does-not-exist
} -match boolean -result false
tcltest::test xvfs-stat-basic-file "Xvfs stat Basic File Test" -body {
file stat $testFile fileInfo
set fileInfo(type)
} -cleanup {
unset -nocomplain fileInfo
} -result file
tcltest::test xvfs-stat-basic-dir "Xvfs stat Basic Directory Test" -body {
file stat $rootDir/lib fileInfo
set fileInfo(type)
} -cleanup {
unset -nocomplain fileInfo
} -result directory
# Broken in Tcl 8.6 and earlier
tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
llength [glob //xvfs:/example/*]
} -constraints tcl87 -result 3
tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
|
| ︙ | | |
169
170
171
172
173
174
175
176
177
178
179
180
181
|
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
|
+
+
+
+
+
+
|
$::tcltest::numTests(Passed) \
$::tcltest::numTests(Failed) \
$::tcltest::numTests(Skipped) \
$::tcltest::numTests(Total) \
]
puts [string repeat - [string length [format $format - - - -]]]
if {[info exists ::env(XVFS_TEST_EXIT_ON_FAILURE)]} {
exit $::env(XVFS_TEST_EXIT_ON_FAILURE)
}
exit 1
}
puts "ALL TESTS PASSED"
if {[info exists ::env(XVFS_TEST_EXIT_ON_SUCCESS)]} {
exit $::env(XVFS_TEST_EXIT_ON_SUCCESS)
}
exit 0
|