Diff

Differences From Artifact [a1ab38e038]:

To Artifact [5b23a3839e]:


1
2
3
4


5
6
7
8
9
10
11
#! /usr/bin/env tclsh

package require tcltest



tcltest::configure -verbose pbse
tcltest::configure {*}$argv

set rootDir "//xvfs:/example"
set rootDirNative  [file join [pwd] example]
#set rootDir $rootDirNative
set testFile "${rootDir}/foo"




>
>







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
	if {!!$expected == !!$actual} {
		return true
	} else {
		return false
	}
}}]

tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]]

tcltest::test xvfs-basic-seek "Xvfs Seek Test" -setup {
	set fd [open $testFile]
} -body {
	seek $fd 0 end
	seek $fd -1 current

	read $fd 1
} -cleanup {
	close $fd
	unset fd
} -result "\n"














































tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup {
	set fd1 [open $testFile]
	set fd2 [open $testFile]
} -body {
	set data1 [read $fd1]
	close $fd1







<
<
|










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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::test xvfs-seek-basic "Xvfs Seek Test" -setup {
	set fd [open $testFile]
} -body {
	seek $fd 0 end
	seek $fd -1 current

	read $fd 1
} -cleanup {
	close $fd
	unset fd
} -result "\n"

tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup {
	set fd [open $testFile]
} -body {
	seek $fd 1 end
} -cleanup {
	close $fd
	unset fd
} -match glob -returnCodes error -result "*: invalid argument"

tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup {
	set fd [open $testFile]
} -body {
	seek $fd -10 current
} -cleanup {
	close $fd
	unset fd
} -match glob -returnCodes error -result "*: invalid argument"

tcltest::test xvfs-seek-read-past-eof "Xvfs Seek Then Read Past EOF Test" -setup {
	set fd [open $testFile]
} -body {
	seek $fd 0 end

	read $fd 1
	read $fd 1
} -cleanup {
	close $fd
	unset fd
} -result ""

tcltest::test xvfs-basic-open-write "Xvfs Open For Writing Test" -setup {
	unset -nocomplain fd
} -body {
	set fd [open $rootDir/new-file w]
	close $fd
} -cleanup {
	if {[info exists fd]} {
		close $fd
		unset fd
	}
	catch {
		file delete $rootDir/new-file
	}
} -match glob -returnCodes error -result "*read*only file*system*"

tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup {
	set fd1 [open $testFile]
	set fd2 [open $testFile]
} -body {
	set data1 [read $fd1]
	close $fd1
79
80
81
82
83
84
85

86
87




88
89
90
91
92
93
94
		incr ::calls
	}} $fd]
	vwait done

	list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
} -cleanup {
	close $fd

	unset -nocomplain fd size done calls output
} -result {1 1}





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*]







>


>
>
>
>







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
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/*"































# 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 {







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
		$::tcltest::numTests(Passed) \
		$::tcltest::numTests(Failed) \
		$::tcltest::numTests(Skipped) \
		$::tcltest::numTests(Total) \
	]
	puts [string repeat - [string length [format $format - - - -]]]




	exit 1
}

puts "ALL TESTS PASSED"




exit 0







>
>
>





>
>
>

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