|
sl@0
|
1 |
# -*- tcl -*-
|
|
sl@0
|
2 |
# Commands covered: transform, and stacking in general
|
|
sl@0
|
3 |
#
|
|
sl@0
|
4 |
# This file contains a collection of tests for Giot
|
|
sl@0
|
5 |
#
|
|
sl@0
|
6 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
7 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
8 |
#
|
|
sl@0
|
9 |
# Copyright (c) 2000 Ajuba Solutions.
|
|
sl@0
|
10 |
# Copyright (c) 2000 Andreas Kupries.
|
|
sl@0
|
11 |
# All rights reserved.
|
|
sl@0
|
12 |
#
|
|
sl@0
|
13 |
# RCS: @(#) $Id: iogt.test,v 1.7.2.1 2005/04/14 07:10:57 davygrvy Exp $
|
|
sl@0
|
14 |
|
|
sl@0
|
15 |
if {[catch {package require tcltest 2.1}]} {
|
|
sl@0
|
16 |
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
|
|
sl@0
|
17 |
return
|
|
sl@0
|
18 |
}
|
|
sl@0
|
19 |
namespace eval ::tcl::test::iogt {
|
|
sl@0
|
20 |
|
|
sl@0
|
21 |
namespace import ::tcltest::cleanupTests
|
|
sl@0
|
22 |
namespace import ::tcltest::makeFile
|
|
sl@0
|
23 |
namespace import ::tcltest::removeFile
|
|
sl@0
|
24 |
namespace import ::tcltest::test
|
|
sl@0
|
25 |
namespace import ::tcltest::testConstraint
|
|
sl@0
|
26 |
|
|
sl@0
|
27 |
testConstraint testchannel [llength [info commands testchannel]]
|
|
sl@0
|
28 |
|
|
sl@0
|
29 |
set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
|
|
sl@0
|
30 |
} dummy]
|
|
sl@0
|
31 |
|
|
sl@0
|
32 |
# " capture coloring of quotes
|
|
sl@0
|
33 |
|
|
sl@0
|
34 |
set path(dummyout) [makeFile {} dummyout]
|
|
sl@0
|
35 |
|
|
sl@0
|
36 |
set path(__echo_srv__.tcl) [makeFile {
|
|
sl@0
|
37 |
#!/usr/local/bin/tclsh
|
|
sl@0
|
38 |
# -*- tcl -*-
|
|
sl@0
|
39 |
# echo server
|
|
sl@0
|
40 |
#
|
|
sl@0
|
41 |
# arguments, options: port to listen on for connections.
|
|
sl@0
|
42 |
# delay till echo of first block
|
|
sl@0
|
43 |
# delay between blocks
|
|
sl@0
|
44 |
# blocksize ...
|
|
sl@0
|
45 |
|
|
sl@0
|
46 |
set port [lindex $argv 0]
|
|
sl@0
|
47 |
set fdelay [lindex $argv 1]
|
|
sl@0
|
48 |
set idelay [lindex $argv 2]
|
|
sl@0
|
49 |
set bsizes [lrange $argv 3 end]
|
|
sl@0
|
50 |
set c 0
|
|
sl@0
|
51 |
|
|
sl@0
|
52 |
proc newconn {sock rhost rport} {
|
|
sl@0
|
53 |
variable fdelay
|
|
sl@0
|
54 |
variable c
|
|
sl@0
|
55 |
incr c
|
|
sl@0
|
56 |
variable c$c
|
|
sl@0
|
57 |
|
|
sl@0
|
58 |
#puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout
|
|
sl@0
|
59 |
|
|
sl@0
|
60 |
upvar 0 c$c conn
|
|
sl@0
|
61 |
set conn(after) {}
|
|
sl@0
|
62 |
set conn(state) 0
|
|
sl@0
|
63 |
set conn(size) 0
|
|
sl@0
|
64 |
set conn(data) ""
|
|
sl@0
|
65 |
set conn(delay) $fdelay
|
|
sl@0
|
66 |
|
|
sl@0
|
67 |
fileevent $sock readable [list echoGet $c $sock]
|
|
sl@0
|
68 |
fconfigure $sock -translation binary -buffering none -blocking 0
|
|
sl@0
|
69 |
}
|
|
sl@0
|
70 |
|
|
sl@0
|
71 |
proc echoGet {c sock} {
|
|
sl@0
|
72 |
variable fdelay
|
|
sl@0
|
73 |
variable c$c
|
|
sl@0
|
74 |
upvar 0 c$c conn
|
|
sl@0
|
75 |
|
|
sl@0
|
76 |
if {[eof $sock]} {
|
|
sl@0
|
77 |
# one-shot echo
|
|
sl@0
|
78 |
exit
|
|
sl@0
|
79 |
}
|
|
sl@0
|
80 |
|
|
sl@0
|
81 |
append conn(data) [read $sock]
|
|
sl@0
|
82 |
|
|
sl@0
|
83 |
#puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout
|
|
sl@0
|
84 |
|
|
sl@0
|
85 |
if {$conn(after) == {}} {
|
|
sl@0
|
86 |
set conn(after) [after $conn(delay) [list echoPut $c $sock]]
|
|
sl@0
|
87 |
}
|
|
sl@0
|
88 |
}
|
|
sl@0
|
89 |
|
|
sl@0
|
90 |
proc echoPut {c sock} {
|
|
sl@0
|
91 |
variable idelay
|
|
sl@0
|
92 |
variable fdelay
|
|
sl@0
|
93 |
variable bsizes
|
|
sl@0
|
94 |
variable c$c
|
|
sl@0
|
95 |
upvar 0 c$c conn
|
|
sl@0
|
96 |
|
|
sl@0
|
97 |
if {[string length $conn(data)] == 0} {
|
|
sl@0
|
98 |
#puts stdout "C $c $sock" ; flush stdout
|
|
sl@0
|
99 |
# auto terminate
|
|
sl@0
|
100 |
close $sock
|
|
sl@0
|
101 |
exit
|
|
sl@0
|
102 |
#set conn(delay) $fdelay
|
|
sl@0
|
103 |
return
|
|
sl@0
|
104 |
}
|
|
sl@0
|
105 |
|
|
sl@0
|
106 |
|
|
sl@0
|
107 |
set conn(delay) $idelay
|
|
sl@0
|
108 |
|
|
sl@0
|
109 |
set n [lindex $bsizes $conn(size)]
|
|
sl@0
|
110 |
|
|
sl@0
|
111 |
#puts stdout "P $c $sock $n >>" ; flush stdout
|
|
sl@0
|
112 |
|
|
sl@0
|
113 |
#puts __________________________________________
|
|
sl@0
|
114 |
#parray conn
|
|
sl@0
|
115 |
#puts n=<$n>
|
|
sl@0
|
116 |
|
|
sl@0
|
117 |
|
|
sl@0
|
118 |
if {[string length $conn(data)] >= $n} {
|
|
sl@0
|
119 |
puts -nonewline $sock [string range $conn(data) 0 $n]
|
|
sl@0
|
120 |
set conn(data) [string range $conn(data) [incr n] end]
|
|
sl@0
|
121 |
}
|
|
sl@0
|
122 |
|
|
sl@0
|
123 |
incr conn(size)
|
|
sl@0
|
124 |
if {$conn(size) >= [llength $bsizes]} {
|
|
sl@0
|
125 |
set conn(size) [expr {[llength $bsizes]-1}]
|
|
sl@0
|
126 |
}
|
|
sl@0
|
127 |
|
|
sl@0
|
128 |
set conn(after) [after $conn(delay) [list echoPut $c $sock]]
|
|
sl@0
|
129 |
}
|
|
sl@0
|
130 |
|
|
sl@0
|
131 |
#fileevent stdin readable {exit ;#cut}
|
|
sl@0
|
132 |
|
|
sl@0
|
133 |
# main
|
|
sl@0
|
134 |
socket -server newconn $port
|
|
sl@0
|
135 |
vwait forever
|
|
sl@0
|
136 |
} __echo_srv__.tcl]
|
|
sl@0
|
137 |
|
|
sl@0
|
138 |
|
|
sl@0
|
139 |
########################################################################
|
|
sl@0
|
140 |
|
|
sl@0
|
141 |
proc fevent {fdelay idelay blocks script data} {
|
|
sl@0
|
142 |
# start and initialize an echo server, prepare data
|
|
sl@0
|
143 |
# transmission, then hand over to the test script.
|
|
sl@0
|
144 |
# this has to start real transmission via 'flush'.
|
|
sl@0
|
145 |
# The server is stopped after completion of the test.
|
|
sl@0
|
146 |
|
|
sl@0
|
147 |
# fixed port, not so good. lets hope for the best, for now.
|
|
sl@0
|
148 |
set port 4000
|
|
sl@0
|
149 |
|
|
sl@0
|
150 |
eval exec tclsh __echo_srv__.tcl \
|
|
sl@0
|
151 |
$port $fdelay $idelay $blocks >@stdout &
|
|
sl@0
|
152 |
|
|
sl@0
|
153 |
after 500
|
|
sl@0
|
154 |
|
|
sl@0
|
155 |
#puts stdout "> $port" ; flush stdout
|
|
sl@0
|
156 |
|
|
sl@0
|
157 |
set sk [socket localhost $port]
|
|
sl@0
|
158 |
fconfigure $sk \
|
|
sl@0
|
159 |
-blocking 0 \
|
|
sl@0
|
160 |
-buffering full \
|
|
sl@0
|
161 |
-buffersize [expr {10+[llength $data]}]
|
|
sl@0
|
162 |
|
|
sl@0
|
163 |
puts -nonewline $sk $data
|
|
sl@0
|
164 |
|
|
sl@0
|
165 |
# The channel is prepared to go off.
|
|
sl@0
|
166 |
|
|
sl@0
|
167 |
#puts stdout ">>>>>" ; flush stdout
|
|
sl@0
|
168 |
|
|
sl@0
|
169 |
uplevel #0 set sock $sk
|
|
sl@0
|
170 |
set res [uplevel #0 $script]
|
|
sl@0
|
171 |
|
|
sl@0
|
172 |
catch {close $sk}
|
|
sl@0
|
173 |
return $res
|
|
sl@0
|
174 |
}
|
|
sl@0
|
175 |
|
|
sl@0
|
176 |
# --------------------------------------------------------------
|
|
sl@0
|
177 |
# utility transformations ...
|
|
sl@0
|
178 |
|
|
sl@0
|
179 |
proc id {op data} {
|
|
sl@0
|
180 |
switch -- $op {
|
|
sl@0
|
181 |
create/write -
|
|
sl@0
|
182 |
create/read -
|
|
sl@0
|
183 |
delete/write -
|
|
sl@0
|
184 |
delete/read -
|
|
sl@0
|
185 |
clear_read {;#ignore}
|
|
sl@0
|
186 |
flush/write -
|
|
sl@0
|
187 |
flush/read -
|
|
sl@0
|
188 |
write -
|
|
sl@0
|
189 |
read {
|
|
sl@0
|
190 |
return $data
|
|
sl@0
|
191 |
}
|
|
sl@0
|
192 |
query/maxRead {return -1}
|
|
sl@0
|
193 |
}
|
|
sl@0
|
194 |
}
|
|
sl@0
|
195 |
|
|
sl@0
|
196 |
proc id_optrail {var op data} {
|
|
sl@0
|
197 |
variable $var
|
|
sl@0
|
198 |
upvar 0 $var trail
|
|
sl@0
|
199 |
|
|
sl@0
|
200 |
lappend trail $op
|
|
sl@0
|
201 |
|
|
sl@0
|
202 |
switch -- $op {
|
|
sl@0
|
203 |
create/write - create/read -
|
|
sl@0
|
204 |
delete/write - delete/read -
|
|
sl@0
|
205 |
flush/read -
|
|
sl@0
|
206 |
clear/read { #ignore }
|
|
sl@0
|
207 |
flush/write -
|
|
sl@0
|
208 |
write -
|
|
sl@0
|
209 |
read {
|
|
sl@0
|
210 |
return $data
|
|
sl@0
|
211 |
}
|
|
sl@0
|
212 |
query/maxRead {
|
|
sl@0
|
213 |
return -1
|
|
sl@0
|
214 |
}
|
|
sl@0
|
215 |
default {
|
|
sl@0
|
216 |
lappend trail "error $op"
|
|
sl@0
|
217 |
error $op
|
|
sl@0
|
218 |
}
|
|
sl@0
|
219 |
}
|
|
sl@0
|
220 |
}
|
|
sl@0
|
221 |
|
|
sl@0
|
222 |
|
|
sl@0
|
223 |
proc id_fulltrail {var op data} {
|
|
sl@0
|
224 |
variable $var
|
|
sl@0
|
225 |
upvar 0 $var trail
|
|
sl@0
|
226 |
|
|
sl@0
|
227 |
#puts stdout ">> $var $op $data" ; flush stdout
|
|
sl@0
|
228 |
|
|
sl@0
|
229 |
switch -- $op {
|
|
sl@0
|
230 |
create/write - create/read -
|
|
sl@0
|
231 |
delete/write - delete/read -
|
|
sl@0
|
232 |
clear_read {
|
|
sl@0
|
233 |
set res *ignored*
|
|
sl@0
|
234 |
}
|
|
sl@0
|
235 |
flush/write - flush/read -
|
|
sl@0
|
236 |
write -
|
|
sl@0
|
237 |
read {
|
|
sl@0
|
238 |
set res $data
|
|
sl@0
|
239 |
}
|
|
sl@0
|
240 |
query/maxRead {
|
|
sl@0
|
241 |
set res -1
|
|
sl@0
|
242 |
}
|
|
sl@0
|
243 |
}
|
|
sl@0
|
244 |
|
|
sl@0
|
245 |
#catch {puts stdout "\t>* $res" ; flush stdout}
|
|
sl@0
|
246 |
#catch {puts stdout "x$res"} msg
|
|
sl@0
|
247 |
|
|
sl@0
|
248 |
lappend trail [list $op $data $res]
|
|
sl@0
|
249 |
return $res
|
|
sl@0
|
250 |
}
|
|
sl@0
|
251 |
|
|
sl@0
|
252 |
proc counter {var op data} {
|
|
sl@0
|
253 |
variable $var
|
|
sl@0
|
254 |
upvar 0 $var n
|
|
sl@0
|
255 |
|
|
sl@0
|
256 |
switch -- $op {
|
|
sl@0
|
257 |
create/write - create/read -
|
|
sl@0
|
258 |
delete/write - delete/read -
|
|
sl@0
|
259 |
clear_read {;#ignore}
|
|
sl@0
|
260 |
flush/write - flush/read {return {}}
|
|
sl@0
|
261 |
write {
|
|
sl@0
|
262 |
return $data
|
|
sl@0
|
263 |
}
|
|
sl@0
|
264 |
read {
|
|
sl@0
|
265 |
if {$n > 0} {
|
|
sl@0
|
266 |
incr n -[string length $data]
|
|
sl@0
|
267 |
if {$n < 0} {
|
|
sl@0
|
268 |
set n 0
|
|
sl@0
|
269 |
}
|
|
sl@0
|
270 |
}
|
|
sl@0
|
271 |
return $data
|
|
sl@0
|
272 |
}
|
|
sl@0
|
273 |
query/maxRead {
|
|
sl@0
|
274 |
return $n
|
|
sl@0
|
275 |
}
|
|
sl@0
|
276 |
}
|
|
sl@0
|
277 |
}
|
|
sl@0
|
278 |
|
|
sl@0
|
279 |
|
|
sl@0
|
280 |
proc counter_audit {var vtrail op data} {
|
|
sl@0
|
281 |
variable $var
|
|
sl@0
|
282 |
variable $vtrail
|
|
sl@0
|
283 |
upvar 0 $var n $vtrail trail
|
|
sl@0
|
284 |
|
|
sl@0
|
285 |
switch -- $op {
|
|
sl@0
|
286 |
create/write - create/read -
|
|
sl@0
|
287 |
delete/write - delete/read -
|
|
sl@0
|
288 |
clear_read {
|
|
sl@0
|
289 |
set res {}
|
|
sl@0
|
290 |
}
|
|
sl@0
|
291 |
flush/write - flush/read {
|
|
sl@0
|
292 |
set res {}
|
|
sl@0
|
293 |
}
|
|
sl@0
|
294 |
write {
|
|
sl@0
|
295 |
set res $data
|
|
sl@0
|
296 |
}
|
|
sl@0
|
297 |
read {
|
|
sl@0
|
298 |
if {$n > 0} {
|
|
sl@0
|
299 |
incr n -[string length $data]
|
|
sl@0
|
300 |
if {$n < 0} {
|
|
sl@0
|
301 |
set n 0
|
|
sl@0
|
302 |
}
|
|
sl@0
|
303 |
}
|
|
sl@0
|
304 |
set res $data
|
|
sl@0
|
305 |
}
|
|
sl@0
|
306 |
query/maxRead {
|
|
sl@0
|
307 |
set res $n
|
|
sl@0
|
308 |
}
|
|
sl@0
|
309 |
}
|
|
sl@0
|
310 |
|
|
sl@0
|
311 |
lappend trail [list counter:$op $data $res]
|
|
sl@0
|
312 |
return $res
|
|
sl@0
|
313 |
}
|
|
sl@0
|
314 |
|
|
sl@0
|
315 |
|
|
sl@0
|
316 |
proc rblocks {var vtrail n op data} {
|
|
sl@0
|
317 |
variable $var
|
|
sl@0
|
318 |
variable $vtrail
|
|
sl@0
|
319 |
upvar 0 $var buf $vtrail trail
|
|
sl@0
|
320 |
|
|
sl@0
|
321 |
set res {}
|
|
sl@0
|
322 |
|
|
sl@0
|
323 |
switch -- $op {
|
|
sl@0
|
324 |
create/write - create/read -
|
|
sl@0
|
325 |
delete/write - delete/read -
|
|
sl@0
|
326 |
clear_read {
|
|
sl@0
|
327 |
set buf {}
|
|
sl@0
|
328 |
}
|
|
sl@0
|
329 |
flush/write {
|
|
sl@0
|
330 |
}
|
|
sl@0
|
331 |
flush/read {
|
|
sl@0
|
332 |
set res $buf
|
|
sl@0
|
333 |
set buf {}
|
|
sl@0
|
334 |
}
|
|
sl@0
|
335 |
write {
|
|
sl@0
|
336 |
set data
|
|
sl@0
|
337 |
}
|
|
sl@0
|
338 |
read {
|
|
sl@0
|
339 |
append buf $data
|
|
sl@0
|
340 |
|
|
sl@0
|
341 |
set b [expr {$n * ([string length $buf] / $n)}]
|
|
sl@0
|
342 |
|
|
sl@0
|
343 |
append op " $n [string length $buf] :- $b"
|
|
sl@0
|
344 |
|
|
sl@0
|
345 |
set res [string range $buf 0 [incr b -1]]
|
|
sl@0
|
346 |
set buf [string range $buf [incr b] end]
|
|
sl@0
|
347 |
#return $res
|
|
sl@0
|
348 |
}
|
|
sl@0
|
349 |
query/maxRead {
|
|
sl@0
|
350 |
set res -1
|
|
sl@0
|
351 |
}
|
|
sl@0
|
352 |
}
|
|
sl@0
|
353 |
|
|
sl@0
|
354 |
lappend trail [list rblock | $op $data $res | $buf]
|
|
sl@0
|
355 |
return $res
|
|
sl@0
|
356 |
}
|
|
sl@0
|
357 |
|
|
sl@0
|
358 |
|
|
sl@0
|
359 |
# --------------------------------------------------------------
|
|
sl@0
|
360 |
# ... and convenience procedures to stack them
|
|
sl@0
|
361 |
|
|
sl@0
|
362 |
proc identity {-attach channel} {
|
|
sl@0
|
363 |
testchannel transform $channel -command [namespace code id]
|
|
sl@0
|
364 |
}
|
|
sl@0
|
365 |
|
|
sl@0
|
366 |
proc audit_ops {var -attach channel} {
|
|
sl@0
|
367 |
testchannel transform $channel -command [namespace code [list id_optrail $var]]
|
|
sl@0
|
368 |
}
|
|
sl@0
|
369 |
|
|
sl@0
|
370 |
proc audit_flow {var -attach channel} {
|
|
sl@0
|
371 |
testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
|
|
sl@0
|
372 |
}
|
|
sl@0
|
373 |
|
|
sl@0
|
374 |
proc stopafter {var n -attach channel} {
|
|
sl@0
|
375 |
variable $var
|
|
sl@0
|
376 |
upvar 0 $var vn
|
|
sl@0
|
377 |
set vn $n
|
|
sl@0
|
378 |
testchannel transform $channel -command [namespace code [list counter $var]]
|
|
sl@0
|
379 |
}
|
|
sl@0
|
380 |
|
|
sl@0
|
381 |
proc stopafter_audit {var trail n -attach channel} {
|
|
sl@0
|
382 |
variable $var
|
|
sl@0
|
383 |
upvar 0 $var vn
|
|
sl@0
|
384 |
set vn $n
|
|
sl@0
|
385 |
testchannel transform $channel -command [namespace code [list counter_audit $var $trail]]
|
|
sl@0
|
386 |
}
|
|
sl@0
|
387 |
|
|
sl@0
|
388 |
proc rblocks_t {var trail n -attach channel} {
|
|
sl@0
|
389 |
testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]]
|
|
sl@0
|
390 |
}
|
|
sl@0
|
391 |
|
|
sl@0
|
392 |
# --------------------------------------------------------------
|
|
sl@0
|
393 |
# serialize an array, with keys in sorted order.
|
|
sl@0
|
394 |
|
|
sl@0
|
395 |
proc array_sget {v} {
|
|
sl@0
|
396 |
upvar $v a
|
|
sl@0
|
397 |
|
|
sl@0
|
398 |
set res [list]
|
|
sl@0
|
399 |
foreach n [lsort [array names a]] {
|
|
sl@0
|
400 |
lappend res $n $a($n)
|
|
sl@0
|
401 |
}
|
|
sl@0
|
402 |
set res
|
|
sl@0
|
403 |
}
|
|
sl@0
|
404 |
|
|
sl@0
|
405 |
proc asort {alist} {
|
|
sl@0
|
406 |
# sort a list of key/value pairs by key, removes duplicates too.
|
|
sl@0
|
407 |
|
|
sl@0
|
408 |
array set a $alist
|
|
sl@0
|
409 |
array_sget a
|
|
sl@0
|
410 |
}
|
|
sl@0
|
411 |
|
|
sl@0
|
412 |
########################################################################
|
|
sl@0
|
413 |
|
|
sl@0
|
414 |
test iogt-1.1 {stack/unstack} testchannel {
|
|
sl@0
|
415 |
set fh [open $path(dummy) r]
|
|
sl@0
|
416 |
identity -attach $fh
|
|
sl@0
|
417 |
testchannel unstack $fh
|
|
sl@0
|
418 |
close $fh
|
|
sl@0
|
419 |
} {}
|
|
sl@0
|
420 |
|
|
sl@0
|
421 |
test iogt-1.2 {stack/close} testchannel {
|
|
sl@0
|
422 |
set fh [open $path(dummy) r]
|
|
sl@0
|
423 |
identity -attach $fh
|
|
sl@0
|
424 |
close $fh
|
|
sl@0
|
425 |
} {}
|
|
sl@0
|
426 |
|
|
sl@0
|
427 |
test iogt-1.3 {stack/unstack, configuration, options} testchannel {
|
|
sl@0
|
428 |
set fh [open $path(dummy) r]
|
|
sl@0
|
429 |
set ca [asort [fconfigure $fh]]
|
|
sl@0
|
430 |
identity -attach $fh
|
|
sl@0
|
431 |
set cb [asort [fconfigure $fh]]
|
|
sl@0
|
432 |
testchannel unstack $fh
|
|
sl@0
|
433 |
set cc [asort [fconfigure $fh]]
|
|
sl@0
|
434 |
close $fh
|
|
sl@0
|
435 |
|
|
sl@0
|
436 |
# With this system none of the buffering, translation and
|
|
sl@0
|
437 |
# encoding option may change their values with channels
|
|
sl@0
|
438 |
# stacked upon each other or not.
|
|
sl@0
|
439 |
|
|
sl@0
|
440 |
# cb == ca == cc
|
|
sl@0
|
441 |
|
|
sl@0
|
442 |
list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
|
|
sl@0
|
443 |
} {1 1 1}
|
|
sl@0
|
444 |
|
|
sl@0
|
445 |
test iogt-1.4 {stack/unstack, configuration} testchannel {
|
|
sl@0
|
446 |
set fh [open $path(dummy) r]
|
|
sl@0
|
447 |
set ca [asort [fconfigure $fh]]
|
|
sl@0
|
448 |
identity -attach $fh
|
|
sl@0
|
449 |
fconfigure $fh \
|
|
sl@0
|
450 |
-buffering line \
|
|
sl@0
|
451 |
-translation cr \
|
|
sl@0
|
452 |
-encoding shiftjis
|
|
sl@0
|
453 |
testchannel unstack $fh
|
|
sl@0
|
454 |
set cc [asort [fconfigure $fh]]
|
|
sl@0
|
455 |
|
|
sl@0
|
456 |
set res [list \
|
|
sl@0
|
457 |
[string equal $ca $cc] \
|
|
sl@0
|
458 |
[fconfigure $fh -buffering] \
|
|
sl@0
|
459 |
[fconfigure $fh -translation] \
|
|
sl@0
|
460 |
[fconfigure $fh -encoding] \
|
|
sl@0
|
461 |
]
|
|
sl@0
|
462 |
|
|
sl@0
|
463 |
close $fh
|
|
sl@0
|
464 |
set res
|
|
sl@0
|
465 |
} {0 line cr shiftjis}
|
|
sl@0
|
466 |
|
|
sl@0
|
467 |
test iogt-2.0 {basic I/O going through transform} testchannel {
|
|
sl@0
|
468 |
set fin [open $path(dummy) r]
|
|
sl@0
|
469 |
set fout [open $path(dummyout) w]
|
|
sl@0
|
470 |
|
|
sl@0
|
471 |
identity -attach $fin
|
|
sl@0
|
472 |
identity -attach $fout
|
|
sl@0
|
473 |
|
|
sl@0
|
474 |
fcopy $fin $fout
|
|
sl@0
|
475 |
|
|
sl@0
|
476 |
close $fin
|
|
sl@0
|
477 |
close $fout
|
|
sl@0
|
478 |
|
|
sl@0
|
479 |
set fin [open $path(dummy) r]
|
|
sl@0
|
480 |
set fout [open $path(dummyout) r]
|
|
sl@0
|
481 |
|
|
sl@0
|
482 |
set res [string equal [set in [read $fin]] [set out [read $fout]]]
|
|
sl@0
|
483 |
lappend res [string length $in] [string length $out]
|
|
sl@0
|
484 |
|
|
sl@0
|
485 |
close $fin
|
|
sl@0
|
486 |
close $fout
|
|
sl@0
|
487 |
|
|
sl@0
|
488 |
set res
|
|
sl@0
|
489 |
} {1 71 71}
|
|
sl@0
|
490 |
|
|
sl@0
|
491 |
|
|
sl@0
|
492 |
test iogt-2.1 {basic I/O, operation trail} {testchannel unixOnly} {
|
|
sl@0
|
493 |
set fin [open $path(dummy) r]
|
|
sl@0
|
494 |
set fout [open $path(dummyout) w]
|
|
sl@0
|
495 |
|
|
sl@0
|
496 |
set ain [list] ; set aout [list]
|
|
sl@0
|
497 |
audit_ops ain -attach $fin
|
|
sl@0
|
498 |
audit_ops aout -attach $fout
|
|
sl@0
|
499 |
|
|
sl@0
|
500 |
fconfigure $fin -buffersize 10
|
|
sl@0
|
501 |
fconfigure $fout -buffersize 10
|
|
sl@0
|
502 |
|
|
sl@0
|
503 |
fcopy $fin $fout
|
|
sl@0
|
504 |
|
|
sl@0
|
505 |
close $fin
|
|
sl@0
|
506 |
close $fout
|
|
sl@0
|
507 |
|
|
sl@0
|
508 |
set res "[join $ain \n]\n--------\n[join $aout \n]"
|
|
sl@0
|
509 |
} {create/read
|
|
sl@0
|
510 |
query/maxRead
|
|
sl@0
|
511 |
read
|
|
sl@0
|
512 |
query/maxRead
|
|
sl@0
|
513 |
read
|
|
sl@0
|
514 |
query/maxRead
|
|
sl@0
|
515 |
read
|
|
sl@0
|
516 |
query/maxRead
|
|
sl@0
|
517 |
read
|
|
sl@0
|
518 |
query/maxRead
|
|
sl@0
|
519 |
read
|
|
sl@0
|
520 |
query/maxRead
|
|
sl@0
|
521 |
read
|
|
sl@0
|
522 |
query/maxRead
|
|
sl@0
|
523 |
read
|
|
sl@0
|
524 |
query/maxRead
|
|
sl@0
|
525 |
read
|
|
sl@0
|
526 |
query/maxRead
|
|
sl@0
|
527 |
flush/read
|
|
sl@0
|
528 |
delete/read
|
|
sl@0
|
529 |
--------
|
|
sl@0
|
530 |
create/write
|
|
sl@0
|
531 |
write
|
|
sl@0
|
532 |
write
|
|
sl@0
|
533 |
write
|
|
sl@0
|
534 |
write
|
|
sl@0
|
535 |
write
|
|
sl@0
|
536 |
write
|
|
sl@0
|
537 |
write
|
|
sl@0
|
538 |
write
|
|
sl@0
|
539 |
flush/write
|
|
sl@0
|
540 |
delete/write}
|
|
sl@0
|
541 |
|
|
sl@0
|
542 |
test iogt-2.2 {basic I/O, data trail} {testchannel unixOnly} {
|
|
sl@0
|
543 |
set fin [open $path(dummy) r]
|
|
sl@0
|
544 |
set fout [open $path(dummyout) w]
|
|
sl@0
|
545 |
|
|
sl@0
|
546 |
set ain [list] ; set aout [list]
|
|
sl@0
|
547 |
audit_flow ain -attach $fin
|
|
sl@0
|
548 |
audit_flow aout -attach $fout
|
|
sl@0
|
549 |
|
|
sl@0
|
550 |
fconfigure $fin -buffersize 10
|
|
sl@0
|
551 |
fconfigure $fout -buffersize 10
|
|
sl@0
|
552 |
|
|
sl@0
|
553 |
fcopy $fin $fout
|
|
sl@0
|
554 |
|
|
sl@0
|
555 |
close $fin
|
|
sl@0
|
556 |
close $fout
|
|
sl@0
|
557 |
|
|
sl@0
|
558 |
set res "[join $ain \n]\n--------\n[join $aout \n]"
|
|
sl@0
|
559 |
} {create/read {} *ignored*
|
|
sl@0
|
560 |
query/maxRead {} -1
|
|
sl@0
|
561 |
read abcdefghij abcdefghij
|
|
sl@0
|
562 |
query/maxRead {} -1
|
|
sl@0
|
563 |
read klmnopqrst klmnopqrst
|
|
sl@0
|
564 |
query/maxRead {} -1
|
|
sl@0
|
565 |
read uvwxyz0123 uvwxyz0123
|
|
sl@0
|
566 |
query/maxRead {} -1
|
|
sl@0
|
567 |
read 456789,./? 456789,./?
|
|
sl@0
|
568 |
query/maxRead {} -1
|
|
sl@0
|
569 |
read {><;'\|":[]} {><;'\|":[]}
|
|
sl@0
|
570 |
query/maxRead {} -1
|
|
sl@0
|
571 |
read {\}\{`~!@#$} {\}\{`~!@#$}
|
|
sl@0
|
572 |
query/maxRead {} -1
|
|
sl@0
|
573 |
read %^&*()_+-= %^&*()_+-=
|
|
sl@0
|
574 |
query/maxRead {} -1
|
|
sl@0
|
575 |
read {
|
|
sl@0
|
576 |
} {
|
|
sl@0
|
577 |
}
|
|
sl@0
|
578 |
query/maxRead {} -1
|
|
sl@0
|
579 |
flush/read {} {}
|
|
sl@0
|
580 |
delete/read {} *ignored*
|
|
sl@0
|
581 |
--------
|
|
sl@0
|
582 |
create/write {} *ignored*
|
|
sl@0
|
583 |
write abcdefghij abcdefghij
|
|
sl@0
|
584 |
write klmnopqrst klmnopqrst
|
|
sl@0
|
585 |
write uvwxyz0123 uvwxyz0123
|
|
sl@0
|
586 |
write 456789,./? 456789,./?
|
|
sl@0
|
587 |
write {><;'\|":[]} {><;'\|":[]}
|
|
sl@0
|
588 |
write {\}\{`~!@#$} {\}\{`~!@#$}
|
|
sl@0
|
589 |
write %^&*()_+-= %^&*()_+-=
|
|
sl@0
|
590 |
write {
|
|
sl@0
|
591 |
} {
|
|
sl@0
|
592 |
}
|
|
sl@0
|
593 |
flush/write {} {}
|
|
sl@0
|
594 |
delete/write {} *ignored*}
|
|
sl@0
|
595 |
|
|
sl@0
|
596 |
|
|
sl@0
|
597 |
test iogt-2.3 {basic I/O, mixed trail} {testchannel unixOnly} {
|
|
sl@0
|
598 |
set fin [open $path(dummy) r]
|
|
sl@0
|
599 |
set fout [open $path(dummyout) w]
|
|
sl@0
|
600 |
|
|
sl@0
|
601 |
set trail [list]
|
|
sl@0
|
602 |
audit_flow trail -attach $fin
|
|
sl@0
|
603 |
audit_flow trail -attach $fout
|
|
sl@0
|
604 |
|
|
sl@0
|
605 |
fconfigure $fin -buffersize 20
|
|
sl@0
|
606 |
fconfigure $fout -buffersize 10
|
|
sl@0
|
607 |
|
|
sl@0
|
608 |
fcopy $fin $fout
|
|
sl@0
|
609 |
|
|
sl@0
|
610 |
close $fin
|
|
sl@0
|
611 |
close $fout
|
|
sl@0
|
612 |
|
|
sl@0
|
613 |
join $trail \n
|
|
sl@0
|
614 |
} {create/read {} *ignored*
|
|
sl@0
|
615 |
create/write {} *ignored*
|
|
sl@0
|
616 |
query/maxRead {} -1
|
|
sl@0
|
617 |
read abcdefghijklmnopqrst abcdefghijklmnopqrst
|
|
sl@0
|
618 |
write abcdefghij abcdefghij
|
|
sl@0
|
619 |
write klmnopqrst klmnopqrst
|
|
sl@0
|
620 |
query/maxRead {} -1
|
|
sl@0
|
621 |
read uvwxyz0123456789,./? uvwxyz0123456789,./?
|
|
sl@0
|
622 |
write uvwxyz0123 uvwxyz0123
|
|
sl@0
|
623 |
write 456789,./? 456789,./?
|
|
sl@0
|
624 |
query/maxRead {} -1
|
|
sl@0
|
625 |
read {><;'\|":[]\}\{`~!@#$} {><;'\|":[]\}\{`~!@#$}
|
|
sl@0
|
626 |
write {><;'\|":[]} {><;'\|":[]}
|
|
sl@0
|
627 |
write {\}\{`~!@#$} {\}\{`~!@#$}
|
|
sl@0
|
628 |
query/maxRead {} -1
|
|
sl@0
|
629 |
read {%^&*()_+-=
|
|
sl@0
|
630 |
} {%^&*()_+-=
|
|
sl@0
|
631 |
}
|
|
sl@0
|
632 |
query/maxRead {} -1
|
|
sl@0
|
633 |
flush/read {} {}
|
|
sl@0
|
634 |
write %^&*()_+-= %^&*()_+-=
|
|
sl@0
|
635 |
write {
|
|
sl@0
|
636 |
} {
|
|
sl@0
|
637 |
}
|
|
sl@0
|
638 |
delete/read {} *ignored*
|
|
sl@0
|
639 |
flush/write {} {}
|
|
sl@0
|
640 |
delete/write {} *ignored*}
|
|
sl@0
|
641 |
|
|
sl@0
|
642 |
|
|
sl@0
|
643 |
test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
|
|
sl@0
|
644 |
{testchannel unknownFailure} {
|
|
sl@0
|
645 |
# This test to check the validity of aquired Tcl_Channel references is
|
|
sl@0
|
646 |
# not possible because even a backgrounded fcopy will immediately start
|
|
sl@0
|
647 |
# to copy data, without waiting for the event loop. This is done only in
|
|
sl@0
|
648 |
# case of an underflow on the read size!. So stacking transforms after the
|
|
sl@0
|
649 |
# fcopy will miss information, or are not used at all.
|
|
sl@0
|
650 |
#
|
|
sl@0
|
651 |
# I was able to circumvent this by using the echo.tcl server with a big
|
|
sl@0
|
652 |
# delay, causing the fcopy to underflow immediately.
|
|
sl@0
|
653 |
|
|
sl@0
|
654 |
proc DoneCopy {n {err {}}} {
|
|
sl@0
|
655 |
variable copy ; set copy 1
|
|
sl@0
|
656 |
}
|
|
sl@0
|
657 |
|
|
sl@0
|
658 |
set fin [open $path(dummy) r]
|
|
sl@0
|
659 |
|
|
sl@0
|
660 |
fevent 1000 500 {20 20 20 10 1 1} {
|
|
sl@0
|
661 |
close $fin
|
|
sl@0
|
662 |
|
|
sl@0
|
663 |
set fout [open dummyout w]
|
|
sl@0
|
664 |
|
|
sl@0
|
665 |
flush $sock ; # now, or fcopy will error us out
|
|
sl@0
|
666 |
# But the 1 second delay should be enough to
|
|
sl@0
|
667 |
# initialize everything else here.
|
|
sl@0
|
668 |
|
|
sl@0
|
669 |
fcopy $sock $fout -command [namespace code DoneCopy]
|
|
sl@0
|
670 |
|
|
sl@0
|
671 |
# transform after fcopy got its handles !
|
|
sl@0
|
672 |
# They should be still valid for fcopy.
|
|
sl@0
|
673 |
|
|
sl@0
|
674 |
set trail [list]
|
|
sl@0
|
675 |
audit_ops trail -attach $fout
|
|
sl@0
|
676 |
|
|
sl@0
|
677 |
vwait [namespace which -variable copy]
|
|
sl@0
|
678 |
} [read $fin] ; # {}
|
|
sl@0
|
679 |
|
|
sl@0
|
680 |
close $fout
|
|
sl@0
|
681 |
|
|
sl@0
|
682 |
rename DoneCopy {}
|
|
sl@0
|
683 |
|
|
sl@0
|
684 |
# Check result of copy.
|
|
sl@0
|
685 |
|
|
sl@0
|
686 |
set fin [open $path(dummy) r]
|
|
sl@0
|
687 |
set fout [open $path(dummyout) r]
|
|
sl@0
|
688 |
|
|
sl@0
|
689 |
set res [string equal [read $fin] [read $fout]]
|
|
sl@0
|
690 |
|
|
sl@0
|
691 |
close $fin
|
|
sl@0
|
692 |
close $fout
|
|
sl@0
|
693 |
|
|
sl@0
|
694 |
list $res $trail
|
|
sl@0
|
695 |
} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
|
|
sl@0
|
696 |
|
|
sl@0
|
697 |
|
|
sl@0
|
698 |
test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
|
|
sl@0
|
699 |
set fin [open $path(dummy) r]
|
|
sl@0
|
700 |
set data [read $fin]
|
|
sl@0
|
701 |
close $fin
|
|
sl@0
|
702 |
|
|
sl@0
|
703 |
set trail [list]
|
|
sl@0
|
704 |
set got [list]
|
|
sl@0
|
705 |
|
|
sl@0
|
706 |
proc Done {args} {
|
|
sl@0
|
707 |
variable stop
|
|
sl@0
|
708 |
set stop 1
|
|
sl@0
|
709 |
}
|
|
sl@0
|
710 |
|
|
sl@0
|
711 |
proc Get {sock} {
|
|
sl@0
|
712 |
variable trail
|
|
sl@0
|
713 |
variable got
|
|
sl@0
|
714 |
if {[eof $sock]} {
|
|
sl@0
|
715 |
Done
|
|
sl@0
|
716 |
lappend trail "xxxxxxxxxxxxx"
|
|
sl@0
|
717 |
close $sock
|
|
sl@0
|
718 |
return
|
|
sl@0
|
719 |
}
|
|
sl@0
|
720 |
lappend trail "vvvvvvvvvvvvv"
|
|
sl@0
|
721 |
lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
|
|
sl@0
|
722 |
lappend trail "============="
|
|
sl@0
|
723 |
#puts stdout $__ ; flush stdout
|
|
sl@0
|
724 |
#read $sock
|
|
sl@0
|
725 |
}
|
|
sl@0
|
726 |
|
|
sl@0
|
727 |
fevent 1000 500 {20 20 20 10 1} {
|
|
sl@0
|
728 |
audit_flow trail -attach $sock
|
|
sl@0
|
729 |
rblocks_t rbuf trail 23 -attach $sock
|
|
sl@0
|
730 |
|
|
sl@0
|
731 |
fileevent $sock readable [list Get $sock]
|
|
sl@0
|
732 |
|
|
sl@0
|
733 |
flush $sock ; # now, or fcopy will error us out
|
|
sl@0
|
734 |
# But the 1 second delay should be enough to
|
|
sl@0
|
735 |
# initialize everything else here.
|
|
sl@0
|
736 |
|
|
sl@0
|
737 |
vwait [namespace which -variable stop]
|
|
sl@0
|
738 |
} $data
|
|
sl@0
|
739 |
|
|
sl@0
|
740 |
|
|
sl@0
|
741 |
rename Done {}
|
|
sl@0
|
742 |
rename Get {}
|
|
sl@0
|
743 |
|
|
sl@0
|
744 |
join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
|
|
sl@0
|
745 |
} {[[]]
|
|
sl@0
|
746 |
[[abcdefghijklmnopqrstuvw]]
|
|
sl@0
|
747 |
[[xyz0123456789,./?><;'\|]]
|
|
sl@0
|
748 |
[[]]
|
|
sl@0
|
749 |
[[]]
|
|
sl@0
|
750 |
[[":[]\}\{`~!@#$%^&*()]]
|
|
sl@0
|
751 |
[[]]
|
|
sl@0
|
752 |
~~~~~~~~
|
|
sl@0
|
753 |
create/write {} *ignored*
|
|
sl@0
|
754 |
create/read {} *ignored*
|
|
sl@0
|
755 |
rblock | create/write {} {} | {}
|
|
sl@0
|
756 |
rblock | create/read {} {} | {}
|
|
sl@0
|
757 |
vvvvvvvvvvvvv
|
|
sl@0
|
758 |
rblock | query/maxRead {} -1 | {}
|
|
sl@0
|
759 |
query/maxRead {} -1
|
|
sl@0
|
760 |
read abcdefghijklmnopqrstu abcdefghijklmnopqrstu
|
|
sl@0
|
761 |
query/maxRead {} -1
|
|
sl@0
|
762 |
rblock | {read 23 21 :- 0} abcdefghijklmnopqrstu {} | abcdefghijklmnopqrstu
|
|
sl@0
|
763 |
rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
|
|
sl@0
|
764 |
query/maxRead {} -1
|
|
sl@0
|
765 |
got: {[[]]}
|
|
sl@0
|
766 |
=============
|
|
sl@0
|
767 |
vvvvvvvvvvvvv
|
|
sl@0
|
768 |
rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
|
|
sl@0
|
769 |
query/maxRead {} -1
|
|
sl@0
|
770 |
read vwxyz0123456789,./?>< vwxyz0123456789,./?><
|
|
sl@0
|
771 |
query/maxRead {} -1
|
|
sl@0
|
772 |
rblock | {read 23 42 :- 23} vwxyz0123456789,./?>< abcdefghijklmnopqrstuvw | xyz0123456789,./?><
|
|
sl@0
|
773 |
rblock | query/maxRead {} -1 | xyz0123456789,./?><
|
|
sl@0
|
774 |
query/maxRead {} -1
|
|
sl@0
|
775 |
got: {[[]]} {[[abcdefghijklmnopqrstuvw]]}
|
|
sl@0
|
776 |
=============
|
|
sl@0
|
777 |
vvvvvvvvvvvvv
|
|
sl@0
|
778 |
rblock | query/maxRead {} -1 | xyz0123456789,./?><
|
|
sl@0
|
779 |
query/maxRead {} -1
|
|
sl@0
|
780 |
read {;'\|":[]\}\{`~!@#$%^&} {;'\|":[]\}\{`~!@#$%^&}
|
|
sl@0
|
781 |
query/maxRead {} -1
|
|
sl@0
|
782 |
rblock | {read 23 40 :- 23} {;'\|":[]\}\{`~!@#$%^&} {xyz0123456789,./?><;'\|} | {":[]\}\{`~!@#$%^&}
|
|
sl@0
|
783 |
rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
|
|
sl@0
|
784 |
query/maxRead {} -1
|
|
sl@0
|
785 |
got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]}
|
|
sl@0
|
786 |
=============
|
|
sl@0
|
787 |
vvvvvvvvvvvvv
|
|
sl@0
|
788 |
rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
|
|
sl@0
|
789 |
query/maxRead {} -1
|
|
sl@0
|
790 |
read *( *(
|
|
sl@0
|
791 |
query/maxRead {} -1
|
|
sl@0
|
792 |
rblock | {read 23 19 :- 0} *( {} | {":[]\}\{`~!@#$%^&*(}
|
|
sl@0
|
793 |
rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
|
|
sl@0
|
794 |
query/maxRead {} -1
|
|
sl@0
|
795 |
got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]}
|
|
sl@0
|
796 |
=============
|
|
sl@0
|
797 |
vvvvvvvvvvvvv
|
|
sl@0
|
798 |
rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
|
|
sl@0
|
799 |
query/maxRead {} -1
|
|
sl@0
|
800 |
read ) )
|
|
sl@0
|
801 |
query/maxRead {} -1
|
|
sl@0
|
802 |
rblock | {read 23 20 :- 0} ) {} | {":[]\}\{`~!@#$%^&*()}
|
|
sl@0
|
803 |
rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
|
|
sl@0
|
804 |
query/maxRead {} -1
|
|
sl@0
|
805 |
got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]}
|
|
sl@0
|
806 |
=============
|
|
sl@0
|
807 |
vvvvvvvvvvvvv
|
|
sl@0
|
808 |
rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
|
|
sl@0
|
809 |
query/maxRead {} -1
|
|
sl@0
|
810 |
flush/read {} {}
|
|
sl@0
|
811 |
rblock | flush/read {} {":[]\}\{`~!@#$%^&*()} | {}
|
|
sl@0
|
812 |
rblock | query/maxRead {} -1 | {}
|
|
sl@0
|
813 |
query/maxRead {} -1
|
|
sl@0
|
814 |
got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]}
|
|
sl@0
|
815 |
=============
|
|
sl@0
|
816 |
vvvvvvvvvvvvv
|
|
sl@0
|
817 |
rblock | query/maxRead {} -1 | {}
|
|
sl@0
|
818 |
query/maxRead {} -1
|
|
sl@0
|
819 |
got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} {[[]]}
|
|
sl@0
|
820 |
xxxxxxxxxxxxx
|
|
sl@0
|
821 |
rblock | flush/write {} {} | {}
|
|
sl@0
|
822 |
rblock | delete/write {} {} | {}
|
|
sl@0
|
823 |
rblock | delete/read {} {} | {}
|
|
sl@0
|
824 |
flush/write {} {}
|
|
sl@0
|
825 |
delete/write {} *ignored*
|
|
sl@0
|
826 |
delete/read {} *ignored*} ; # catch unescaped quote "
|
|
sl@0
|
827 |
|
|
sl@0
|
828 |
|
|
sl@0
|
829 |
test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
|
|
sl@0
|
830 |
set fin [open $path(dummy) r]
|
|
sl@0
|
831 |
set fout [open $path(dummyout) w]
|
|
sl@0
|
832 |
|
|
sl@0
|
833 |
set trail [list]
|
|
sl@0
|
834 |
|
|
sl@0
|
835 |
audit_flow trail -attach $fin
|
|
sl@0
|
836 |
stopafter_audit d trail 20 -attach $fin
|
|
sl@0
|
837 |
audit_flow trail -attach $fout
|
|
sl@0
|
838 |
|
|
sl@0
|
839 |
fconfigure $fin -buffersize 20
|
|
sl@0
|
840 |
fconfigure $fout -buffersize 10
|
|
sl@0
|
841 |
|
|
sl@0
|
842 |
fcopy $fin $fout
|
|
sl@0
|
843 |
testchannel unstack $fin
|
|
sl@0
|
844 |
|
|
sl@0
|
845 |
# now copy the rest in the channel
|
|
sl@0
|
846 |
lappend trail {**after unstack**}
|
|
sl@0
|
847 |
|
|
sl@0
|
848 |
fcopy $fin $fout
|
|
sl@0
|
849 |
|
|
sl@0
|
850 |
close $fin
|
|
sl@0
|
851 |
close $fout
|
|
sl@0
|
852 |
|
|
sl@0
|
853 |
join $trail \n
|
|
sl@0
|
854 |
} {create/read {} *ignored*
|
|
sl@0
|
855 |
counter:create/read {} {}
|
|
sl@0
|
856 |
create/write {} *ignored*
|
|
sl@0
|
857 |
counter:query/maxRead {} 20
|
|
sl@0
|
858 |
query/maxRead {} -1
|
|
sl@0
|
859 |
read {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
|
|
sl@0
|
860 |
} {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
|
|
sl@0
|
861 |
}
|
|
sl@0
|
862 |
query/maxRead {} -1
|
|
sl@0
|
863 |
flush/read {} {}
|
|
sl@0
|
864 |
counter:read abcdefghijklmnopqrst abcdefghijklmnopqrst
|
|
sl@0
|
865 |
write abcdefghij abcdefghij
|
|
sl@0
|
866 |
write klmnopqrst klmnopqrst
|
|
sl@0
|
867 |
counter:query/maxRead {} 0
|
|
sl@0
|
868 |
counter:flush/read {} {}
|
|
sl@0
|
869 |
counter:delete/read {} {}
|
|
sl@0
|
870 |
**after unstack**
|
|
sl@0
|
871 |
query/maxRead {} -1
|
|
sl@0
|
872 |
write uvwxyz0123 uvwxyz0123
|
|
sl@0
|
873 |
write 456789,./? 456789,./?
|
|
sl@0
|
874 |
write {><;'\|":[]} {><;'\|":[]}
|
|
sl@0
|
875 |
write {\}\{`~!@#$} {\}\{`~!@#$}
|
|
sl@0
|
876 |
write %^&*()_+-= %^&*()_+-=
|
|
sl@0
|
877 |
write {
|
|
sl@0
|
878 |
} {
|
|
sl@0
|
879 |
}
|
|
sl@0
|
880 |
query/maxRead {} -1
|
|
sl@0
|
881 |
delete/read {} *ignored*
|
|
sl@0
|
882 |
flush/write {} {}
|
|
sl@0
|
883 |
delete/write {} *ignored*}
|
|
sl@0
|
884 |
|
|
sl@0
|
885 |
|
|
sl@0
|
886 |
|
|
sl@0
|
887 |
|
|
sl@0
|
888 |
|
|
sl@0
|
889 |
proc constX {op data} {
|
|
sl@0
|
890 |
# replace anything coming in with a same-length string of x'es.
|
|
sl@0
|
891 |
switch -- $op {
|
|
sl@0
|
892 |
create/write - create/read -
|
|
sl@0
|
893 |
delete/write - delete/read -
|
|
sl@0
|
894 |
clear_read {;#ignore}
|
|
sl@0
|
895 |
flush/write - flush/read -
|
|
sl@0
|
896 |
write -
|
|
sl@0
|
897 |
read {
|
|
sl@0
|
898 |
return [string repeat x [string length $data]]
|
|
sl@0
|
899 |
}
|
|
sl@0
|
900 |
query/maxRead {return -1}
|
|
sl@0
|
901 |
}
|
|
sl@0
|
902 |
}
|
|
sl@0
|
903 |
|
|
sl@0
|
904 |
proc constx {-attach channel} {
|
|
sl@0
|
905 |
testchannel transform $channel -command [namespace code constX]
|
|
sl@0
|
906 |
}
|
|
sl@0
|
907 |
|
|
sl@0
|
908 |
test iogt-6.0 {Push back} testchannel {
|
|
sl@0
|
909 |
set f [open $path(dummy) r]
|
|
sl@0
|
910 |
|
|
sl@0
|
911 |
# contents of dummy = "abcdefghi..."
|
|
sl@0
|
912 |
read $f 3 ; # skip behind "abc"
|
|
sl@0
|
913 |
|
|
sl@0
|
914 |
constx -attach $f
|
|
sl@0
|
915 |
|
|
sl@0
|
916 |
# expect to get "xxx" from the transform because
|
|
sl@0
|
917 |
# of unread "def" input to transform which returns "xxx".
|
|
sl@0
|
918 |
#
|
|
sl@0
|
919 |
# Actually the IO layer pre-read the whole file and will
|
|
sl@0
|
920 |
# read "def" directly from the buffer without bothering
|
|
sl@0
|
921 |
# to consult the newly stacked transformation. This is
|
|
sl@0
|
922 |
# wrong.
|
|
sl@0
|
923 |
|
|
sl@0
|
924 |
set res [read $f 3]
|
|
sl@0
|
925 |
close $f
|
|
sl@0
|
926 |
set res
|
|
sl@0
|
927 |
} {xxx}
|
|
sl@0
|
928 |
|
|
sl@0
|
929 |
test iogt-6.1 {Push back and up} {testchannel knownBug} {
|
|
sl@0
|
930 |
set f [open $path(dummy) r]
|
|
sl@0
|
931 |
|
|
sl@0
|
932 |
# contents of dummy = "abcdefghi..."
|
|
sl@0
|
933 |
read $f 3 ; # skip behind "abc"
|
|
sl@0
|
934 |
|
|
sl@0
|
935 |
constx -attach $f
|
|
sl@0
|
936 |
set res [read $f 3]
|
|
sl@0
|
937 |
|
|
sl@0
|
938 |
testchannel unstack $f
|
|
sl@0
|
939 |
append res [read $f 3]
|
|
sl@0
|
940 |
close $f
|
|
sl@0
|
941 |
set res
|
|
sl@0
|
942 |
} {xxxghi}
|
|
sl@0
|
943 |
|
|
sl@0
|
944 |
|
|
sl@0
|
945 |
# cleanup
|
|
sl@0
|
946 |
foreach file [list dummy dummyout __echo_srv__.tcl] {
|
|
sl@0
|
947 |
removeFile $file
|
|
sl@0
|
948 |
}
|
|
sl@0
|
949 |
cleanupTests
|
|
sl@0
|
950 |
}
|
|
sl@0
|
951 |
namespace delete ::tcl::test::iogt
|
|
sl@0
|
952 |
return
|