summaryrefslogtreecommitdiffstats
path: root/tests/ioCmd.test
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2005-08-24 17:56:23 (GMT)
committerandreas_kupries <akupries@shaw.ca>2005-08-24 17:56:23 (GMT)
commitb32c5538015a9a182a54be4f711d0e01feb0a47c (patch)
tree20a737ae03097f905f0e9230c85c04123e5b5894 /tests/ioCmd.test
parentd1b987be17d4f05e79530f9f0896284fbe354205 (diff)
downloadtcl-b32c5538015a9a182a54be4f711d0e01feb0a47c.zip
tcl-b32c5538015a9a182a54be4f711d0e01feb0a47c.tar.gz
tcl-b32c5538015a9a182a54be4f711d0e01feb0a47c.tar.bz2
TIP#219 IMPLEMENTATION
* doc/SetChanErr.3: ** New File **. Documentation of the new channel API functions. * generic/tcl.decls: Stub declarations of the new channel API. * generic/tclDecls.h: Regenerated * generic/tclStubInit.c: * tclIORChan.c: ** New File **. Implementation of the reflected channel. * generic/tclInt.h: Integration of reflected channel and new error * generic/tclIO.c: propagation into the generic I/O core. * generic/tclIOCmd.c: * generic/tclIO.h: * library/init.tcl: * tests/io.test: Extended testsuite. * tests/ioCmd.test: * tests/chan.test: * generic/tclTest.c: * generic/tclThreadTest.c: * unix/Makefile.in: Integration into the build machinery. * win/Makefile.in: * win/Makefile.vc:
Diffstat (limited to 'tests/ioCmd.test')
-rw-r--r--tests/ioCmd.test3078
1 files changed, 3077 insertions, 1 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index fd09bc7..2c95b13 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1,3 +1,4 @@
+# -*- tcl -*-
# Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
# fblocked, fconfigure, open, channel, fcopy
#
@@ -12,7 +13,7 @@
# 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.23 2005/05/10 18:35:22 kennykb Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.24 2005/08/24 17:56:24 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -572,6 +573,3081 @@ test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
close $rfile
close $wfile
+# ### ### ### ######### ######### #########
+## Testing the reflected channel.
+
+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
+} {unknown or ambiguous subcommand "foo": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate}
+
+# --- --- --- --------- --------- ---------
+# chan create, and method "initalize"
+
+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
+ lappend res $args
+ if {[lindex $args 0] ne "initialize"} {return}
+ return {initialize finalize watch read write}
+ }
+ set res {}
+ lappend res [file channel rc*]
+ lappend res [chan create {r w} foo]
+ lappend res [close [lindex $res end]]
+ lappend res [file channel rc*]
+ 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
+ lappend res $args
+ return {}
+ }
+ set res {}
+ lappend res [file channel rc*]
+ lappend res [catch {chan create {r w} foo} msg]
+ lappend res $msg
+ lappend res [file channel rc*]
+ rename foo {}
+ set res
+} -result {{} {initialize rc* {read write}} 1 {Initialize failure: Not all required methods supported} {}}
+
+# --- --- --- --------- --------- ---------
+# 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 notes {items} {foreach i $items {note $i}}
+
+# Helper command, canned result for 'initialize' method.
+# Gets the optional methods as arguments. Use return features
+# to post the result higher up.
+
+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}
+ return -code return ""
+}
+
+# --- --- --- --------- --------- ---------
+# method finalize
+
+test iocmd-22.1 {chan finalize, handler destruction has no effect on channel} -match glob -body {
+ set res {}
+ 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 [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 {}}
+ 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}
+ note [set c [chan create {r w} foo]]
+
+ 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}
+ 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*} 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}
+ 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}
+ 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*} 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}
+ 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*} 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}
+ 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*} 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}
+ note [set c [chan create {r w} foo]]
+
+ 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}}
+
+# --- === *** ###########################
+# method read
+
+test iocmd-23.1 {chan read, regular data return} -match glob -body {
+ set res {}
+ proc foo {args} {
+ 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
+ return [string repeat snarf 1000]
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ }
+ set c [chan create {w} foo]
+
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+ 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
+ return -code break BOOM!
+ }
+ set c [chan create {r w} foo]
+ 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
+ return -code continue BOOM!
+ }
+ set c [chan create {r w} foo]
+ 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
+ return -code 777 BOOM!
+ }
+ set c [chan create {r w} foo]
+ 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
+ return -level 55 -code 777 BOOM!
+ }
+ set c [chan create {r w} foo]
+ 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!}}
+
+# --- === *** ###########################
+# method write
+
+test iocmd-24.1 {chan write, regular write} -match glob -body {
+ set res {}
+ proc foo {args} {
+ 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
+ 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
+ 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
+ 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}
+
+ set c [chan create {r w} foo]
+ 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}
+ set c [chan create {r} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}}
+
+# --- === *** ###########################
+# method cgetall
+
+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}
+ 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 ""}
+ 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
+ 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
+ return "-bar"
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return "\{"
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code break BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code continue BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code 777 BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -level 55 -code 777 BANG
+ }
+ set c [chan create {r w} foo]
+
+ 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}}
+
+# --- === *** ###########################
+# method configure
+
+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
+ }
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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}
+ 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
+ return -code break BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code continue BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code 444 BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ 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
+ close $c
+
+ rename foo {}
+ set res
+} -result {{configure rc* -rc-foo bar} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+# --- === *** ###########################
+# method cget
+
+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}
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code continue BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ return -code 333 BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ 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
+ 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
+ close $c
+
+ rename foo {}
+ set res
+} -result {{cget rc* -rc-foo} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+# --- === *** ###########################
+# method seek
+
+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}
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ 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
+} {
+ test iocmd-28.19.$n "chan seek, base conversion, $code" -match glob -body {
+ set res {}
+ 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] {}]
+}
+
+# --- === *** ###########################
+# method blocking
+
+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}
+ 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}
+ 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}
+ 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}
+ 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}
+ 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!}
+
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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!}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+
+ catch {close $c}
+ rename foo {}
+ set res
+} -result {{blocking rc* 0} 0 {}}
+
+# --- === *** ###########################
+# method watch
+
+test iocmd-30.1 {chan watch, read interest, some return} -match glob -body {
+ set res {}
+ 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.
+
+ 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}
+ 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}
+ 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}
+ 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.
+ rename foo {}
+ set res
+} -result {{watch rc* write} {} {watch rc* {read write}} {} {} {watch rc* write} {watch rc* {}}}
+
+# --- === *** ###########################
+# chan postevent
+
+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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ set c [chan create {r w} foo]
+
+ 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}
+ 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}
+ 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* {}}}
+
+# ### ### ### ######### ######### #########
+## Same tests as above, but exercising the code forwarding and
+## receiving driver operations to the originator thread.
+
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Testing the reflected channel (Thread forwarding).
+#
+## The id numbers refer to the original test without thread
+## 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
+
+ proc ThreadError {id info} {
+ global threadError
+ set threadError $info
+ }
+
+ proc ThreadNullError {id info} {
+ # ignore
+ }
+}
+
+# ### ### ### ######### ######### #########
+## Helper command. Runs a script in a separate thread and returns the
+## result. A channel is transfered into the thread as well, and list of
+## configuation variables
+
+proc inthread {chan script args} {
+
+ # Test thread.
+
+ set tid [testthread create]
+
+ # Init thread configuration.
+ # - Listed variables
+ # - Id of main thread
+ # - A number of helper commands
+
+ foreach v $args {
+ upvar 1 $v x
+ testthread send $tid [list set $v $x]
+ }
+ 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}
+ }
+ testthread send $tid [list proc s {} [list uplevel 1 $script]] ; # (*)
+
+ # Transfer channel (cut/splice aka detach/attach)
+
+ testchannel cut $chan
+ testthread send $tid [list testchannel splice $chan]
+
+ # Run test script, also run local event loop!
+ # The local event loop waits for the result to come back.
+ # It is also necessary for the execution of forwarded channel
+ # operations.
+
+ set ::tres ""
+ testthread send -async $tid {
+ after 500
+ catch {s} res ; # This runs the script, 's' was defined at (*)
+ testthread send -async $mid [list set ::tres $res]
+ }
+ vwait ::tres
+ # Remove test thread, and return the captured result.
+
+ tcltest::threadReap
+ return $::tres
+}
+
+# ### ### ### ######### ######### #########
+
+# ### ### ### ######### ######### #########
+
+test iocmd.tf-22.2 {chan finalize, for close} -match glob -body {
+ set res {}
+ 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}
+ note [set c [chan create {r w} foo]]
+
+ notes [inthread $c {
+ 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}
+ 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*} 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}
+ 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}
+ note [set c [chan create {r w} foo]]
+
+ notes [inthread $c {
+ 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}
+ note [set c [chan create {r w} foo]]
+
+ notes [inthread $c {
+ 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}
+ note [set c [chan create {r w} foo]]
+
+ notes [inthread $c {
+ 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}
+ note [set c [chan create {r w} foo]]
+
+ notes [inthread $c {
+ 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}} \
+ -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method read
+
+test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
+ set res {}
+ proc foo {args} {
+ oninit ; onfinal ; track
+ return snarf
+ }
+ set c [chan create {r w} foo]
+ notes [inthread $c {
+ note [read $c 10]
+ 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
+ return [string repeat snarf 1000]
+ }
+ set c [chan create {r w} foo]
+ notes [inthread $c {
+ 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
+ }
+ set c [chan create {w} foo]
+ notes [inthread $c {
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code break BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code continue BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code 777 BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ 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
+ close $c
+ notes
+ } c]
+
+ rename foo {}
+ set res
+} -result {{read rc* 4096} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} \
+ -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method write
+
+test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
+ set res {}
+ proc foo {args} {
+ 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
+ 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
+ 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
+ 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}
+ set c [chan create {r w} foo]
+
+ inthread $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}
+ set c [chan create {r} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}} \
+ -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method cgetall
+
+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}
+ 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 ""}
+ 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
+ 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
+ return "-bar"
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return "\{"
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code break BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code continue BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code 777 BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ 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
+ close $c
+ notes
+ } c]
+
+ rename foo {}
+ set res
+} -result {{cgetall rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
+ -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method configure
+
+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
+ }
+
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ 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
+ return -code break BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code continue BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code 444 BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ 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
+ 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}} \
+ -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method cget
+
+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}
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code error BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code continue BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ return -code 333 BOOM!
+ }
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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
+ 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
+ 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}} \
+ -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method seek
+
+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}
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ 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
+} {
+ test iocmd.tf-28.19.$n "chan seek, base conversion, $code" -match glob -body {
+ set res {}
+ 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] {}] \
+ -constraints {testchannel testthread}
+}
+
+# --- === *** ###########################
+# method blocking
+
+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}
+ 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}
+ 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}
+ 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}
+ 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}
+ 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!}
+
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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!}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+ catch {close $c}
+ notes
+ } c]
+
+ rename foo {}
+ set res
+} -result {{blocking rc* 0} 0 {}} \
+ -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method watch
+
+test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body {
+ set res {}
+ 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.
+ 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}
+ 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}
+ set c [chan create {r w} foo]
+
+ notes [inthread $c {
+ note [fileevent $c writable {set tick $tick}]
+ note [fileevent $c readable {set tick $tick}]
+ note [fileevent $c writable {}]
+ note [fileevent $c readable {}]
+ 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}
+ 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.
+ notes
+ } c]
+
+ rename foo {}
+ set res
+} -constraints {testchannel testthread} \
+ -result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}}
+
+# --- === *** ###########################
+# postevent
+# Not possible from a thread not containing the command handler.
+# Check that this is rejected.
+
+test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
+ set res {}
+ 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
+ close $c
+ notes
+ } c]
+
+ rename foo {}
+ set res
+} -constraints {testchannel testthread} \
+ -result {{postevent for channel "rc*" called from outside interpreter}}
+
+
+# ### ### ### ######### ######### #########
+
+# ### ### ### ######### ######### #########
+
+rename track {}
# cleanup
foreach file [list test1 test2 test3 test4] {
removeFile $file