Lines of
example/main.tcl
from check-in ad7092b843
that are changed by the sequence of edits moving toward
check-in e4bde431db:
1: #! /usr/bin/env tclsh
2:
3: package require tcltest
4:
5: tcltest::configure -verbose pbse
6: tcltest::configure {*}$argv
7:
8: set rootDir "//xvfs:/example"
9: set rootDirNative [file join [pwd] example]
10: #set rootDir $rootDirNative
11: set testFile "${rootDir}/foo"
12:
13: proc glob_verify {args} {
14: set rv [glob -nocomplain -directory $::rootDir {*}$args]
15: set verify [glob -nocomplain -directory $::rootDirNative {*}$args]
16:
17: if {[llength $rv] != [llength $verify]} {
18: error "VERIFY FAILED: glob ... $args ($rv versus $verify)"
19: }
20:
21: return $rv
22: }
23:
24: tcltest::customMatch boolean [list apply {{expected actual} {
25: if {!!$expected == !!$actual} {
26: return true
27: } else {
28: return false
29: }
30: }}]
31:
32: tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]]
33:
34: tcltest::test xvfs-basic-seek "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-basic-two-files "Xvfs Multiple Open Files Test" -setup {
47: set fd1 [open $testFile]
48: set fd2 [open $testFile]
49: } -body {
50: set data1 [read $fd1]
51: close $fd1
52: set data2 [read $fd2]
53: close $fd2
54:
55: expr {$data1 eq $data2}
56: } -cleanup {
57: unset -nocomplain fd1 fd2 data1 data2
58: } -match boolean -result true
59:
60: tcltest::test xvfs-events "Xvfs Fileevent Test" -setup {
61: set fd [open $testFile]
62: seek $fd 0 end
63: set size [tell $fd]
64: seek $fd 0 start
65:
66: set done false
67: set calls 0
68: set output ""
69: } -body {
70: fileevent $fd readable [list apply {{fd} {
71: set pos [tell $fd]
72: set x [read $fd 1]
73: if {[string length $x] == 0} {
74: set ::done true
75: fileevent $fd readable ""
76: }
77:
78: lappend ::output $pos
79: incr ::calls
80: }} $fd]
81: vwait done
82:
83: list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
84: } -cleanup {
85: close $fd
86: unset -nocomplain fd size done calls output
87: } -result {1 1}
88:
89: tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body {
90: llength [glob_verify *]
91: } -result 3
92:
93: tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body {
94: llength [glob_verify f*]
95: } -result 1
96:
97: tcltest::test xvfs-glob-basic-limited-neg "Xvfs Glob Match Limited Negative Test" -body {
98: llength [glob_verify x*]
99: } -result 0
100:
101: tcltest::test xvfs-glob-basic-limited-prefixed "Xvfs Glob Match Limited But With Directory Prefix Test" -body {
102: llength [glob_verify ./f*]
103: } -result 1
104:
105: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed "Xvfs Glob Match Limited Path and Type Positive Test" -body {
106: llength [glob_verify -type f ./f*]
107: } -result 1
108:
109: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed-neg "Xvfs Glob Match Limited Path and Type Negative Test" -body {
110: llength [glob_verify -type d ./f*]
111: } -result 0
112:
113: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
114: llength [glob_verify lib/*]
115: } -result 1
116:
117: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
118: lindex [glob_verify lib/*] 0
119: } -match glob -result "$rootDir/*"
120:
121: # Broken in Tcl 8.6 and earlier
122: tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
123: llength [glob //xvfs:/example/*]
124: } -constraints tcl87 -result 3
125:
126: tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
127: lindex [glob -directory [file dirname $testFile] *] 0
128: } -constraints tcl87 -match glob -result "$rootDir/*"
129:
130: tcltest::test xvfs-cwd-1 "Xvfs Can Be cwd" -setup {
131: set startDir [pwd]
132: } -body {
133: cd $rootDir
134: pwd
135: } -cleanup {
136: cd $startDir
137: unset startDir
ad7092b843 2019-09-16 138: } -result $rootDir
139:
140: tcltest::test xvfs-cwd-2 "Xvfs Can Be cwd" -setup {
141: set startDir [pwd]
142: } -body {
143: cd $rootDir
144: cd lib
145: lindex [glob *] 0
146: } -cleanup {
147: cd $startDir
148: unset startDir
ad7092b843 2019-09-16 149: } -result "hello"
150:
151: # Currently broken
152: tcltest::test xvfs-package "Xvfs Can Be Package Directory" -setup {
153: set startAutoPath $auto_path
154: lappend auto_path ${rootDir}/lib
155: } -body {
156: package require hello
157: set auto_path
158: } -cleanup {
159: set auto_path $startAutoPath
160: unset startAutoPath
161: } -constraints knownBug -result ""
162:
163: # Output results
164: if {$::tcltest::numTests(Failed) != 0} {
165: set format "| %20s | %20s | %20s | %20s |"
166: puts [string repeat - [string length [format $format - - - -]]]
167: puts [format $format "Passed" "Failed" "Skipped" "Total"]
168: puts [format $format \
169: $::tcltest::numTests(Passed) \
170: $::tcltest::numTests(Failed) \
171: $::tcltest::numTests(Skipped) \
172: $::tcltest::numTests(Total) \
173: ]
174: puts [string repeat - [string length [format $format - - - -]]]
175:
176: exit 1
177: }
178:
179: puts "ALL TESTS PASSED"
180:
181: exit 0