os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/iogt.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/iogt.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,952 @@
1.4 +# -*- tcl -*-
1.5 +# Commands covered: transform, and stacking in general
1.6 +#
1.7 +# This file contains a collection of tests for Giot
1.8 +#
1.9 +# See the file "license.terms" for information on usage and redistribution
1.10 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.11 +#
1.12 +# Copyright (c) 2000 Ajuba Solutions.
1.13 +# Copyright (c) 2000 Andreas Kupries.
1.14 +# All rights reserved.
1.15 +#
1.16 +# RCS: @(#) $Id: iogt.test,v 1.7.2.1 2005/04/14 07:10:57 davygrvy Exp $
1.17 +
1.18 +if {[catch {package require tcltest 2.1}]} {
1.19 + puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
1.20 + return
1.21 +}
1.22 +namespace eval ::tcl::test::iogt {
1.23 +
1.24 + namespace import ::tcltest::cleanupTests
1.25 + namespace import ::tcltest::makeFile
1.26 + namespace import ::tcltest::removeFile
1.27 + namespace import ::tcltest::test
1.28 + namespace import ::tcltest::testConstraint
1.29 +
1.30 + testConstraint testchannel [llength [info commands testchannel]]
1.31 +
1.32 +set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
1.33 +} dummy]
1.34 +
1.35 +# " capture coloring of quotes
1.36 +
1.37 +set path(dummyout) [makeFile {} dummyout]
1.38 +
1.39 +set path(__echo_srv__.tcl) [makeFile {
1.40 +#!/usr/local/bin/tclsh
1.41 +# -*- tcl -*-
1.42 +# echo server
1.43 +#
1.44 +# arguments, options: port to listen on for connections.
1.45 +# delay till echo of first block
1.46 +# delay between blocks
1.47 +# blocksize ...
1.48 +
1.49 +set port [lindex $argv 0]
1.50 +set fdelay [lindex $argv 1]
1.51 +set idelay [lindex $argv 2]
1.52 +set bsizes [lrange $argv 3 end]
1.53 +set c 0
1.54 +
1.55 +proc newconn {sock rhost rport} {
1.56 + variable fdelay
1.57 + variable c
1.58 + incr c
1.59 + variable c$c
1.60 +
1.61 + #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout
1.62 +
1.63 + upvar 0 c$c conn
1.64 + set conn(after) {}
1.65 + set conn(state) 0
1.66 + set conn(size) 0
1.67 + set conn(data) ""
1.68 + set conn(delay) $fdelay
1.69 +
1.70 + fileevent $sock readable [list echoGet $c $sock]
1.71 + fconfigure $sock -translation binary -buffering none -blocking 0
1.72 +}
1.73 +
1.74 +proc echoGet {c sock} {
1.75 + variable fdelay
1.76 + variable c$c
1.77 + upvar 0 c$c conn
1.78 +
1.79 + if {[eof $sock]} {
1.80 + # one-shot echo
1.81 + exit
1.82 + }
1.83 +
1.84 + append conn(data) [read $sock]
1.85 +
1.86 + #puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout
1.87 +
1.88 + if {$conn(after) == {}} {
1.89 + set conn(after) [after $conn(delay) [list echoPut $c $sock]]
1.90 + }
1.91 +}
1.92 +
1.93 +proc echoPut {c sock} {
1.94 + variable idelay
1.95 + variable fdelay
1.96 + variable bsizes
1.97 + variable c$c
1.98 + upvar 0 c$c conn
1.99 +
1.100 + if {[string length $conn(data)] == 0} {
1.101 + #puts stdout "C $c $sock" ; flush stdout
1.102 + # auto terminate
1.103 + close $sock
1.104 + exit
1.105 + #set conn(delay) $fdelay
1.106 + return
1.107 + }
1.108 +
1.109 +
1.110 + set conn(delay) $idelay
1.111 +
1.112 + set n [lindex $bsizes $conn(size)]
1.113 +
1.114 + #puts stdout "P $c $sock $n >>" ; flush stdout
1.115 +
1.116 + #puts __________________________________________
1.117 + #parray conn
1.118 + #puts n=<$n>
1.119 +
1.120 +
1.121 + if {[string length $conn(data)] >= $n} {
1.122 + puts -nonewline $sock [string range $conn(data) 0 $n]
1.123 + set conn(data) [string range $conn(data) [incr n] end]
1.124 + }
1.125 +
1.126 + incr conn(size)
1.127 + if {$conn(size) >= [llength $bsizes]} {
1.128 + set conn(size) [expr {[llength $bsizes]-1}]
1.129 + }
1.130 +
1.131 + set conn(after) [after $conn(delay) [list echoPut $c $sock]]
1.132 +}
1.133 +
1.134 +#fileevent stdin readable {exit ;#cut}
1.135 +
1.136 +# main
1.137 +socket -server newconn $port
1.138 +vwait forever
1.139 +} __echo_srv__.tcl]
1.140 +
1.141 +
1.142 +########################################################################
1.143 +
1.144 +proc fevent {fdelay idelay blocks script data} {
1.145 + # start and initialize an echo server, prepare data
1.146 + # transmission, then hand over to the test script.
1.147 + # this has to start real transmission via 'flush'.
1.148 + # The server is stopped after completion of the test.
1.149 +
1.150 + # fixed port, not so good. lets hope for the best, for now.
1.151 + set port 4000
1.152 +
1.153 + eval exec tclsh __echo_srv__.tcl \
1.154 + $port $fdelay $idelay $blocks >@stdout &
1.155 +
1.156 + after 500
1.157 +
1.158 + #puts stdout "> $port" ; flush stdout
1.159 +
1.160 + set sk [socket localhost $port]
1.161 + fconfigure $sk \
1.162 + -blocking 0 \
1.163 + -buffering full \
1.164 + -buffersize [expr {10+[llength $data]}]
1.165 +
1.166 + puts -nonewline $sk $data
1.167 +
1.168 + # The channel is prepared to go off.
1.169 +
1.170 + #puts stdout ">>>>>" ; flush stdout
1.171 +
1.172 + uplevel #0 set sock $sk
1.173 + set res [uplevel #0 $script]
1.174 +
1.175 + catch {close $sk}
1.176 + return $res
1.177 +}
1.178 +
1.179 +# --------------------------------------------------------------
1.180 +# utility transformations ...
1.181 +
1.182 +proc id {op data} {
1.183 + switch -- $op {
1.184 + create/write -
1.185 + create/read -
1.186 + delete/write -
1.187 + delete/read -
1.188 + clear_read {;#ignore}
1.189 + flush/write -
1.190 + flush/read -
1.191 + write -
1.192 + read {
1.193 + return $data
1.194 + }
1.195 + query/maxRead {return -1}
1.196 + }
1.197 +}
1.198 +
1.199 +proc id_optrail {var op data} {
1.200 + variable $var
1.201 + upvar 0 $var trail
1.202 +
1.203 + lappend trail $op
1.204 +
1.205 + switch -- $op {
1.206 + create/write - create/read -
1.207 + delete/write - delete/read -
1.208 + flush/read -
1.209 + clear/read { #ignore }
1.210 + flush/write -
1.211 + write -
1.212 + read {
1.213 + return $data
1.214 + }
1.215 + query/maxRead {
1.216 + return -1
1.217 + }
1.218 + default {
1.219 + lappend trail "error $op"
1.220 + error $op
1.221 + }
1.222 + }
1.223 +}
1.224 +
1.225 +
1.226 +proc id_fulltrail {var op data} {
1.227 + variable $var
1.228 + upvar 0 $var trail
1.229 +
1.230 + #puts stdout ">> $var $op $data" ; flush stdout
1.231 +
1.232 + switch -- $op {
1.233 + create/write - create/read -
1.234 + delete/write - delete/read -
1.235 + clear_read {
1.236 + set res *ignored*
1.237 + }
1.238 + flush/write - flush/read -
1.239 + write -
1.240 + read {
1.241 + set res $data
1.242 + }
1.243 + query/maxRead {
1.244 + set res -1
1.245 + }
1.246 + }
1.247 +
1.248 + #catch {puts stdout "\t>* $res" ; flush stdout}
1.249 + #catch {puts stdout "x$res"} msg
1.250 +
1.251 + lappend trail [list $op $data $res]
1.252 + return $res
1.253 +}
1.254 +
1.255 +proc counter {var op data} {
1.256 + variable $var
1.257 + upvar 0 $var n
1.258 +
1.259 + switch -- $op {
1.260 + create/write - create/read -
1.261 + delete/write - delete/read -
1.262 + clear_read {;#ignore}
1.263 + flush/write - flush/read {return {}}
1.264 + write {
1.265 + return $data
1.266 + }
1.267 + read {
1.268 + if {$n > 0} {
1.269 + incr n -[string length $data]
1.270 + if {$n < 0} {
1.271 + set n 0
1.272 + }
1.273 + }
1.274 + return $data
1.275 + }
1.276 + query/maxRead {
1.277 + return $n
1.278 + }
1.279 + }
1.280 +}
1.281 +
1.282 +
1.283 +proc counter_audit {var vtrail op data} {
1.284 + variable $var
1.285 + variable $vtrail
1.286 + upvar 0 $var n $vtrail trail
1.287 +
1.288 + switch -- $op {
1.289 + create/write - create/read -
1.290 + delete/write - delete/read -
1.291 + clear_read {
1.292 + set res {}
1.293 + }
1.294 + flush/write - flush/read {
1.295 + set res {}
1.296 + }
1.297 + write {
1.298 + set res $data
1.299 + }
1.300 + read {
1.301 + if {$n > 0} {
1.302 + incr n -[string length $data]
1.303 + if {$n < 0} {
1.304 + set n 0
1.305 + }
1.306 + }
1.307 + set res $data
1.308 + }
1.309 + query/maxRead {
1.310 + set res $n
1.311 + }
1.312 + }
1.313 +
1.314 + lappend trail [list counter:$op $data $res]
1.315 + return $res
1.316 +}
1.317 +
1.318 +
1.319 +proc rblocks {var vtrail n op data} {
1.320 + variable $var
1.321 + variable $vtrail
1.322 + upvar 0 $var buf $vtrail trail
1.323 +
1.324 + set res {}
1.325 +
1.326 + switch -- $op {
1.327 + create/write - create/read -
1.328 + delete/write - delete/read -
1.329 + clear_read {
1.330 + set buf {}
1.331 + }
1.332 + flush/write {
1.333 + }
1.334 + flush/read {
1.335 + set res $buf
1.336 + set buf {}
1.337 + }
1.338 + write {
1.339 + set data
1.340 + }
1.341 + read {
1.342 + append buf $data
1.343 +
1.344 + set b [expr {$n * ([string length $buf] / $n)}]
1.345 +
1.346 + append op " $n [string length $buf] :- $b"
1.347 +
1.348 + set res [string range $buf 0 [incr b -1]]
1.349 + set buf [string range $buf [incr b] end]
1.350 + #return $res
1.351 + }
1.352 + query/maxRead {
1.353 + set res -1
1.354 + }
1.355 + }
1.356 +
1.357 + lappend trail [list rblock | $op $data $res | $buf]
1.358 + return $res
1.359 +}
1.360 +
1.361 +
1.362 +# --------------------------------------------------------------
1.363 +# ... and convenience procedures to stack them
1.364 +
1.365 +proc identity {-attach channel} {
1.366 + testchannel transform $channel -command [namespace code id]
1.367 +}
1.368 +
1.369 +proc audit_ops {var -attach channel} {
1.370 + testchannel transform $channel -command [namespace code [list id_optrail $var]]
1.371 +}
1.372 +
1.373 +proc audit_flow {var -attach channel} {
1.374 + testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
1.375 +}
1.376 +
1.377 +proc stopafter {var n -attach channel} {
1.378 + variable $var
1.379 + upvar 0 $var vn
1.380 + set vn $n
1.381 + testchannel transform $channel -command [namespace code [list counter $var]]
1.382 +}
1.383 +
1.384 +proc stopafter_audit {var trail n -attach channel} {
1.385 + variable $var
1.386 + upvar 0 $var vn
1.387 + set vn $n
1.388 + testchannel transform $channel -command [namespace code [list counter_audit $var $trail]]
1.389 +}
1.390 +
1.391 +proc rblocks_t {var trail n -attach channel} {
1.392 + testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]]
1.393 +}
1.394 +
1.395 +# --------------------------------------------------------------
1.396 +# serialize an array, with keys in sorted order.
1.397 +
1.398 +proc array_sget {v} {
1.399 + upvar $v a
1.400 +
1.401 + set res [list]
1.402 + foreach n [lsort [array names a]] {
1.403 + lappend res $n $a($n)
1.404 + }
1.405 + set res
1.406 +}
1.407 +
1.408 +proc asort {alist} {
1.409 + # sort a list of key/value pairs by key, removes duplicates too.
1.410 +
1.411 + array set a $alist
1.412 + array_sget a
1.413 +}
1.414 +
1.415 +########################################################################
1.416 +
1.417 +test iogt-1.1 {stack/unstack} testchannel {
1.418 + set fh [open $path(dummy) r]
1.419 + identity -attach $fh
1.420 + testchannel unstack $fh
1.421 + close $fh
1.422 +} {}
1.423 +
1.424 +test iogt-1.2 {stack/close} testchannel {
1.425 + set fh [open $path(dummy) r]
1.426 + identity -attach $fh
1.427 + close $fh
1.428 +} {}
1.429 +
1.430 +test iogt-1.3 {stack/unstack, configuration, options} testchannel {
1.431 + set fh [open $path(dummy) r]
1.432 + set ca [asort [fconfigure $fh]]
1.433 + identity -attach $fh
1.434 + set cb [asort [fconfigure $fh]]
1.435 + testchannel unstack $fh
1.436 + set cc [asort [fconfigure $fh]]
1.437 + close $fh
1.438 +
1.439 + # With this system none of the buffering, translation and
1.440 + # encoding option may change their values with channels
1.441 + # stacked upon each other or not.
1.442 +
1.443 + # cb == ca == cc
1.444 +
1.445 + list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
1.446 +} {1 1 1}
1.447 +
1.448 +test iogt-1.4 {stack/unstack, configuration} testchannel {
1.449 + set fh [open $path(dummy) r]
1.450 + set ca [asort [fconfigure $fh]]
1.451 + identity -attach $fh
1.452 + fconfigure $fh \
1.453 + -buffering line \
1.454 + -translation cr \
1.455 + -encoding shiftjis
1.456 + testchannel unstack $fh
1.457 + set cc [asort [fconfigure $fh]]
1.458 +
1.459 + set res [list \
1.460 + [string equal $ca $cc] \
1.461 + [fconfigure $fh -buffering] \
1.462 + [fconfigure $fh -translation] \
1.463 + [fconfigure $fh -encoding] \
1.464 + ]
1.465 +
1.466 + close $fh
1.467 + set res
1.468 +} {0 line cr shiftjis}
1.469 +
1.470 +test iogt-2.0 {basic I/O going through transform} testchannel {
1.471 + set fin [open $path(dummy) r]
1.472 + set fout [open $path(dummyout) w]
1.473 +
1.474 + identity -attach $fin
1.475 + identity -attach $fout
1.476 +
1.477 + fcopy $fin $fout
1.478 +
1.479 + close $fin
1.480 + close $fout
1.481 +
1.482 + set fin [open $path(dummy) r]
1.483 + set fout [open $path(dummyout) r]
1.484 +
1.485 + set res [string equal [set in [read $fin]] [set out [read $fout]]]
1.486 + lappend res [string length $in] [string length $out]
1.487 +
1.488 + close $fin
1.489 + close $fout
1.490 +
1.491 + set res
1.492 +} {1 71 71}
1.493 +
1.494 +
1.495 +test iogt-2.1 {basic I/O, operation trail} {testchannel unixOnly} {
1.496 + set fin [open $path(dummy) r]
1.497 + set fout [open $path(dummyout) w]
1.498 +
1.499 + set ain [list] ; set aout [list]
1.500 + audit_ops ain -attach $fin
1.501 + audit_ops aout -attach $fout
1.502 +
1.503 + fconfigure $fin -buffersize 10
1.504 + fconfigure $fout -buffersize 10
1.505 +
1.506 + fcopy $fin $fout
1.507 +
1.508 + close $fin
1.509 + close $fout
1.510 +
1.511 + set res "[join $ain \n]\n--------\n[join $aout \n]"
1.512 +} {create/read
1.513 +query/maxRead
1.514 +read
1.515 +query/maxRead
1.516 +read
1.517 +query/maxRead
1.518 +read
1.519 +query/maxRead
1.520 +read
1.521 +query/maxRead
1.522 +read
1.523 +query/maxRead
1.524 +read
1.525 +query/maxRead
1.526 +read
1.527 +query/maxRead
1.528 +read
1.529 +query/maxRead
1.530 +flush/read
1.531 +delete/read
1.532 +--------
1.533 +create/write
1.534 +write
1.535 +write
1.536 +write
1.537 +write
1.538 +write
1.539 +write
1.540 +write
1.541 +write
1.542 +flush/write
1.543 +delete/write}
1.544 +
1.545 +test iogt-2.2 {basic I/O, data trail} {testchannel unixOnly} {
1.546 + set fin [open $path(dummy) r]
1.547 + set fout [open $path(dummyout) w]
1.548 +
1.549 + set ain [list] ; set aout [list]
1.550 + audit_flow ain -attach $fin
1.551 + audit_flow aout -attach $fout
1.552 +
1.553 + fconfigure $fin -buffersize 10
1.554 + fconfigure $fout -buffersize 10
1.555 +
1.556 + fcopy $fin $fout
1.557 +
1.558 + close $fin
1.559 + close $fout
1.560 +
1.561 + set res "[join $ain \n]\n--------\n[join $aout \n]"
1.562 +} {create/read {} *ignored*
1.563 +query/maxRead {} -1
1.564 +read abcdefghij abcdefghij
1.565 +query/maxRead {} -1
1.566 +read klmnopqrst klmnopqrst
1.567 +query/maxRead {} -1
1.568 +read uvwxyz0123 uvwxyz0123
1.569 +query/maxRead {} -1
1.570 +read 456789,./? 456789,./?
1.571 +query/maxRead {} -1
1.572 +read {><;'\|":[]} {><;'\|":[]}
1.573 +query/maxRead {} -1
1.574 +read {\}\{`~!@#$} {\}\{`~!@#$}
1.575 +query/maxRead {} -1
1.576 +read %^&*()_+-= %^&*()_+-=
1.577 +query/maxRead {} -1
1.578 +read {
1.579 +} {
1.580 +}
1.581 +query/maxRead {} -1
1.582 +flush/read {} {}
1.583 +delete/read {} *ignored*
1.584 +--------
1.585 +create/write {} *ignored*
1.586 +write abcdefghij abcdefghij
1.587 +write klmnopqrst klmnopqrst
1.588 +write uvwxyz0123 uvwxyz0123
1.589 +write 456789,./? 456789,./?
1.590 +write {><;'\|":[]} {><;'\|":[]}
1.591 +write {\}\{`~!@#$} {\}\{`~!@#$}
1.592 +write %^&*()_+-= %^&*()_+-=
1.593 +write {
1.594 +} {
1.595 +}
1.596 +flush/write {} {}
1.597 +delete/write {} *ignored*}
1.598 +
1.599 +
1.600 +test iogt-2.3 {basic I/O, mixed trail} {testchannel unixOnly} {
1.601 + set fin [open $path(dummy) r]
1.602 + set fout [open $path(dummyout) w]
1.603 +
1.604 + set trail [list]
1.605 + audit_flow trail -attach $fin
1.606 + audit_flow trail -attach $fout
1.607 +
1.608 + fconfigure $fin -buffersize 20
1.609 + fconfigure $fout -buffersize 10
1.610 +
1.611 + fcopy $fin $fout
1.612 +
1.613 + close $fin
1.614 + close $fout
1.615 +
1.616 + join $trail \n
1.617 +} {create/read {} *ignored*
1.618 +create/write {} *ignored*
1.619 +query/maxRead {} -1
1.620 +read abcdefghijklmnopqrst abcdefghijklmnopqrst
1.621 +write abcdefghij abcdefghij
1.622 +write klmnopqrst klmnopqrst
1.623 +query/maxRead {} -1
1.624 +read uvwxyz0123456789,./? uvwxyz0123456789,./?
1.625 +write uvwxyz0123 uvwxyz0123
1.626 +write 456789,./? 456789,./?
1.627 +query/maxRead {} -1
1.628 +read {><;'\|":[]\}\{`~!@#$} {><;'\|":[]\}\{`~!@#$}
1.629 +write {><;'\|":[]} {><;'\|":[]}
1.630 +write {\}\{`~!@#$} {\}\{`~!@#$}
1.631 +query/maxRead {} -1
1.632 +read {%^&*()_+-=
1.633 +} {%^&*()_+-=
1.634 +}
1.635 +query/maxRead {} -1
1.636 +flush/read {} {}
1.637 +write %^&*()_+-= %^&*()_+-=
1.638 +write {
1.639 +} {
1.640 +}
1.641 +delete/read {} *ignored*
1.642 +flush/write {} {}
1.643 +delete/write {} *ignored*}
1.644 +
1.645 +
1.646 +test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
1.647 + {testchannel unknownFailure} {
1.648 + # This test to check the validity of aquired Tcl_Channel references is
1.649 + # not possible because even a backgrounded fcopy will immediately start
1.650 + # to copy data, without waiting for the event loop. This is done only in
1.651 + # case of an underflow on the read size!. So stacking transforms after the
1.652 + # fcopy will miss information, or are not used at all.
1.653 + #
1.654 + # I was able to circumvent this by using the echo.tcl server with a big
1.655 + # delay, causing the fcopy to underflow immediately.
1.656 +
1.657 + proc DoneCopy {n {err {}}} {
1.658 + variable copy ; set copy 1
1.659 + }
1.660 +
1.661 + set fin [open $path(dummy) r]
1.662 +
1.663 + fevent 1000 500 {20 20 20 10 1 1} {
1.664 + close $fin
1.665 +
1.666 + set fout [open dummyout w]
1.667 +
1.668 + flush $sock ; # now, or fcopy will error us out
1.669 + # But the 1 second delay should be enough to
1.670 + # initialize everything else here.
1.671 +
1.672 + fcopy $sock $fout -command [namespace code DoneCopy]
1.673 +
1.674 + # transform after fcopy got its handles !
1.675 + # They should be still valid for fcopy.
1.676 +
1.677 + set trail [list]
1.678 + audit_ops trail -attach $fout
1.679 +
1.680 + vwait [namespace which -variable copy]
1.681 + } [read $fin] ; # {}
1.682 +
1.683 + close $fout
1.684 +
1.685 + rename DoneCopy {}
1.686 +
1.687 + # Check result of copy.
1.688 +
1.689 + set fin [open $path(dummy) r]
1.690 + set fout [open $path(dummyout) r]
1.691 +
1.692 + set res [string equal [read $fin] [read $fout]]
1.693 +
1.694 + close $fin
1.695 + close $fout
1.696 +
1.697 + list $res $trail
1.698 +} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
1.699 +
1.700 +
1.701 +test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
1.702 + set fin [open $path(dummy) r]
1.703 + set data [read $fin]
1.704 + close $fin
1.705 +
1.706 + set trail [list]
1.707 + set got [list]
1.708 +
1.709 + proc Done {args} {
1.710 + variable stop
1.711 + set stop 1
1.712 + }
1.713 +
1.714 + proc Get {sock} {
1.715 + variable trail
1.716 + variable got
1.717 + if {[eof $sock]} {
1.718 + Done
1.719 + lappend trail "xxxxxxxxxxxxx"
1.720 + close $sock
1.721 + return
1.722 + }
1.723 + lappend trail "vvvvvvvvvvvvv"
1.724 + lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
1.725 + lappend trail "============="
1.726 + #puts stdout $__ ; flush stdout
1.727 + #read $sock
1.728 + }
1.729 +
1.730 + fevent 1000 500 {20 20 20 10 1} {
1.731 + audit_flow trail -attach $sock
1.732 + rblocks_t rbuf trail 23 -attach $sock
1.733 +
1.734 + fileevent $sock readable [list Get $sock]
1.735 +
1.736 + flush $sock ; # now, or fcopy will error us out
1.737 + # But the 1 second delay should be enough to
1.738 + # initialize everything else here.
1.739 +
1.740 + vwait [namespace which -variable stop]
1.741 + } $data
1.742 +
1.743 +
1.744 + rename Done {}
1.745 + rename Get {}
1.746 +
1.747 + join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
1.748 +} {[[]]
1.749 +[[abcdefghijklmnopqrstuvw]]
1.750 +[[xyz0123456789,./?><;'\|]]
1.751 +[[]]
1.752 +[[]]
1.753 +[[":[]\}\{`~!@#$%^&*()]]
1.754 +[[]]
1.755 +~~~~~~~~
1.756 +create/write {} *ignored*
1.757 +create/read {} *ignored*
1.758 +rblock | create/write {} {} | {}
1.759 +rblock | create/read {} {} | {}
1.760 +vvvvvvvvvvvvv
1.761 +rblock | query/maxRead {} -1 | {}
1.762 +query/maxRead {} -1
1.763 +read abcdefghijklmnopqrstu abcdefghijklmnopqrstu
1.764 +query/maxRead {} -1
1.765 +rblock | {read 23 21 :- 0} abcdefghijklmnopqrstu {} | abcdefghijklmnopqrstu
1.766 +rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
1.767 +query/maxRead {} -1
1.768 + got: {[[]]}
1.769 +=============
1.770 +vvvvvvvvvvvvv
1.771 +rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
1.772 +query/maxRead {} -1
1.773 +read vwxyz0123456789,./?>< vwxyz0123456789,./?><
1.774 +query/maxRead {} -1
1.775 +rblock | {read 23 42 :- 23} vwxyz0123456789,./?>< abcdefghijklmnopqrstuvw | xyz0123456789,./?><
1.776 +rblock | query/maxRead {} -1 | xyz0123456789,./?><
1.777 +query/maxRead {} -1
1.778 + got: {[[]]} {[[abcdefghijklmnopqrstuvw]]}
1.779 +=============
1.780 +vvvvvvvvvvvvv
1.781 +rblock | query/maxRead {} -1 | xyz0123456789,./?><
1.782 +query/maxRead {} -1
1.783 +read {;'\|":[]\}\{`~!@#$%^&} {;'\|":[]\}\{`~!@#$%^&}
1.784 +query/maxRead {} -1
1.785 +rblock | {read 23 40 :- 23} {;'\|":[]\}\{`~!@#$%^&} {xyz0123456789,./?><;'\|} | {":[]\}\{`~!@#$%^&}
1.786 +rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
1.787 +query/maxRead {} -1
1.788 + got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]}
1.789 +=============
1.790 +vvvvvvvvvvvvv
1.791 +rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
1.792 +query/maxRead {} -1
1.793 +read *( *(
1.794 +query/maxRead {} -1
1.795 +rblock | {read 23 19 :- 0} *( {} | {":[]\}\{`~!@#$%^&*(}
1.796 +rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
1.797 +query/maxRead {} -1
1.798 + got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]}
1.799 +=============
1.800 +vvvvvvvvvvvvv
1.801 +rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
1.802 +query/maxRead {} -1
1.803 +read ) )
1.804 +query/maxRead {} -1
1.805 +rblock | {read 23 20 :- 0} ) {} | {":[]\}\{`~!@#$%^&*()}
1.806 +rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
1.807 +query/maxRead {} -1
1.808 + got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]}
1.809 +=============
1.810 +vvvvvvvvvvvvv
1.811 +rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
1.812 +query/maxRead {} -1
1.813 +flush/read {} {}
1.814 +rblock | flush/read {} {":[]\}\{`~!@#$%^&*()} | {}
1.815 +rblock | query/maxRead {} -1 | {}
1.816 +query/maxRead {} -1
1.817 + got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]}
1.818 +=============
1.819 +vvvvvvvvvvvvv
1.820 +rblock | query/maxRead {} -1 | {}
1.821 +query/maxRead {} -1
1.822 + got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} {[[]]}
1.823 +xxxxxxxxxxxxx
1.824 +rblock | flush/write {} {} | {}
1.825 +rblock | delete/write {} {} | {}
1.826 +rblock | delete/read {} {} | {}
1.827 +flush/write {} {}
1.828 +delete/write {} *ignored*
1.829 +delete/read {} *ignored*} ; # catch unescaped quote "
1.830 +
1.831 +
1.832 +test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
1.833 + set fin [open $path(dummy) r]
1.834 + set fout [open $path(dummyout) w]
1.835 +
1.836 + set trail [list]
1.837 +
1.838 + audit_flow trail -attach $fin
1.839 + stopafter_audit d trail 20 -attach $fin
1.840 + audit_flow trail -attach $fout
1.841 +
1.842 + fconfigure $fin -buffersize 20
1.843 + fconfigure $fout -buffersize 10
1.844 +
1.845 + fcopy $fin $fout
1.846 + testchannel unstack $fin
1.847 +
1.848 + # now copy the rest in the channel
1.849 + lappend trail {**after unstack**}
1.850 +
1.851 + fcopy $fin $fout
1.852 +
1.853 + close $fin
1.854 + close $fout
1.855 +
1.856 + join $trail \n
1.857 +} {create/read {} *ignored*
1.858 +counter:create/read {} {}
1.859 +create/write {} *ignored*
1.860 +counter:query/maxRead {} 20
1.861 +query/maxRead {} -1
1.862 +read {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
1.863 +} {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
1.864 +}
1.865 +query/maxRead {} -1
1.866 +flush/read {} {}
1.867 +counter:read abcdefghijklmnopqrst abcdefghijklmnopqrst
1.868 +write abcdefghij abcdefghij
1.869 +write klmnopqrst klmnopqrst
1.870 +counter:query/maxRead {} 0
1.871 +counter:flush/read {} {}
1.872 +counter:delete/read {} {}
1.873 +**after unstack**
1.874 +query/maxRead {} -1
1.875 +write uvwxyz0123 uvwxyz0123
1.876 +write 456789,./? 456789,./?
1.877 +write {><;'\|":[]} {><;'\|":[]}
1.878 +write {\}\{`~!@#$} {\}\{`~!@#$}
1.879 +write %^&*()_+-= %^&*()_+-=
1.880 +write {
1.881 +} {
1.882 +}
1.883 +query/maxRead {} -1
1.884 +delete/read {} *ignored*
1.885 +flush/write {} {}
1.886 +delete/write {} *ignored*}
1.887 +
1.888 +
1.889 +
1.890 +
1.891 +
1.892 +proc constX {op data} {
1.893 + # replace anything coming in with a same-length string of x'es.
1.894 + switch -- $op {
1.895 + create/write - create/read -
1.896 + delete/write - delete/read -
1.897 + clear_read {;#ignore}
1.898 + flush/write - flush/read -
1.899 + write -
1.900 + read {
1.901 + return [string repeat x [string length $data]]
1.902 + }
1.903 + query/maxRead {return -1}
1.904 + }
1.905 +}
1.906 +
1.907 +proc constx {-attach channel} {
1.908 + testchannel transform $channel -command [namespace code constX]
1.909 +}
1.910 +
1.911 +test iogt-6.0 {Push back} testchannel {
1.912 + set f [open $path(dummy) r]
1.913 +
1.914 + # contents of dummy = "abcdefghi..."
1.915 + read $f 3 ; # skip behind "abc"
1.916 +
1.917 + constx -attach $f
1.918 +
1.919 + # expect to get "xxx" from the transform because
1.920 + # of unread "def" input to transform which returns "xxx".
1.921 + #
1.922 + # Actually the IO layer pre-read the whole file and will
1.923 + # read "def" directly from the buffer without bothering
1.924 + # to consult the newly stacked transformation. This is
1.925 + # wrong.
1.926 +
1.927 + set res [read $f 3]
1.928 + close $f
1.929 + set res
1.930 +} {xxx}
1.931 +
1.932 +test iogt-6.1 {Push back and up} {testchannel knownBug} {
1.933 + set f [open $path(dummy) r]
1.934 +
1.935 + # contents of dummy = "abcdefghi..."
1.936 + read $f 3 ; # skip behind "abc"
1.937 +
1.938 + constx -attach $f
1.939 + set res [read $f 3]
1.940 +
1.941 + testchannel unstack $f
1.942 + append res [read $f 3]
1.943 + close $f
1.944 + set res
1.945 +} {xxxghi}
1.946 +
1.947 +
1.948 +# cleanup
1.949 +foreach file [list dummy dummyout __echo_srv__.tcl] {
1.950 + removeFile $file
1.951 +}
1.952 +cleanupTests
1.953 +}
1.954 +namespace delete ::tcl::test::iogt
1.955 +return