diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | tests/iogt.test | 129 |
2 files changed, 78 insertions, 57 deletions
@@ -1,3 +1,9 @@ +2002-04-17 Don Porter <dgp@users.sourceforge.net> + + * tests/iogt.test: Revised to run tests in a namespace, rather than + use the useless and buggy [saveState] and [restoreState] commands + of tcltest. Updated to use tcltest 2 as well. [Patch 544911] + 2002-04-16 Don Porter <dgp@users.sourceforge.net> * tests/io.test: Revised to run tests in a namespace, rather than diff --git a/tests/iogt.test b/tests/iogt.test index a737634..b083efb 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -10,31 +10,29 @@ # Copyright (c) 2000 Andreas Kupries. # All rights reserved. # -# RCS: @(#) $Id: iogt.test,v 1.3 2001/12/17 22:55:51 andreas_kupries Exp $ +# RCS: @(#) $Id: iogt.test,v 1.4 2002/04/17 23:03:14 dgp Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} - -if {[info commands testchannel] == ""} { - puts "Skipping io tests. This application does not seem to have the" - puts "testchannel command that is needed to run these tests." +if {[catch {package require tcltest 2}]} { + puts stderr "Skipping tests in [info script]. tcltest 2 required." return } +namespace eval ::tcl::test::iogt { -::tcltest::saveState + namespace import ::tcltest::cleanupTests + namespace import ::tcltest::makeFile + namespace import ::tcltest::removeFile + namespace import ::tcltest::test + namespace import ::tcltest::testConstraint -#::tcltest::makeFile contents name + testConstraint testchannel [llength [info commands testchannel]] -::tcltest::makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=} dummy +makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=} dummy # " capture coloring of quotes -::tcltest::makeFile {} dummyout +makeFile {} dummyout -::tcltest::makeFile { +makeFile { #!/usr/local/bin/tclsh # -*- tcl -*- # echo server @@ -51,12 +49,14 @@ set bsizes [lrange $argv 3 end] set c 0 proc newconn {sock rhost rport} { - global c fdelay + variable fdelay + variable c incr c + variable c$c #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout - upvar #0 c$c conn + upvar 0 c$c conn set conn(after) {} set conn(state) 0 set conn(size) 0 @@ -68,8 +68,9 @@ proc newconn {sock rhost rport} { } proc echoGet {c sock} { - global fdelay - upvar #0 c$c conn + variable fdelay + variable c$c + upvar 0 c$c conn if {[eof $sock]} { # one-shot echo @@ -86,8 +87,11 @@ proc echoGet {c sock} { } proc echoPut {c sock} { - global idelay fdelay bsizes - upvar #0 c$c conn + variable idelay + variable fdelay + variable bsizes + variable c$c + upvar 0 c$c conn if {[string length $conn(data)] == 0} { #puts stdout "C $c $sock" ; flush stdout @@ -189,7 +193,8 @@ proc id {op data} { } proc id_optrail {var op data} { - upvar #0 $var trail + variable $var + upvar 0 $var trail lappend trail $op @@ -215,7 +220,8 @@ proc id_optrail {var op data} { proc id_fulltrail {var op data} { - upvar #0 $var trail + variable $var + upvar 0 $var trail #puts stdout ">> $var $op $data" ; flush stdout @@ -243,7 +249,8 @@ proc id_fulltrail {var op data} { } proc counter {var op data} { - upvar #0 $var n + variable $var + upvar 0 $var n switch -- $op { create/write - create/read - @@ -270,7 +277,9 @@ proc counter {var op data} { proc counter_audit {var vtrail op data} { - upvar #0 $var n $vtrail trail + variable $var + variable $vtrail + upvar 0 $var n $vtrail trail switch -- $op { create/write - create/read - @@ -304,7 +313,9 @@ proc counter_audit {var vtrail op data} { proc rblocks {var vtrail n op data} { - upvar #0 $var buf $vtrail trail + variable $var + variable $vtrail + upvar 0 $var buf $vtrail trail set res {} @@ -348,31 +359,33 @@ proc rblocks {var vtrail n op data} { # ... and convenience procedures to stack them proc identity {-attach channel} { - testchannel transform $channel -command id + testchannel transform $channel -command [namespace code id] } proc audit_ops {var -attach channel} { - testchannel transform $channel -command [list id_optrail $var] + testchannel transform $channel -command [namespace code [list id_optrail $var]] } proc audit_flow {var -attach channel} { - testchannel transform $channel -command [list id_fulltrail $var] + testchannel transform $channel -command [namespace code [list id_fulltrail $var]] } proc stopafter {var n -attach channel} { - upvar #0 $var vn + variable $var + upvar 0 $var vn set vn $n - testchannel transform $channel -command [list counter $var] + testchannel transform $channel -command [namespace code [list counter $var]] } proc stopafter_audit {var trail n -attach channel} { - upvar #0 $var vn + variable $var + upvar 0 $var vn set vn $n - testchannel transform $channel -command [list counter_audit $var $trail] + testchannel transform $channel -command [namespace code [list counter_audit $var $trail]] } proc rblocks_t {var trail n -attach channel} { - testchannel transform $channel -command [list rblocks $var $trail $n] + testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]] } # -------------------------------------------------------------- @@ -398,20 +411,20 @@ proc asort {alist} { ######################################################################## -test iogt-1.1 {stack/unstack} { +test iogt-1.1 {stack/unstack} testchannel { set fh [open dummy r] identity -attach $fh testchannel unstack $fh close $fh } {} -test iogt-1.2 {stack/close} { +test iogt-1.2 {stack/close} testchannel { set fh [open dummy r] identity -attach $fh close $fh } {} -test iogt-1.3 {stack/unstack, configuration, options} { +test iogt-1.3 {stack/unstack, configuration, options} testchannel { set fh [open dummy r] set ca [asort [fconfigure $fh]] identity -attach $fh @@ -429,7 +442,7 @@ test iogt-1.3 {stack/unstack, configuration, options} { list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc] } {1 1 1} -test iogt-1.4 {stack/unstack, configuration} { +test iogt-1.4 {stack/unstack, configuration} testchannel { set fh [open dummy r] set ca [asort [fconfigure $fh]] identity -attach $fh @@ -451,7 +464,7 @@ test iogt-1.4 {stack/unstack, configuration} { set res } {0 line cr shiftjis} -test iogt-2.0 {basic I/O going through transform} { +test iogt-2.0 {basic I/O going through transform} testchannel { set fin [open dummy r] set fout [open dummyout w] @@ -476,7 +489,7 @@ test iogt-2.0 {basic I/O going through transform} { } {1 71 71} -test iogt-2.1 {basic I/O, operation trail} {unixOnly} { +test iogt-2.1 {basic I/O, operation trail} {testchannel unixOnly} { set fin [open dummy r] set fout [open dummyout w] @@ -526,7 +539,7 @@ write flush/write delete/write} -test iogt-2.2 {basic I/O, data trail} {unixOnly} { +test iogt-2.2 {basic I/O, data trail} {testchannel unixOnly} { set fin [open dummy r] set fout [open dummyout w] @@ -581,7 +594,7 @@ flush/write {} {} delete/write {} *ignored*} -test iogt-2.3 {basic I/O, mixed trail} {unixOnly} { +test iogt-2.3 {basic I/O, mixed trail} {testchannel unixOnly} { set fin [open dummy r] set fout [open dummyout w] @@ -628,7 +641,7 @@ delete/write {} *ignored*} test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ - {unknownFailure} { + {testchannel unknownFailure} { # This test to check the validity of aquired Tcl_Channel references is # not possible because even a backgrounded fcopy will immediately start # to copy data, without waiting for the event loop. This is done only in @@ -639,7 +652,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ # delay, causing the fcopy to underflow immediately. proc DoneCopy {n {err {}}} { - global copy ; set copy 1 + variable copy ; set copy 1 } set fin [open dummy r] @@ -653,7 +666,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ # But the 1 second delay should be enough to # initialize everything else here. - fcopy $sock $fout -command DoneCopy + fcopy $sock $fout -command [namespace code DoneCopy] # transform after fcopy got its handles ! # They should be still valid for fcopy. @@ -661,7 +674,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ set trail [list] audit_ops trail -attach $fout - vwait copy + vwait [namespace which -variable copy] } [read $fin] ; # {} close $fout @@ -682,7 +695,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \ } {1 {create/write create/read write flush/write flush/read delete/write delete/read}} -test iogt-4.0 {fileevent readable, after transform} {unknownFailure} { +test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} { set fin [open dummy r] set data [read $fin] close $fin @@ -691,12 +704,13 @@ test iogt-4.0 {fileevent readable, after transform} {unknownFailure} { set got [list] proc Done {args} { - global stop + variable stop set stop 1 } proc Get {sock} { - global trail got + variable trail + variable got if {[eof $sock]} { Done lappend trail "xxxxxxxxxxxxx" @@ -720,7 +734,7 @@ test iogt-4.0 {fileevent readable, after transform} {unknownFailure} { # But the 1 second delay should be enough to # initialize everything else here. - vwait stop + vwait [namespace which -variable stop] } $data @@ -812,7 +826,7 @@ delete/write {} *ignored* delete/read {} *ignored*} ; # catch unescaped quote " -test iogt-5.0 {EOF simulation} {unknownFailure} { +test iogt-5.0 {EOF simulation} {testchannel unknownFailure} { set fin [open dummy r] set fout [open dummyout w] @@ -888,10 +902,10 @@ proc constX {op data} { } proc constx {-attach channel} { - testchannel transform $channel -command constX + testchannel transform $channel -command [namespace code constX] } -test iogt-6.0 {Push back} { +test iogt-6.0 {Push back} testchannel { set f [open dummy r] # contents of dummy = "abcdefghi..." @@ -912,7 +926,7 @@ test iogt-6.0 {Push back} { set res } {xxx} -test iogt-6.1 {Push back and up} {knownBug} { +test iogt-6.1 {Push back and up} {testchannel knownBug} { set f [open dummy r] # contents of dummy = "abcdefghi..." @@ -930,8 +944,9 @@ test iogt-6.1 {Push back and up} {knownBug} { # cleanup foreach file [list dummy dummyout __echo_srv__.tcl] { - ::tcltest::removeFile $file + removeFile $file +} +cleanupTests } -::tcltest::restoreState -::tcltest::cleanupTests +namespace delete ::tcl::test::iogt return |