diff options
| -rw-r--r-- | ChangeLog | 40 | ||||
| -rw-r--r-- | tests/ioCmd.test | 1417 | ||||
| -rw-r--r-- | win/tclWinSerial.c | 330 |
3 files changed, 660 insertions, 1127 deletions
@@ -1,38 +1,44 @@ +2005-10-31 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * win/tclWinSerial.c (SerialSetOptionProc): Cleaned up option parsing + to produce more informative error messages and separate error and + non-error code paths better. + * tests/ioCmd.test (iocmd-8-19): Updated. + 2005-10-29 Miguel Sofer <msofer@users.sf.net> - * generic/tclTrace.c (TraceVarProc): [Bug 1337229], partial - fix. Insure that a second call with TCL_TRACE_DESTROYED does not - lead to a second call to Tcl_EventuallyFree(). It is still true - that that second call should not happen, so the bug is not - completely fixed. - * tests/trace.test (test-18.3-4): added tests for bugs #1337229 - and 1338280. + * generic/tclTrace.c (TraceVarProc): [Bug 1337229], partial fix. + Ensure that a second call with TCL_TRACE_DESTROYED does not lead to a + second call to Tcl_EventuallyFree(). It is still true that that second + call should not happen, so the bug is not completely fixed. + * tests/trace.test (test-18.3-4): added tests for [Bug 1337229] and + [Bug 1338280]. 2005-10-23 Vince Darley <vincentdarley@sourceforge.net> - * generic/tclFileName.c: fix to memory leak in glob [Bug 1335006] - Obj leak detection and patch by Eric Melbardis. + * generic/tclFileName.c: fix to memory leak in glob [Bug 1335006] Obj + leak detection and patch by Eric Melbardis. * tests/fCmd.test: - * win/tclWinFile.c: where appropriate windows API is available, try - to set 'nlink' and 'ino' stat fields (previously they were always 0). + * win/tclWinFile.c: where appropriate windows API is available, try to + set 'nlink' and 'ino' stat fields (previously they were always 0). [Bug 1325803] 2005-10-22 Miguel Sofer <msofer@users.sf.net> * tests/foreach.test (foreach-8.1): added test for [Bug 1189274] - + 2005-10-22 Miguel Sofer <msofer@users.sf.net> - * generic/tclExecute.c (INST_INCR_*): fixed [Bug 1334570]. Obj - leak detection and patch by Eric Melbardis. + * generic/tclExecute.c (INST_INCR_*): fixed [Bug 1334570]. Obj leak + detection and patch by Eric Melbardis. 2005-10-21 Kevin B. Kenny <kennykb@acm.org> * generic/tclStrToD.c (RefineApproximation): Plugged a memory leak - where two intermediate results were not freed on one return path. - [Bug 1334461]. Thanks to Eric Melbardis for the patch. - + where two intermediate results were not freed on one return path. [Bug + 1334461]. Thanks to Eric Melbardis for the patch. + 2005-10-21 Donal K. Fellows <dkf@users.sf.net> * doc/binary.n: Clarify that virtually all code that uses the 'h' diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 2c95b13..7c018ae 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -13,14 +13,19 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioCmd.test,v 1.24 2005/08/24 17:56:24 andreas_kupries Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.25 2005/10/31 13:53:33 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2 namespace import -force ::tcltest::* } -testConstraint fcopy [llength [info commands fcopy]] +# Custom constraints used in this file +testConstraint fcopy [llength [info commands fcopy]] +testConstraint testchannel [llength [info commands testchannel]] +testConstraint testthread [llength [info commands testthread]] + +#---------------------------------------------------------------------- test iocmd-1.1 {puts command} { list [catch {puts} msg] $msg @@ -62,7 +67,6 @@ test iocmd-1.8 {puts command} { file size $path(test1) } 9 - test iocmd-2.1 {flush command} { list [catch {flush} msg] $msg } {1 {wrong # args: should be "flush channelId"}} @@ -250,14 +254,12 @@ test iocmd-8.11 {fconfigure command} { close $chan set res } {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} - test iocmd-8.12 {fconfigure command} { set chan [open $path(fconfigure.dummy) r] set res [list [catch {fconfigure $chan -b blarfo} msg] $msg] close $chan set res } {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} - test iocmd-8.13 {fconfigure command} { set chan [open $path(fconfigure.dummy) r] set res [list [catch {fconfigure $chan -buffer blarfo} msg] $msg] @@ -270,62 +272,75 @@ removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 - -proc iocmdSSETUP {} { - uplevel { - set srv [socket -server iocmdSRV 0] - set port [lindex [fconfigure $srv -sockname] 2] - proc iocmdSRV {sock ip port} {close $sock} - set cli [socket 127.0.0.1 $port] - } -} -proc iocmdSSHTDWN {} { - uplevel { - close $cli - close $srv - unset cli srv port - rename iocmdSRV {} - } -} - -test iocmd-8.15.1 {fconfigure command / tcp channel} {socket unixOrPc} { - iocmdSSETUP - set r [list [catch {fconfigure $cli -blah} msg] $msg] - iocmdSSHTDWN - set r -} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}} -test iocmd-8.16 {fconfigure command / tcp channel} {socket} { - iocmdSSETUP - set r [expr [lindex [fconfigure $cli -peername] 2]==$port] - iocmdSSHTDWN - set r -} 1 -test iocmd-8.17 {fconfigure command / tcp channel} {nonPortable} { - # It is possible that you don't get the connection reset by peer - # error but rather a valid answer. depends of the tcp implementation - iocmdSSETUP - update; - puts $cli "blah"; flush $cli; # that flush could/should fail too - update; - set r [catch {fconfigure $cli -peername} msg] - iocmdSSHTDWN - regsub -all {can([^:])+: } $r {} r; - set r -} 1 -test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unix} { - # might fail if /dev/ttya is unavailable - set tty [open /dev/ttya] - set r [list [catch {fconfigure $tty -blah blih} msg] $msg]; - close $tty; - set r; -} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}} -test iocmd-8.19 {fconfigure command / win tty channel} {nonPortable win} { - # might fail if com1 is unavailable - set tty [open com1] - set r [list [catch {fconfigure $tty -blah blih} msg] $msg]; - close $tty; - set r; -} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, or -pollinterval}} +test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup { + set srv [socket -server iocmdSRV 0] + set port [lindex [fconfigure $srv -sockname] 2] + proc iocmdSRV {sock ip port} {close $sock} + set cli [socket 127.0.0.1 $port] +} -body { + fconfigure $cli -blah +} -cleanup { + close $cli + close $srv + unset cli srv port + rename iocmdSRV {} +} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname} +test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup { + set srv [socket -server iocmdSRV 0] + set port [lindex [fconfigure $srv -sockname] 2] + proc iocmdSRV {sock ip port} {close $sock} + set cli [socket 127.0.0.1 $port] +} -body { + expr {[lindex [fconfigure $cli -peername] 2] == $port} +} -cleanup { + close $cli + close $srv + unset cli srv port + rename iocmdSRV {} +} -result 1 +test iocmd-8.17 {fconfigure command / tcp channel} -constraints nonPortable -setup { + set srv [socket -server iocmdSRV 0] + set port [lindex [fconfigure $srv -sockname] 2] + proc iocmdSRV {sock ip port} {close $sock} + set cli [socket 127.0.0.1 $port] +} -body { + # It is possible that you don't get the connection reset by peer + # error but rather a valid answer. Depends on the tcp implementation + update + puts $cli "blah" + flush $cli; # that flush could/should fail too + update + regsub -all {can([^:])+: } [catch {fconfigure $cli -peername} msg] {} +} -cleanup { + close $cli + close $srv + unset cli srv port + rename iocmdSRV {} +} -result 1 +test iocmd-8.18 {fconfigure command / unix tty channel} -constraints {nonPortable unix} -setup { + set tty "" +} -body { + # might fail if /dev/ttya is unavailable + set tty [open /dev/ttya] + fconfigure $tty -blah blih +} -cleanup { + if {$tty ne ""} { + close $tty + } +} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode} +test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable win} -setup { + set tty "" +} -body { + # might fail early if com1 is unavailable + set tty [open com1] + fconfigure $tty -blah blih +} -cleanup { + if {$tty ne ""} { + close $tty + } +} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar} +# TODO: Test parsing of serial channel options (nonportable, since requires an +# open channel to work with). test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $errorCode @@ -449,7 +464,7 @@ test iocmd-12.10 {POSIX open access modes: BINARY} { } 5 test iocmd-12.11 {POSIX open access modes: BINARY} { set f [open $path(test1) {WRONLY BINARY TRUNC}] - puts $f \u0248 ;# gets truncated to \u0048 + puts $f \u0248 ;# gets truncated to \u0048 close $f set f [open $path(test1) r] fconfigure $f -translation binary @@ -476,7 +491,7 @@ test iocmd-13.5 {errors in open command} { test iocmd-13.6 {errors in open command} { set msg [list [catch {open _non_existent_} msg] $msg $errorCode] regsub [file join {} _non_existent_] $msg "_non_existent_" msg - string tolower $msg + string tolower $msg } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}} test iocmd-13.7 {errors in open command} { list [catch {open $path(test1) b} msg] $msg @@ -541,10 +556,8 @@ test iocmd-15.5 {Tcl_FcopyObjCmd} {fcopy} { } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}} set path(test2) [makeFile {} test2] - set f [open $path(test1) w] close $f - set rfile [open $path(test1) r] set wfile [open $path(test2) w] @@ -580,7 +593,6 @@ test iocmd-20.0 {chan, wrong#args} { catch {chan} msg set msg } {wrong # args: should be "chan subcommand ?argument ...?"} - test iocmd-20.1 {chan, unknown method} { catch {chan foo} msg set msg @@ -593,120 +605,102 @@ test iocmd-21.0 {chan create, wrong#args, not enough} { catch {chan create} msg set msg } {wrong # args: should be "chan create mode cmdprefix"} - test iocmd-21.1 {chan create, wrong#args, too many} { catch {chan create a b c} msg set msg } {wrong # args: should be "chan create mode cmdprefix"} - test iocmd-21.2 {chan create, invalid r/w mode, empty} { proc foo {} {} catch {chan create {} foo} msg rename foo {} set msg } {bad mode list: is empty} - test iocmd-21.3 {chan create, invalid r/w mode, bad string} { proc foo {} {} catch {chan create {c} foo} msg rename foo {} set msg } {bad mode "c": must be read or write} - test iocmd-21.4 {chan create, bad handler, not a list} { catch {chan create {r w} "foo \{"} msg set msg } {unmatched open brace in list} - test iocmd-21.5 {chan create, bad handler, not a command} { catch {chan create {r w} foo} msg set msg } {Initialize failure: invalid command name "foo"} - test iocmd-21.6 {chan create, initialize failed, bad signature} { proc foo {} {} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: wrong # args: should be "foo"} - test iocmd-21.7 {chan create, initialize failed, bad signature} { proc foo {} {} catch {chan create {r w} ::foo} msg rename foo {} set msg } {Initialize failure: wrong # args: should be "::foo"} - test iocmd-21.8 {chan create, initialize failed, bad result, not a list} { proc foo {args} {return "\{"} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: unmatched open brace in list} - test iocmd-21.9 {chan create, initialize failed, bad result, not a list} { proc foo {args} {return \{\{\}} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: unmatched open brace in list} - test iocmd-21.10 {chan create, initialize failed, bad result, empty list} { proc foo {args} {} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: Not all required methods supported} - test iocmd-21.11 {chan create, initialize failed, bad result, bogus method name} { proc foo {args} {return 1} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: bad method "1": must be blocking, cget, cgetall, configure, finalize, initialize, read, seek, watch, or write} - test iocmd-21.12 {chan create, initialize failed, bad result, ambiguous method name} { proc foo {args} {return {a b c}} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: ambiguous method "c": must be blocking, cget, cgetall, configure, finalize, initialize, read, seek, watch, or write} - test iocmd-21.13 {chan create, initialize failed, bad result, required methods missing} { proc foo {args} {return {initialize finalize}} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: Not all required methods supported} - test iocmd-21.14 {chan create, initialize failed, bad result, mode/handler mismatch} { proc foo {args} {return {initialize finalize watch read}} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: Writing not supported, but requested} - test iocmd-21.15 {chan create, initialize failed, bad result, mode/handler mismatch} { proc foo {args} {return {initialize finalize watch write}} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: Reading not supported, but requested} - test iocmd-21.16 {chan create, initialize failed, bad result, cget(all) mismatch} { proc foo {args} {return {initialize finalize watch cget write read}} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: 'cgetall' not supported, but should be, as 'cget' is} - test iocmd-21.17 {chan create, initialize failed, bad result, cget(all) mismatch} { proc foo {args} {return {initialize finalize watch cgetall read write}} catch {chan create {r w} foo} msg rename foo {} set msg } {Initialize failure: 'cget' not supported, but should be, as 'cgetall' is} - test iocmd-21.18 {chan create, initialize ok, creates channel} -match glob -body { proc foo {args} { global res @@ -722,7 +716,6 @@ test iocmd-21.18 {chan create, initialize ok, creates channel} -match glob -body rename foo {} set res } -result {{} {initialize rc* {read write}} rc* {finalize rc*} {} {}} - test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match glob -body { proc foo {args} { global res @@ -741,8 +734,8 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g # --- --- --- --------- --------- --------- # Helper commands to record the arguments to handler methods. -proc note {item} {global res ; lappend res $item ; return} -proc track {} {upvar args item ; note $item; return} +proc note {item} {global res; lappend res $item; return} +proc track {} {upvar args item; note $item; return} proc notes {items} {foreach i $items {note $i}} # Helper command, canned result for 'initialize' method. @@ -753,14 +746,12 @@ proc init {args} { lappend args initialize finalize watch read write return -code return $args } - proc oninit {args} { upvar args hargs if {[lindex $hargs 0] ne "initialize"} {return} lappend args initialize finalize watch read write return -code return $args } - proc onfinal {} { upvar args hargs if {[lindex $hargs 0] ne "finalize"} {return} @@ -772,110 +763,81 @@ proc onfinal {} { test iocmd-22.1 {chan finalize, handler destruction has no effect on channel} -match glob -body { set res {} - proc foo {args} {track ; oninit; return} + proc foo {args} {track; oninit; return} note [set c [chan create {r w} foo]] - rename foo {} - note [file channels rc*] - note [catch {close $c} msg] ; note $msg + note [catch {close $c} msg]; note $msg note [file channels rc*] - set res } -result {{initialize rc* {read write}} rc* rc* 1 {invalid command name "foo"} {}} - test iocmd-22.2 {chan finalize, for close} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return {}} + proc foo {args} {track; oninit; return {}} note [set c [chan create {r w} foo]] - close $c - # Close deleted the channel. note [file channels rc*] - # Channel destruction does not kill handler command! note [info command foo] - rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo} - test iocmd-22.3 {chan finalize, for close, error, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -code error 5} + proc foo {args} {track; oninit; return -code error 5} note [set c [chan create {r w} foo]] - - note [catch {close $c} msg] ; note $msg + note [catch {close $c} msg]; note $msg # Channel is gone despite error. note [file channels rc*] - rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}} - test iocmd-22.4 {chan finalize, for close, error, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; error FOO} + proc foo {args} {track; oninit; error FOO} note [set c [chan create {r w} foo]] - - note [catch {close $c} msg] ; note $msg - + note [catch {close $c} msg]; note $msg rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO} - test iocmd-22.5 {chan finalize, for close, arbitrary result, ignored} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return SOMETHING} + proc foo {args} {track; oninit; return SOMETHING} note [set c [chan create {r w} foo]] - note [catch {close $c} msg]; note $msg - rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}} - test iocmd-22.6 {chan finalize, for close, break, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -code 3} + proc foo {args} {track; oninit; return -code 3} note [set c [chan create {r w} foo]] - - note [catch {close $c} msg] ; note $msg - + note [catch {close $c} msg]; note $msg rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}} - test iocmd-22.7 {chan finalize, for close, continue, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -code 4} + proc foo {args} {track; oninit; return -code 4} note [set c [chan create {r w} foo]] - - note [catch {close $c} msg] ; note $msg - + note [catch {close $c} msg]; note $msg rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}} - test iocmd-22.8 {chan finalize, for close, custom code, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -code 777 BANG} + proc foo {args} {track; oninit; return -code 777 BANG} note [set c [chan create {r w} foo]] - - note [catch {close $c} msg] ; note $msg - + note [catch {close $c} msg]; note $msg rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG} - test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -level 5 -code 777 BANG} + proc foo {args} {track; oninit; return -level 5 -code 777 BANG} note [set c [chan create {r w} foo]] - - note [catch {close $c} msg opt] ; note $msg ; note $opt - + note [catch {close $c} msg opt]; note $msg; note $opt rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} @@ -886,114 +848,95 @@ test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glo test iocmd-23.1 {chan read, regular data return} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return snarf } set c [chan create {r w} foo] - note [read $c 10] close $c - rename foo {} set res } -result {{read rc* 4096} {read rc* 4096} snarfsnarf} - test iocmd-23.2 {chan read, bad data return, to much} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return [string repeat snarf 1000] } set c [chan create {r w} foo] - - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c - rename foo {} set res } -result {{read rc* 4096} 1 {read delivered more than requested}} - test iocmd-23.3 {chan read, for non-readable channel} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track - note MUST_NOT_HAPPEN + oninit; onfinal; track; note MUST_NOT_HAPPEN } set c [chan create {w} foo] - - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c - rename foo {} set res } -result {1 {channel "rc*" wasn't opened for reading}} - test iocmd-23.4 {chan read, error return} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c - rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} - test iocmd-23.5 {chan read, break return is error} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c - rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} - test iocmd-23.6 {chan read, continue return is error} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c - rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} - test iocmd-23.7 {chan read, custom return is error} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -code 777 BOOM! } set c [chan create {r w} foo] - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c - rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} - test iocmd-23.8 {chan read, level is squashed} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -level 55 -code 777 BOOM! } set c [chan create {r w} foo] - note [catch {read $c 2} msg opt] ; note $msg ; note $opt + note [catch {read $c 2} msg opt]; note $msg; note $opt close $c - rename foo {} set res } -result {{read rc* 4096} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} @@ -1004,174 +947,136 @@ test iocmd-23.8 {chan read, level is squashed} -match glob -body { test iocmd-24.1 {chan write, regular write} -match glob -body { set res {} proc foo {args} { - oninit; onfinal ; track + oninit; onfinal; track set written [string length [lindex $args 2]] note $written return $written } set c [chan create {r w} foo] - - puts -nonewline $c snarf ; flush $c + puts -nonewline $c snarf; flush $c close $c - rename foo {} set res } -result {{write rc* snarf} 5} - test iocmd-24.2 {chan write, partial write is ok} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track set written [string length [lindex $args 2]] if {$written > 10} {set written [expr {$written / 2}]} note $written return $written } set c [chan create {r w} foo] - - puts -nonewline $c snarfsnarfsnarf ; flush $c + puts -nonewline $c snarfsnarfsnarf; flush $c close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8} - test iocmd-24.3 {chan write, failed write} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note -1 ; return -1} - + proc foo {args} {oninit; onfinal; track; note -1; return -1} set c [chan create {r w} foo] - puts -nonewline $c snarfsnarfsnarf ; flush $c + puts -nonewline $c snarfsnarfsnarf; flush $c close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} -1} - test iocmd-24.4 {chan write, non-writable channel} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r} foo] - - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] ; note $msg + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]; note $msg close $c - rename foo {} set res } -result {1 {channel "rc*" wasn't opened for writing}} - test iocmd-24.5 {chan write, bad result, more written than data} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return 10000} + proc foo {args} {oninit; onfinal; track; return 10000} set c [chan create {r w} foo] - - note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg + note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg close $c - rename foo {} set res } -result {{write rc* snarf} 1 {write wrote more than requested}} - test iocmd-24.6 {chan write, bad result, zero-length write} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return 0} + proc foo {args} {oninit; onfinal; track; return 0} set c [chan create {r w} foo] - - note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg + note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg close $c - rename foo {} set res } -result {{write rc* snarf} 1 {write wrote more than requested}} - test iocmd-24.7 {chan write, failed write, error return} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!} + proc foo {args} {oninit; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] - - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} - test iocmd-24.8 {chan write, failed write, error return} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; error BOOM!} + proc foo {args} {oninit; onfinal; track; error BOOM!} set c [chan create {r w} foo] - - notes [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + notes [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} - test iocmd-24.9 {chan write, failed write, break return is error} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code break BOOM!} + proc foo {args} {oninit; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] - - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} - test iocmd-24.10 {chan write, failed write, continue return is error} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code continue BOOM!} + proc foo {args} {oninit; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] - - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} - test iocmd-24.11 {chan write, failed write, custom return is error} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code 777 BOOM!} + proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!} set c [chan create {r w} foo] - - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} - test iocmd-24.12 {chan write, failed write, non-numeric return is error} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return BANG} + proc foo {args} {oninit; onfinal; track; return BANG} set c [chan create {r w} foo] - - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} - test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -level 55 -code 777 BOOM!} + proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!} set c [chan create {r w} foo] - - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg opt] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt] note $msg note $opt close $c - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} @@ -1181,144 +1086,115 @@ test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - note [fconfigure $c] close $c - rename foo {} set res } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} - test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} - proc foo {args} {oninit cget cgetall ; onfinal ; track ; return ""} + proc foo {args} {oninit cget cgetall; onfinal; track; return ""} set c [chan create {r w} foo] - note [fconfigure $c] close $c - rename foo {} set res } -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} - test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return "-bar foo -snarf x" } set c [chan create {r w} foo] - note [fconfigure $c] close $c - rename foo {} set res } -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} - test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return "-bar" } set c [chan create {r w} foo] - - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg]; note $msg close $c - rename foo {} set res } -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}} - test iocmd-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return "\{" } set c [chan create {r w} foo] - - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg]; note $msg close $c - rename foo {} set res } -result {{cgetall rc*} 1 {unmatched open brace in list}} - test iocmd-25.6 {chan configure, cgetall, error return} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg]; note $msg close $c - rename foo {} set res } -result {{cgetall rc*} 1 BOOM!} - test iocmd-25.7 {chan configure, cgetall, break return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg]; note $msg close $c - rename foo {} set res } -result {{cgetall rc*} 1 BOOM!} - test iocmd-25.8 {chan configure, cgetall, continue return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg]; note $msg close $c - rename foo {} set res } -result {{cgetall rc*} 1 BOOM!} - test iocmd-25.9 {chan configure, cgetall, custom return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code 777 BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg]; note $msg close $c - rename foo {} set res } -result {{cgetall rc*} 1 BOOM!} - test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -level 55 -code 777 BANG } set c [chan create {r w} foo] - - note [catch {fconfigure $c} msg opt] ; note $msg ; note $opt + note [catch {fconfigure $c} msg opt]; note $msg; note $opt close $c - rename foo {} set res } -result {{cgetall rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} @@ -1329,101 +1205,80 @@ test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body { test iocmd-26.1 {chan configure, set standard option} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track ; note MUST_NOT_HAPPEN - return + oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return } set c [chan create {r w} foo] - note [fconfigure $c -translation lf] close $c - rename foo {} set res } -result {{}} - test iocmd-26.2 {chan configure, set option, error return} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg + note [catch {fconfigure $c -rc-foo bar} msg]; note $msg close $c - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BOOM!} - test iocmd-26.3 {chan configure, set option, ok return} -match glob -body { set res {} - proc foo {args} {oninit configure ; onfinal ; track ; return} + proc foo {args} {oninit configure; onfinal; track; return} set c [chan create {r w} foo] - note [fconfigure $c -rc-foo bar] close $c - rename foo {} set res } -result {{configure rc* -rc-foo bar} {}} - test iocmd-26.4 {chan configure, set option, break return is error} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg + note [catch {fconfigure $c -rc-foo bar} msg]; note $msg close $c - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BOOM!} - test iocmd-26.5 {chan configure, set option, continue return is error} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg + note [catch {fconfigure $c -rc-foo bar} msg]; note $msg close $c - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BOOM!} - test iocmd-26.6 {chan configure, set option, custom return is error} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -code 444 BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg + note [catch {fconfigure $c -rc-foo bar} msg]; note $msg close $c - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BOOM!} - test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -level 55 -code 444 BANG } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo bar} msg opt] ; note $msg ; note $opt + note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; note $opt close $c - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} @@ -1433,87 +1288,70 @@ test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body test iocmd-27.1 {chan configure, get option, ok return} -match glob -body { set res {} - proc foo {args} {oninit cget cgetall ; onfinal ; track ; return foo} + proc foo {args} {oninit cget cgetall; onfinal; track; return foo} set c [chan create {r w} foo] - note [fconfigure $c -rc-foo] close $c - rename foo {} set res } -result {{cget rc* -rc-foo} foo} - test iocmd-27.2 {chan configure, get option, error return} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo} msg] ; note $msg + note [catch {fconfigure $c -rc-foo} msg]; note $msg close $c - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} - test iocmd-27.3 {chan configure, get option, break return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo} msg] ; note $msg + note [catch {fconfigure $c -rc-foo} msg]; note $msg close $c - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} - test iocmd-27.4 {chan configure, get option, continue return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo} msg] ; note $msg + note [catch {fconfigure $c -rc-foo} msg]; note $msg close $c - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} - test iocmd-27.5 {chan configure, get option, custom return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code 333 BOOM! } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo} msg] ; note $msg + note [catch {fconfigure $c -rc-foo} msg]; note $msg close $c - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} - test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -level 77 -code 333 BANG } set c [chan create {r w} foo] - - note [catch {fconfigure $c -rc-foo} msg opt] ; note $msg ; note $opt + note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; note $opt close $c - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} @@ -1523,233 +1361,177 @@ test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body test iocmd-28.1 {chan tell, not supported by handler} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - note [tell $c] close $c - rename foo {} set res } -result {-1} - test iocmd-28.2 {chan tell, error return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] - - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} - test iocmd-28.3 {chan tell, break return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] - - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} - test iocmd-28.4 {chan tell, continue return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] - - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} - test iocmd-28.5 {chan tell, custom return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code 222 BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!} set c [chan create {r w} foo] - - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} - test iocmd-28.6 {chan tell, level is ignored} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -level 11 -code 222 BANG} + proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG} set c [chan create {r w} foo] - - note [catch {tell $c} msg opt] ; note $msg ; note $opt + note [catch {tell $c} msg opt]; note $msg; note $opt close $c - rename foo {} set res } -result {{seek rc* 0 current} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} - test iocmd-28.7 {chan tell, regular return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return 88} + proc foo {args} {oninit seek; onfinal; track; return 88} set c [chan create {r w} foo] - note [tell $c] close $c - rename foo {} set res } -result {{seek rc* 0 current} 88} - test iocmd-28.8 {chan tell, negative return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -1} + proc foo {args} {oninit seek; onfinal; track; return -1} set c [chan create {r w} foo] - - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 current} 1 {Tried to seek before origin}} - test iocmd-28.9 {chan tell, string return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS} + proc foo {args} {oninit seek; onfinal; track; return BOGUS} set c [chan create {r w} foo] - - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} - test iocmd-28.10 {chan seek, not supported by handler} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg]; note $msg close $c - rename foo {} set res } -result {1 {error during seek on "rc*": invalid argument}} - test iocmd-28.11 {chan seek, error return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] - - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} - test iocmd-28.12 {chan seek, break return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] - - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} - test iocmd-28.13 {chan seek, continue return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] - - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} - test iocmd-28.14 {chan seek, custom return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code 99 BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!} set c [chan create {r w} foo] - - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} - test iocmd-28.15 {chan seek, level is ignored} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -level 33 -code 99 BANG} + proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG} set c [chan create {r w} foo] - - note [catch {seek $c 0 start} msg opt] ; note $msg ; note $opt + note [catch {seek $c 0 start} msg opt]; note $msg; note $opt close $c - rename foo {} set res } -result {{seek rc* 0 start} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} - test iocmd-28.16 {chan seek, bogus return, negative location} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -45} + proc foo {args} {oninit seek; onfinal; track; return -45} set c [chan create {r w} foo] - - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 start} 1 {Tried to seek before origin}} - test iocmd-28.17 {chan seek, bogus return, string return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS} + proc foo {args} {oninit seek; onfinal; track; return BOGUS} set c [chan create {r w} foo] - - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg]; note $msg close $c - rename foo {} set res } -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} - test iocmd-28.18 {chan seek, ok result} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return 23} + proc foo {args} {oninit seek; onfinal; track; return 23} set c [chan create {r w} foo] - note [seek $c 0 current] close $c - rename foo {} set res } -result {{seek rc* 0 current} {}} - -foreach {n code} { - 0 start - 1 current - 2 end +foreach {testname code} { + iocmd-28.19.0 start + iocmd-28.19.1 current + iocmd-28.19.2 end } { - test iocmd-28.19.$n "chan seek, base conversion, $code" -match glob -body { + test $testname "chan seek, base conversion, $code" -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return 0} - + proc foo {args} {oninit seek; onfinal; track; return 0} set c [chan create {r w} foo] note [seek $c 0 $code] close $c - rename foo {} set res } -result [list [list seek rc* 0 $code] {}] @@ -1760,136 +1542,103 @@ foreach {n code} { test iocmd-29.1 {chan blocking, no handler support} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - note [fconfigure $c -blocking] close $c - rename foo {} set res } -result {1} - test iocmd-29.2 {chan blocking, no handler support} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - note [fconfigure $c -blocking 0] note [fconfigure $c -blocking] close $c - rename foo {} set res } -result {{} 0} - test iocmd-29.3 {chan blocking, retrieval, handler support} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - note [fconfigure $c -blocking] close $c - rename foo {} set res } -result {1} - test iocmd-29.4 {chan blocking, resetting, handler support} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return} + proc foo {args} {oninit blocking; onfinal; track; return} set c [chan create {r w} foo] - note [fconfigure $c -blocking 0] note [fconfigure $c -blocking] close $c - rename foo {} set res } -result {{blocking rc* 0} {} 0} - test iocmd-29.5 {chan blocking, setting, handler support} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return} + proc foo {args} {oninit blocking; onfinal; track; return} set c [chan create {r w} foo] - note [fconfigure $c -blocking 1] note [fconfigure $c -blocking] close $c - rename foo {} set res } -result {{blocking rc* 1} {} 1} - test iocmd-29.6 {chan blocking, error return} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; error BOOM!} - + proc foo {args} {oninit blocking; onfinal; track; error BOOM!} set c [chan create {r w} foo] - - note [catch {fconfigure $c -blocking 0} msg] ; note $msg - + note [catch {fconfigure $c -blocking 0} msg]; note $msg # Catch the close. It changes blocking mode internally, and runs into the error result. catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} - test iocmd-29.7 {chan blocking, break return is error} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return -code break BOOM!} + proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] - - note [catch {fconfigure $c -blocking 0} msg] ; note $msg - + note [catch {fconfigure $c -blocking 0} msg]; note $msg catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} - test iocmd-29.8 {chan blocking, continue return is error} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return -code continue BOOM!} + proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] - - note [catch {fconfigure $c -blocking 0} msg] ; note $msg - + note [catch {fconfigure $c -blocking 0} msg]; note $msg catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} - test iocmd-29.9 {chan blocking, custom return is error} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return -code 44 BOOM!} + proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!} set c [chan create {r w} foo] - - note [catch {fconfigure $c -blocking 0} msg] ; note $msg - + note [catch {fconfigure $c -blocking 0} msg]; note $msg catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} - test iocmd-29.10 {chan blocking, level is ignored} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return -level 99 -code 44 BANG} + proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG} set c [chan create {r w} foo] - - note [catch {fconfigure $c -blocking 0} msg opt] ; note $msg ; note $opt - + note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; note $opt catch {close $c} rename foo {} set res } -result {{blocking rc* 0} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} - test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return BOGUS} + proc foo {args} {oninit blocking; onfinal; track; return BOGUS} set c [chan create {r w} foo] - - note [catch {fconfigure $c -blocking 0} msg] ; note $msg - + note [catch {fconfigure $c -blocking 0} msg]; note $msg catch {close $c} rename foo {} set res @@ -1900,54 +1649,43 @@ test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob - test iocmd-30.1 {chan watch, read interest, some return} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return IGNORED} + proc foo {args} {oninit; onfinal; track; return IGNORED} set c [chan create {r w} foo] - note [fileevent $c readable {set tick $tick}] - close $c ;# 2nd watch, interest zero. - + close $c ;# 2nd watch, interest zero. rename foo {} set res } -result {{watch rc* read} {} {watch rc* {}}} - test iocmd-30.2 {chan watch, write interest, error return} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!_IGNORED} + proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED} set c [chan create {r w} foo] - note [fileevent $c writable {set tick $tick}] note [fileevent $c writable {}] close $c - rename foo {} set res } -result {{watch rc* write} {} {watch rc* {}} {}} - test iocmd-30.3 {chan watch, accumulated interests} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - note [fileevent $c writable {set tick $tick}] note [fileevent $c readable {set tick $tick}] note [fileevent $c writable {}] note [fileevent $c readable {}] close $c - rename foo {} set res } -result {{watch rc* write} {} {watch rc* {read write}} {} {watch rc* read} {} {watch rc* {}} {}} - test iocmd-30.4 {chan watch, unchanged interest not forwarded} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - note [fileevent $c writable {set tick $tick}] note [fileevent $c readable {set tick $tick}] ;# Script is changing, note [fileevent $c readable {set tock $tock}] ;# interest does not. - - close $c ;# 3rd and 4th watch, removing the event handlers. + close $c ;# 3rd and 4th watch, removing the event handlers. rename foo {} set res } -result {{watch rc* write} {} {watch rc* {read write}} {} {} {watch rc* write} {watch rc* {}}} @@ -1957,92 +1695,70 @@ test iocmd-30.4 {chan watch, unchanged interest not forwarded} -match glob -body test iocmd-31.1 {chan postevent, restricted to reflected channels} -match glob -body { set c [open [makeFile {} goo] r] - catch {chan postevent $c {r w}} msg - close $c removeFile goo set msg } -result {channel "file*" is not a reflected channel} - test iocmd-31.2 {chan postevent, unwanted events} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - - catch {chan postevent $c {r w}} msg ; note $msg + catch {chan postevent $c {r w}} msg; note $msg close $c - rename foo {} set res } -result {{tried to post events channel "rc*" is not interested in}} - test iocmd-31.3 {chan postevent, bad input, empty list} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - - catch {chan postevent $c {}} msg ; note $msg + catch {chan postevent $c {}} msg; note $msg close $c - rename foo {} set res } -result {{bad event list: is empty}} - test iocmd-31.4 {chan postevent, bad input, illlegal keyword} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - - catch {chan postevent $c goo} msg ; note $msg + catch {chan postevent $c goo} msg; note $msg close $c - rename foo {} set res } -result {{bad event "goo": must be read or write}} - test iocmd-31.5 {chan postevent, bad input, not a list} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - - catch {chan postevent $c "\{"} msg ; note $msg + catch {chan postevent $c "\{"} msg; note $msg close $c - rename foo {} set res } -result {{unmatched open brace in list}} - test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - note [fileevent $c readable {note TOCK}] - set stop [after 10000 {note TIMEOUT}] after 1000 {note [chan postevent $c r]} vwait ::res catch {after cancel $stop} close $c - rename foo {} set res } -result {{watch rc* read} {} TOCK {} {watch rc* {}}} - test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - note [fileevent $c writable {note TOCK}] - set stop [after 10000 {note TIMEOUT}] after 1000 {note [chan postevent $c w]} vwait ::res catch {after cancel $stop} close $c - rename foo {} set res } -result {{watch rc* write} {} TOCK {} {watch rc* {}}} @@ -2059,15 +1775,11 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { ## forwarding, and gaps due to tests not applicable to forwarding are ## left to keep this asociation. -testConstraint testchannel [llength [info commands testchannel]] - # Duplicate of code in "thread.test". Find a better way of doing this # without duplication. Maybe placement into a proc which transforms to # nop after the first call, and placement of its defintion in a # central location. -testConstraint testthread [expr {[info commands testthread] != {}}] - if {[testConstraint testthread]} { testthread errorproc ThreadError @@ -2075,7 +1787,6 @@ if {[testConstraint testthread]} { global threadError set threadError $info } - proc ThreadNullError {id info} { # ignore } @@ -2087,7 +1798,6 @@ if {[testConstraint testthread]} { ## configuation variables proc inthread {chan script args} { - # Test thread. set tid [testthread create] @@ -2103,10 +1813,10 @@ proc inthread {chan script args} { } testthread send $tid [list set mid $tcltest::mainThread] testthread send $tid { - proc note {item} {global notes ; lappend notes $item} - proc notes {} {global notes ; return $notes} + proc note {item} {global notes; lappend notes $item} + proc notes {} {global notes; return $notes} } - testthread send $tid [list proc s {} [list uplevel 1 $script]] ; # (*) + testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*) # Transfer channel (cut/splice aka detach/attach) @@ -2121,7 +1831,7 @@ proc inthread {chan script args} { set ::tres "" testthread send -async $tid { after 500 - catch {s} res ; # This runs the script, 's' was defined at (*) + catch {s} res; # This runs the script, 's' was defined at (*) testthread send -async $mid [list set ::tres $res] } vwait ::tres @@ -2137,121 +1847,97 @@ proc inthread {chan script args} { test iocmd.tf-22.2 {chan finalize, for close} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return {}} + proc foo {args} {track; oninit; return {}} note [set c [chan create {r w} foo]] - note [inthread $c { close $c # Close the deleted the channel. file channels rc* } c] - # Channel destruction does not kill handler command! note [info command foo] - rename foo {} set res } -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo} - test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -code error 5} + proc foo {args} {track; oninit; return -code error 5} note [set c [chan create {r w} foo]] - notes [inthread $c { - note [catch {close $c} msg] ; note $msg + note [catch {close $c} msg]; note $msg # Channel is gone despite error. note [file channels rc*] notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}} - test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -body { set res {} - proc foo {args} {track ; oninit ; error FOO} + proc foo {args} {track; oninit; error FOO} note [set c [chan create {r w} foo]] - notes [inthread $c { - note [catch {close $c} msg] ; note $msg + note [catch {close $c} msg]; note $msg notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO} - test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return SOMETHING} + proc foo {args} {track; oninit; return SOMETHING} note [set c [chan create {r w} foo]] - notes [inthread $c { note [catch {close $c} msg]; note $msg notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}} - test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -code 3} + proc foo {args} {track; oninit; return -code 3} note [set c [chan create {r w} foo]] - notes [inthread $c { - note [catch {close $c} msg] ; note $msg + note [catch {close $c} msg]; note $msg notes } c] - rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}} \ -constraints {testchannel testthread} - test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -code 4} + proc foo {args} {track; oninit; return -code 4} note [set c [chan create {r w} foo]] - notes [inthread $c { - note [catch {close $c} msg] ; note $msg + note [catch {close $c} msg]; note $msg notes } c] - rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}} \ -constraints {testchannel testthread} - test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -code 777 BANG} + proc foo {args} {track; oninit; return -code 777 BANG} note [set c [chan create {r w} foo]] - notes [inthread $c { - note [catch {close $c} msg] ; note $msg + note [catch {close $c} msg]; note $msg notes } c] - rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG} \ -constraints {testchannel testthread} - test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match glob -body { set res {} - proc foo {args} {track ; oninit ; return -level 5 -code 777 BANG} + proc foo {args} {track; oninit; return -level 5 -code 777 BANG} note [set c [chan create {r w} foo]] - notes [inthread $c { - note [catch {close $c} msg opt] ; note $msg ; note $opt + note [catch {close $c} msg opt]; note $msg; note $opt notes } c] - rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \ @@ -2263,7 +1949,7 @@ test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match test iocmd.tf-23.1 {chan read, regular data return} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return snarf } set c [chan create {r w} foo] @@ -2272,135 +1958,114 @@ test iocmd.tf-23.1 {chan read, regular data return} -match glob -body { close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf} - test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return [string repeat snarf 1000] } set c [chan create {r w} foo] notes [inthread $c { - note [catch {[read $c 2]} msg] ; note $msg + note [catch {[read $c 2]} msg]; note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{read rc* 4096} 1 {read delivered more than requested}} - test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track - note MUST_NOT_HAPPEN + oninit; onfinal; track; note MUST_NOT_HAPPEN } set c [chan create {w} foo] notes [inthread $c { - note [catch {[read $c 2]} msg] ; note $msg + note [catch {[read $c 2]} msg]; note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for reading}} - test iocmd.tf-23.4 {chan read, error return} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c notes } c] - rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-23.5 {chan read, break return is error} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c notes } c] - rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c notes } c] - rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -code 777 BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {read $c 2} msg] ; note $msg + note [catch {read $c 2} msg]; note $msg close $c notes } c] - rename foo {} set res } -result {{read rc* 4096} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track return -level 55 -code 777 BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {read $c 2} msg opt] ; note $msg ; note $opt + note [catch {read $c 2} msg opt]; note $msg; note $opt close $c notes } c] - rename foo {} set res } -result {{read rc* 4096} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} \ @@ -2412,216 +2077,181 @@ test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body { test iocmd.tf-24.1 {chan write, regular write} -match glob -body { set res {} proc foo {args} { - oninit; onfinal ; track + oninit; onfinal; track set written [string length [lindex $args 2]] note $written return $written } set c [chan create {r w} foo] - inthread $c { - puts -nonewline $c snarf ; flush $c + puts -nonewline $c snarf; flush $c close $c } c - rename foo {} set res } -constraints {testchannel testthread} -result {{write rc* snarf} 5} - test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body { set res {} proc foo {args} { - oninit ; onfinal ; track + oninit; onfinal; track set written [string length [lindex $args 2]] if {$written > 10} {set written [expr {$written / 2}]} note $written return $written } set c [chan create {r w} foo] - inthread $c { - puts -nonewline $c snarfsnarfsnarf ; flush $c + puts -nonewline $c snarfsnarfsnarf; flush $c close $c } c - rename foo {} set res } -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8} - test iocmd.tf-24.3 {chan write, failed write} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note -1 ; return -1} + proc foo {args} {oninit; onfinal; track; note -1; return -1} set c [chan create {r w} foo] - inthread $c { - puts -nonewline $c snarfsnarfsnarf ; flush $c + puts -nonewline $c snarfsnarfsnarf; flush $c close $c } c - rename foo {} set res } -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} -1} - test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] ; note $msg + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for writing}} - test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return 10000} + proc foo {args} {oninit; onfinal; track; return 10000} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg + note [catch {puts -nonewline $c snarf; flush $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}} - test iocmd.tf-24.6 {chan write, zero writes} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return 0} + proc foo {args} {oninit; onfinal; track; return 0} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg + note [catch {puts -nonewline $c snarf; flush $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}} - test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!} + proc foo {args} {oninit; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; error BOOM!} + proc foo {args} {oninit; onfinal; track; error BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code break BOOM!} + proc foo {args} {oninit; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code continue BOOM!} + proc foo {args} {oninit; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code 777 BOOM!} + proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return BANG} + proc foo {args} {oninit; onfinal; track; return BANG} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg] note $msg close $c notes } c] - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} \ -constraints {testchannel testthread} - test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -level 55 -code 777 BOOM!} + proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg opt] + note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt] note $msg note $opt close $c notes } c] - rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} \ @@ -2632,180 +2262,159 @@ test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -bo test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c] close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} \ -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} - test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} - proc foo {args} {oninit cget cgetall ; onfinal ; track ; return ""} + proc foo {args} {oninit cget cgetall; onfinal; track; return ""} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c] close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} \ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} - test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return "-bar foo -snarf x" } set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c] close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} \ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} - test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return "-bar" } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}} - test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return "\{" } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{cgetall rc*} 1 {unmatched open brace in list}} - test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{cgetall rc*} 1 BOOM!} - test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{cgetall rc*} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{cgetall rc*} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code 777 BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c} msg] ; note $msg + note [catch {fconfigure $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{cgetall rc*} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -level 55 -code 777 BANG } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c} msg opt] ; note $msg ; note $opt + note [catch {fconfigure $c} msg opt] + note $msg + note $opt close $c notes } c] - rename foo {} set res } -result {{cgetall rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \ @@ -2817,125 +2426,110 @@ test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -bod test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track ; note MUST_NOT_HAPPEN - return + oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return } - set c [chan create {r w} foo] notes [inthread $c { note [fconfigure $c -translation lf] close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{}} - test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg + note [catch {fconfigure $c -rc-foo bar} msg] + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} 1 BOOM!} - test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body { set res {} - proc foo {args} {oninit configure ; onfinal ; track ; return} + proc foo {args} {oninit configure; onfinal; track; return} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c -rc-foo bar] close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} {}} - test iocmd.tf-26.4 {chan configure, set option, break return is error} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -code break BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg + note [catch {fconfigure $c -rc-foo bar} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg + note [catch {fconfigure $c -rc-foo bar} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -code 444 BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg + note [catch {fconfigure $c -rc-foo bar} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body { set res {} proc foo {args} { - oninit configure ; onfinal ; track + oninit configure; onfinal; track return -level 55 -code 444 BANG } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo bar} msg opt] ; note $msg ; note $opt + note [catch {fconfigure $c -rc-foo bar} msg opt] + note $msg + note $opt close $c notes } c] - rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \ @@ -2946,108 +2540,97 @@ test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -b test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body { set res {} - proc foo {args} {oninit cget cgetall ; onfinal ; track ; return foo} + proc foo {args} {oninit cget cgetall; onfinal; track; return foo} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c -rc-foo] close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{cget rc* -rc-foo} foo} - test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo} msg] ; note $msg + note [catch {fconfigure $c -rc-foo} msg] + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{cget rc* -rc-foo} 1 BOOM!} - test iocmd.tf-27.3 {chan configure, get option, break return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code error BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo} msg] ; note $msg + note [catch {fconfigure $c -rc-foo} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code continue BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo} msg] ; note $msg + note [catch {fconfigure $c -rc-foo} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -code 333 BOOM! } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo} msg] ; note $msg + note [catch {fconfigure $c -rc-foo} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body { set res {} proc foo {args} { - oninit cget cgetall ; onfinal ; track + oninit cget cgetall; onfinal; track return -level 77 -code 333 BANG } set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -rc-foo} msg opt] ; note $msg ; note $opt + note [catch {fconfigure $c -rc-foo} msg opt] + note $msg + note $opt close $c notes } c] - rename foo {} set res } -result {{cget rc* -rc-foo} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \ @@ -3058,308 +2641,269 @@ test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -b test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - notes [inthread $c { note [tell $c] close $c notes } c] - rename foo {} set res } -result {-1} \ -constraints {testchannel testthread} - test iocmd.tf-28.2 {chan tell, error return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code 222 BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -level 11 -code 222 BANG} + proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {tell $c} msg opt] ; note $msg ; note $opt + note [catch {tell $c} msg opt] + note $msg + note $opt close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \ -constraints {testchannel testthread} - test iocmd.tf-28.7 {chan tell, regular return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return 88} + proc foo {args} {oninit seek; onfinal; track; return 88} set c [chan create {r w} foo] - notes [inthread $c { note [tell $c] close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} 88} \ -constraints {testchannel testthread} - test iocmd.tf-28.8 {chan tell, negative return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -1} + proc foo {args} {oninit seek; onfinal; track; return -1} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} 1 {Tried to seek before origin}} \ -constraints {testchannel testthread} - test iocmd.tf-28.9 {chan tell, string return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS} + proc foo {args} {oninit seek; onfinal; track; return BOGUS} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {tell $c} msg] ; note $msg + note [catch {tell $c} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} \ -constraints {testchannel testthread} - test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {1 {error during seek on "rc*": invalid argument}} \ -constraints {testchannel testthread} - test iocmd.tf-28.11 {chan seek, error return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -code 99 BOOM!} + proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -level 33 -code 99 BANG} + proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {seek $c 0 start} msg opt] ; note $msg ; note $opt + note [catch {seek $c 0 start} msg opt] + note $msg + note $opt close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 start} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \ -constraints {testchannel testthread} - test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return -45} + proc foo {args} {oninit seek; onfinal; track; return -45} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 start} 1 {Tried to seek before origin}} \ -constraints {testchannel testthread} - test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS} + proc foo {args} {oninit seek; onfinal; track; return BOGUS} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {seek $c 0 start} msg] ; note $msg + note [catch {seek $c 0 start} msg] + note $msg close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} \ -constraints {testchannel testthread} - test iocmd.tf-28.18 {chan seek, ok result} -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return 23} + proc foo {args} {oninit seek; onfinal; track; return 23} set c [chan create {r w} foo] - notes [inthread $c { note [seek $c 0 current] close $c notes } c] - rename foo {} set res } -result {{seek rc* 0 current} {}} \ -constraints {testchannel testthread} - -foreach {n code} { - 0 start - 1 current - 2 end +foreach {testname code} { + iocmd.tf-28.19.0 start + iocmd.tf-28.19.1 current + iocmd.tf-28.19.2 end } { - test iocmd.tf-28.19.$n "chan seek, base conversion, $code" -match glob -body { + test $testname "chan seek, base conversion, $code" -match glob -body { set res {} - proc foo {args} {oninit seek ; onfinal ; track ; return 0} + proc foo {args} {oninit seek; onfinal; track; return 0} set c [chan create {r w} foo] - notes [inthread $c { note [seek $c 0 $code] close $c notes } c code] - rename foo {} set res } -result [list [list seek rc* 0 $code] {}] \ @@ -3371,180 +2915,154 @@ foreach {n code} { test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c -blocking] close $c notes } c] - rename foo {} set res } -result {1} \ -constraints {testchannel testthread} - test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c -blocking 0] note [fconfigure $c -blocking] close $c notes } c] - rename foo {} set res } -result {{} 0} \ -constraints {testchannel testthread} - test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; note MUST_NOT_HAPPEN ; return} + proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c -blocking] close $c notes } c] - rename foo {} set res } -result {1} \ -constraints {testchannel testthread} - test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return} + proc foo {args} {oninit blocking; onfinal; track; return} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c -blocking 0] note [fconfigure $c -blocking] close $c notes } c] - rename foo {} set res } -result {{blocking rc* 0} {} 0} \ -constraints {testchannel testthread} - test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return} + proc foo {args} {oninit blocking; onfinal; track; return} set c [chan create {r w} foo] - notes [inthread $c { note [fconfigure $c -blocking 1] note [fconfigure $c -blocking] close $c notes } c] - rename foo {} set res } -result {{blocking rc* 1} {} 1} \ -constraints {testchannel testthread} - test iocmd.tf-29.6 {chan blocking, error return} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; error BOOM!} - + proc foo {args} {oninit blocking; onfinal; track; error BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -blocking 0} msg] ; note $msg + note [catch {fconfigure $c -blocking 0} msg] + note $msg # Catch the close. It changes blocking mode internally, and runs into the error result. catch {close $c} notes } c] - rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return -code break BOOM!} + proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -blocking 0} msg] ; note $msg + note [catch {fconfigure $c -blocking 0} msg] + note $msg catch {close $c} notes } c] - rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return -code continue BOOM!} + proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -blocking 0} msg] ; note $msg + note [catch {fconfigure $c -blocking 0} msg] + note $msg catch {close $c} notes } c] - rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return -code 44 BOOM!} + proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -blocking 0} msg] ; note $msg + note [catch {fconfigure $c -blocking 0} msg] + note $msg catch {close $c} notes } c] - rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} \ -constraints {testchannel testthread} - test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return -level 99 -code 44 BANG} + proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -blocking 0} msg opt] ; note $msg ; note $opt + note [catch {fconfigure $c -blocking 0} msg opt] + note $msg + note $opt catch {close $c} notes } c] - rename foo {} set res } -result {{blocking rc* 0} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \ -constraints {testchannel testthread} - test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glob -body { set res {} - proc foo {args} {oninit blocking ; onfinal ; track ; return BOGUS} + proc foo {args} {oninit blocking; onfinal; track; return BOGUS} set c [chan create {r w} foo] - notes [inthread $c { - note [catch {fconfigure $c -blocking 0} msg] ; note $msg + note [catch {fconfigure $c -blocking 0} msg] + note $msg catch {close $c} notes } c] - rename foo {} set res } -result {{blocking rc* 0} 0 {}} \ @@ -3555,40 +3073,33 @@ test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glo test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return IGNORED} + proc foo {args} {oninit; onfinal; track; return IGNORED} set c [chan create {r w} foo] - notes [inthread $c { note [fileevent $c readable {set tick $tick}] - close $c ;# 2nd watch, interest zero. + close $c ;# 2nd watch, interest zero. notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{watch rc* read} {watch rc* {}} {}} - test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!_IGNORED} + proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED} set c [chan create {r w} foo] - notes [inthread $c { note [fileevent $c writable {set tick $tick}] note [fileevent $c writable {}] close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} -result {{watch rc* write} {watch rc* {}} {} {}} - test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - notes [inthread $c { note [fileevent $c writable {set tick $tick}] note [fileevent $c readable {set tick $tick}] @@ -3597,25 +3108,21 @@ test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body { close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} \ -result {{watch rc* write} {watch rc* {read write}} {watch rc* read} {watch rc* {}} {} {} {} {}} - test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - notes [inthread $c { note [fileevent $c writable {set tick $tick}] note [fileevent $c readable {set tick $tick}] ;# Script is changing, note [fileevent $c readable {set tock $tock}] ;# interest does not. - close $c ;# 3rd and 4th watch, removing the event handlers. + close $c ;# 3rd and 4th watch, removing the event handlers. notes } c] - rename foo {} set res } -constraints {testchannel testthread} \ @@ -3628,21 +3135,19 @@ test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -b test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body { set res {} - proc foo {args} {oninit ; onfinal ; track ; return} + proc foo {args} {oninit; onfinal; track; return} set c [chan create {r w} foo] - notes [inthread $c { - catch {chan postevent $c r} msg ; note $msg + catch {chan postevent $c r} msg + note $msg close $c notes } c] - rename foo {} set res } -constraints {testchannel testthread} \ -result {{postevent for channel "rc*" called from outside interpreter}} - # ### ### ### ######### ######### ######### # ### ### ### ######### ######### ######### diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 15fe869..a4557ee 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -11,7 +11,7 @@ * * Serial functionality implemented by Rolf.Schroedter@dlr.de * - * RCS: @(#) $Id: tclWinSerial.c,v 1.32 2005/10/05 06:34:04 hobbs Exp $ + * RCS: @(#) $Id: tclWinSerial.c,v 1.33 2005/10/31 13:53:33 dkf Exp $ */ #include "tclWinInt.h" @@ -167,37 +167,36 @@ static COMMTIMEOUTS no_timeout = { * Declarations for functions used only in this file. */ -static int SerialBlockProc(ClientData instanceData, - int mode); -static void SerialCheckProc(ClientData clientData, - int flags); -static int SerialCloseProc(ClientData instanceData, - Tcl_Interp *interp); -static int SerialEventProc(Tcl_Event *evPtr, int flags); -static void SerialExitHandler(ClientData clientData); -static int SerialGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static ThreadSpecificData * SerialInit(void); -static int SerialInputProc(ClientData instanceData, - char *buf, int toRead, int *errorCode); -static int SerialOutputProc(ClientData instanceData, - CONST char *buf, int toWrite, - int *errorCode); -static void SerialSetupProc(ClientData clientData, - int flags); -static void SerialWatchProc(ClientData instanceData, - int mask); -static void ProcExitHandler(ClientData clientData); -static int SerialGetOptionProc(ClientData instanceData, - Tcl_Interp *interp, CONST char *optionName, - Tcl_DString *dsPtr); -static int SerialSetOptionProc(ClientData instanceData, - Tcl_Interp *interp, CONST char *optionName, - CONST char *value); -static DWORD WINAPI SerialWriterThread(LPVOID arg); - -static void SerialThreadActionProc(ClientData instanceData, - int action); +static int SerialBlockProc(ClientData instanceData, int mode); +static void SerialCheckProc(ClientData clientData, int flags); +static int SerialCloseProc(ClientData instanceData, + Tcl_Interp *interp); +static int SerialEventProc(Tcl_Event *evPtr, int flags); +static void SerialExitHandler(ClientData clientData); +static int SerialGetHandleProc(ClientData instanceData, + int direction, ClientData *handlePtr); +static ThreadSpecificData *SerialInit(void); +static int SerialInputProc(ClientData instanceData, char *buf, + int toRead, int *errorCode); +static int SerialOutputProc(ClientData instanceData, + CONST char *buf, int toWrite, int *errorCode); +static void SerialSetupProc(ClientData clientData, int flags); +static void SerialWatchProc(ClientData instanceData, int mask); +static void ProcExitHandler(ClientData clientData); +static int SerialGetOptionProc(ClientData instanceData, + Tcl_Interp *interp, CONST char *optionName, + Tcl_DString *dsPtr); +static int SerialSetOptionProc(ClientData instanceData, + Tcl_Interp *interp, CONST char *optionName, + CONST char *value); +static DWORD WINAPI SerialWriterThread(LPVOID arg); +static void SerialThreadActionProc(ClientData instanceData, + int action); +static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf, + DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr); +static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, + DWORD bufSize, LPDWORD lpWritten, + LPOVERLAPPED osPtr); /* * This structure describes the channel type structure for command serial @@ -240,7 +239,7 @@ static Tcl_ChannelType serialChannelType = { */ static ThreadSpecificData * -SerialInit() +SerialInit(void) { ThreadSpecificData *tsdPtr; @@ -722,7 +721,7 @@ SerialCloseProc( /* *---------------------------------------------------------------------- * - * blockingRead -- + * SerialBlockingRead -- * * Perform a blocking read into the buffer given. Returns count of how * many bytes were actually read, and an error indication. @@ -738,12 +737,12 @@ SerialCloseProc( */ static int -blockingRead( +SerialBlockingRead( SerialInfo *infoPtr, /* Serial info structure */ LPVOID buf, /* The input buffer pointer */ - DWORD bufSize, /* The number of bytes to read */ - LPDWORD lpRead, /* Returns number of bytes read */ - LPOVERLAPPED osPtr ) /* OVERLAPPED structure */ + DWORD bufSize, /* The number of bytes to read */ + LPDWORD lpRead, /* Returns number of bytes read */ + LPOVERLAPPED osPtr) /* OVERLAPPED structure */ { /* * Perform overlapped blocking read. @@ -785,7 +784,7 @@ blockingRead( /* *---------------------------------------------------------------------- * - * blockingWrite -- + * SerialBlockingWrite -- * * Perform a blocking write from the buffer given. Returns count of how * many bytes were actually written, and an error indication. @@ -801,10 +800,10 @@ blockingRead( */ static int -blockingWrite( +SerialBlockingWrite( SerialInfo *infoPtr, /* Serial info structure */ - LPVOID buf, /* The output buffer pointer */ - DWORD bufSize, /* The number of bytes to write */ + LPVOID buf, /* The output buffer pointer */ + DWORD bufSize, /* The number of bytes to write */ LPDWORD lpWritten, /* Returns number of bytes written */ LPOVERLAPPED osPtr) /* OVERLAPPED structure */ { @@ -964,7 +963,7 @@ SerialInputProc( * checked the number of available bytes. */ - if (blockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead, + if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead, &infoPtr->osRead) == FALSE) { TclWinConvertError(GetLastError()); *errorCode = errno; @@ -1090,7 +1089,7 @@ SerialOutputProc( * avoids an unnecessary copy. */ - if (!blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, + if (!SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, &infoPtr->osWrite)) { goto writeError; } @@ -1147,9 +1146,9 @@ SerialOutputProc( static int SerialEventProc( - Tcl_Event *evPtr, /* Event to service. */ - int flags) /* Flags that indicate what events to handle, such as - * TCL_FILE_EVENTS. */ + Tcl_Event *evPtr, /* Event to service. */ + int flags) /* Flags that indicate what events to handle, + * such as TCL_FILE_EVENTS. */ { SerialEvent *serialEvPtr = (SerialEvent *)evPtr; SerialInfo *infoPtr; @@ -1257,8 +1256,7 @@ SerialWatchProc( * Remove the serial port from the list of watched serial ports. */ - for (nextPtrPtr=&(tsdPtr->firstSerialPtr), ptr=*nextPtrPtr; - ptr!=NULL; + for (nextPtrPtr=&(tsdPtr->firstSerialPtr), ptr=*nextPtrPtr; ptr!=NULL; nextPtrPtr=&ptr->nextPtr, ptr=*nextPtrPtr) { if (infoPtr == ptr) { *nextPtrPtr = ptr->nextPtr; @@ -1316,7 +1314,8 @@ SerialGetHandleProc( */ static DWORD WINAPI -SerialWriterThread(LPVOID arg) +SerialWriterThread( + LPVOID arg) { SerialInfo *infoPtr = (SerialInfo *)arg; DWORD bytesWritten, toWrite, waitResult; @@ -1365,7 +1364,7 @@ SerialWriterThread(LPVOID arg) if (infoPtr->writeError) { break; } - if (blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, + if (SerialBlockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite, &bytesWritten, &myWrite) == FALSE) { infoPtr->writeError = GetLastError(); break; @@ -1431,10 +1430,10 @@ SerialWriterThread(LPVOID arg) */ HANDLE -TclWinSerialReopen(handle, name, access) - HANDLE handle; - CONST TCHAR *name; - DWORD access; +TclWinSerialReopen( + HANDLE handle, + CONST TCHAR *name, + DWORD access) { ThreadSpecificData *tsdPtr; @@ -1473,10 +1472,10 @@ TclWinSerialReopen(handle, name, access) */ Tcl_Channel -TclWinOpenSerialChannel(handle, channelName, permissions) - HANDLE handle; - char *channelName; - int permissions; +TclWinOpenSerialChannel( + HANDLE handle, + char *channelName, + int permissions) { SerialInfo *infoPtr; DWORD id; @@ -1565,9 +1564,9 @@ TclWinOpenSerialChannel(handle, channelName, permissions) */ static void -SerialErrorStr(error, dsPtr) - DWORD error; /* Win32 serial error code. */ - Tcl_DString *dsPtr; /* Where to store string. */ +SerialErrorStr( + DWORD error, /* Win32 serial error code. */ + Tcl_DString *dsPtr) /* Where to store string. */ { if (error & CE_RXOVER) { Tcl_DStringAppendElement(dsPtr, "RXOVER"); @@ -1615,9 +1614,9 @@ SerialErrorStr(error, dsPtr) */ static void -SerialModemStatusStr(status, dsPtr) - DWORD status; /* Win32 modem status. */ - Tcl_DString *dsPtr; /* Where to store string. */ +SerialModemStatusStr( + DWORD status, /* Win32 modem status. */ + Tcl_DString *dsPtr) /* Where to store string. */ { Tcl_DStringAppendElement(dsPtr, "CTS"); Tcl_DStringAppendElement(dsPtr, (status & MS_CTS_ON) ? "1" : "0"); @@ -1647,11 +1646,11 @@ SerialModemStatusStr(status, dsPtr) */ static int -SerialSetOptionProc(instanceData, interp, optionName, value) - ClientData instanceData; /* File state. */ - Tcl_Interp *interp; /* For error reporting - can be NULL. */ - CONST char *optionName; /* Which option to set? */ - CONST char *value; /* New value for option. */ +SerialSetOptionProc( + ClientData instanceData, /* File state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL. */ + CONST char *optionName, /* Which option to set? */ + CONST char *value) /* New value for option. */ { SerialInfo *infoPtr; DCB dcb; @@ -1678,8 +1677,8 @@ SerialSetOptionProc(instanceData, interp, optionName, value) if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't get comm state", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -1688,10 +1687,9 @@ SerialSetOptionProc(instanceData, interp, optionName, value) Tcl_DStringFree(&ds); if (result == FALSE) { - if (interp) { - Tcl_AppendResult(interp, - "bad value for -mode: should be baud,parity,data,stop", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -mode: should be baud,parity,data,stop", NULL); } return TCL_ERROR; } @@ -1706,8 +1704,8 @@ SerialSetOptionProc(instanceData, interp, optionName, value) dcb.fAbortOnError = FALSE; if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't set comm state", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); } return TCL_ERROR; } @@ -1720,8 +1718,8 @@ SerialSetOptionProc(instanceData, interp, optionName, value) if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't get comm state", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -1757,17 +1755,17 @@ SerialSetOptionProc(instanceData, interp, optionName, value) dcb.fOutxDsrFlow = TRUE; dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { - if (interp) { - Tcl_AppendResult(interp, "bad value for -handshake: ", - "must be one of xonxoff, rtscts, dtrdsr or none", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -handshake: must be one of xonxoff, rtscts, ", + "dtrdsr or none", NULL); } return TCL_ERROR; } if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't set comm state", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); } return TCL_ERROR; } @@ -1780,8 +1778,8 @@ SerialSetOptionProc(instanceData, interp, optionName, value) if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't get comm state", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -1789,22 +1787,49 @@ SerialSetOptionProc(instanceData, interp, optionName, value) if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } - if (argc == 2) { - dcb.XonChar = argv[0][0]; - dcb.XoffChar = argv[1][0]; - ckfree((char *) argv); - } else { - if (interp) { - Tcl_AppendResult(interp, "bad value for -xchar: ", - "should be a list of two elements", (char *) NULL); + if (argc != 2) { + badXchar: + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value for -xchar: should be ", + "a list of two elements with each a single character", + NULL); } ckfree((char *) argv); return TCL_ERROR; } + /* + * These dereferences are safe, even in the zero-length string cases, + * because that just makes the xon/xoff character into NUL. When the + * character looks like it is UTF-8 encoded, decode it before casting + * into the format required for the Win guts. Note that this does not + * convert character sets; it is expected that when people set the + * control characters to something large and custom, they'll know the + * hex/octal value rather than the printable form. + */ + + dcb.XonChar = argv[0][0]; + dcb.XoffChar = argv[1][0]; + if (argv[0][0] & 0x80 || argv[1][0] & 0x80) { + Tcl_UniChar character; + int charLen; + + charLen = Tcl_UtfToUniChar(argv[0], &character); + if (argv[0][charLen]) { + goto badXchar; + } + dcb.XonChar = (char) character; + charLen = Tcl_UtfToUniChar(argv[1], &character); + if (argv[1][charLen]) { + goto badXchar; + } + dcb.XoffChar = (char) character; + } + ckfree((char *) argv); + if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't set comm state", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); } return TCL_ERROR; } @@ -1822,53 +1847,52 @@ SerialSetOptionProc(instanceData, interp, optionName, value) return TCL_ERROR; } if ((argc % 2) == 1) { - if (interp) { - Tcl_AppendResult(interp, "bad value for -ttycontrol: ", - "should be a list of signal,value pairs", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -ttycontrol: should be a list of ", + "signal,value pairs", NULL); } ckfree((char *) argv); return TCL_ERROR; } + for (i = 0; i < argc - 1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { result = TCL_ERROR; break; } if (strnicmp(argv[i], "DTR", strlen(argv[i])) == 0) { - if (!EscapeCommFunction(infoPtr->handle, flag ? - (DWORD) SETDTR : (DWORD) CLRDTR)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set DTR signal", (char *) NULL); + if (!EscapeCommFunction(infoPtr->handle, + (DWORD) (flag ? SETDTR : CLRDTR))) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set DTR signal", NULL); } result = TCL_ERROR; break; } } else if (strnicmp(argv[i], "RTS", strlen(argv[i])) == 0) { - if (!EscapeCommFunction(infoPtr->handle, flag ? - (DWORD) SETRTS : (DWORD) CLRRTS)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set RTS signal", (char *) NULL); + if (!EscapeCommFunction(infoPtr->handle, + (DWORD) (flag ? SETRTS : CLRRTS))) { + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set RTS signal", NULL); } result = TCL_ERROR; break; } } else if (strnicmp(argv[i], "BREAK", strlen(argv[i])) == 0) { - if (!EscapeCommFunction(infoPtr->handle, flag ? - (DWORD) SETBREAK : (DWORD) CLRBREAK)) { - if (interp) { - Tcl_AppendResult(interp, - "can't set BREAK signal", (char *) NULL); + if (!EscapeCommFunction(infoPtr->handle, + (DWORD) (flag ? SETBREAK : CLRBREAK))) { + if (interp != NULL) { + Tcl_AppendResult(interp,"can't set BREAK signal",NULL); } result = TCL_ERROR; break; } } else { - if (interp) { - Tcl_AppendResult(interp, "bad signal for -ttycontrol: ", - "must be DTR, RTS or BREAK", (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "bad signal name \"", argv[i], + "\" for -ttycontrol: must be DTR, RTS or BREAK", + NULL); } result = TCL_ERROR; break; @@ -1902,18 +1926,19 @@ SerialSetOptionProc(instanceData, interp, optionName, value) outSize = atoi(argv[1]); } ckfree((char *) argv); - if ((inSize <= 0) || (outSize <= 0)) { - if (interp) { - Tcl_AppendResult(interp, "bad value for -sysbuffer: ", - "should be a list of one or two integers > 0", - (char *) NULL); + + if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { + if (interp != NULL) { + Tcl_AppendResult(interp, "bad value \"", value, + "\" for -sysbuffer: should be a list of one or two ", + "integers > 0", NULL); } return TCL_ERROR; } + if (!SetupComm(infoPtr->handle, inSize, outSize)) { - if (interp) { - Tcl_AppendResult(interp, "can't setup comm buffers", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't setup comm buffers", NULL); } return TCL_ERROR; } @@ -1926,18 +1951,16 @@ SerialSetOptionProc(instanceData, interp, optionName, value) */ if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't get comm state", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't set comm state", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm state", NULL); } return TCL_ERROR; } @@ -1949,7 +1972,7 @@ SerialSetOptionProc(instanceData, interp, optionName, value) */ if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) { - if (Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) { + if (Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK) { return TCL_ERROR; } return TCL_OK; @@ -1968,9 +1991,8 @@ SerialSetOptionProc(instanceData, interp, optionName, value) } tout.ReadTotalTimeoutConstant = msec; if (!SetCommTimeouts(infoPtr->handle, &tout)) { - if (interp) { - Tcl_AppendResult(interp, "can't set comm timeouts", - (char *) NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't set comm timeouts", NULL); } return TCL_ERROR; } @@ -2004,11 +2026,11 @@ SerialSetOptionProc(instanceData, interp, optionName, value) */ static int -SerialGetOptionProc(instanceData, interp, optionName, dsPtr) - ClientData instanceData; /* File state. */ - Tcl_Interp *interp; /* For error reporting - can be NULL. */ - CONST char *optionName; /* Option to get. */ - Tcl_DString *dsPtr; /* Where to store value(s). */ +SerialGetOptionProc( + ClientData instanceData, /* File state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL. */ + CONST char *optionName, /* Option to get. */ + Tcl_DString *dsPtr) /* Where to store value(s). */ { SerialInfo *infoPtr; DCB dcb; @@ -2036,8 +2058,8 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) char buf[2 * TCL_INTEGER_SPACE + 16]; if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't get comm state", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -2104,8 +2126,8 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) valid = 1; if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp) { - Tcl_AppendResult(interp, "can't get comm state", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get comm state", NULL); } return TCL_ERROR; } @@ -2159,8 +2181,8 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) */ EnterCriticalSection(&infoPtr->csWrite); - ClearCommError( infoPtr->handle, &error, &cStat ); - count = (int)cStat.cbOutQue + infoPtr->writeQueue; + ClearCommError(infoPtr->handle, &error, &cStat); + count = (int) cStat.cbOutQue + infoPtr->writeQueue; LeaveCriticalSection(&infoPtr->csWrite); wsprintfA(buf, "%d", inBuffered + cStat.cbInQue); @@ -2180,8 +2202,8 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) DWORD status; if (!GetCommModemStatus(infoPtr->handle, &status)) { - if (interp) { - Tcl_AppendResult(interp, "can't get tty status", (char *)NULL); + if (interp != NULL) { + Tcl_AppendResult(interp, "can't get tty status", NULL); } return TCL_ERROR; } @@ -2214,9 +2236,9 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr) */ static void -SerialThreadActionProc(instanceData, action) - ClientData instanceData; - int action; +SerialThreadActionProc( + ClientData instanceData, + int action) { SerialInfo *infoPtr = (SerialInfo *) instanceData; |