diff options
| author | andreas_kupries <akupries@shaw.ca> | 2005-08-24 17:56:23 (GMT) |
|---|---|---|
| committer | andreas_kupries <akupries@shaw.ca> | 2005-08-24 17:56:23 (GMT) |
| commit | b32c5538015a9a182a54be4f711d0e01feb0a47c (patch) | |
| tree | 20a737ae03097f905f0e9230c85c04123e5b5894 /tests | |
| parent | d1b987be17d4f05e79530f9f0896284fbe354205 (diff) | |
| download | tcl-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')
| -rw-r--r-- | tests/chan.test | 9 | ||||
| -rw-r--r-- | tests/io.test | 277 | ||||
| -rw-r--r-- | tests/ioCmd.test | 3078 |
3 files changed, 3353 insertions, 11 deletions
diff --git a/tests/chan.test b/tests/chan.test index dd2fea6..f2376a3 100644 --- a/tests/chan.test +++ b/tests/chan.test @@ -7,19 +7,24 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: chan.test,v 1.4 2005/06/07 21:31:53 dkf Exp $ +# RCS: @(#) $Id: chan.test,v 1.5 2005/08/24 17:56:24 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } +# +# Note: The tests for the chan methods "create" and "postevent" +# currently reside in the file "ioCmd.test". +# + test chan-1.1 {chan command general syntax} -body { chan } -returnCodes error -result "wrong # args: should be \"chan subcommand ?argument ...?\"" test chan-1.2 {chan command general syntax} -body { chan FOOBAR -} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, eof, event, flush, gets, names, puts, read, seek, tell, or truncate" +} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate" test chan-2.1 {chan command: blocked subcommand} -body { chan blocked foo bar diff --git a/tests/io.test b/tests/io.test index 9d724b8..4edb308 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1,3 +1,4 @@ +# -*- tcl -*- # Functionality covered: operation of all IO commands, and all procedures # defined in generic/tclIO.c. # @@ -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: io.test,v 1.68 2005/05/10 18:35:21 kennykb Exp $ +# RCS: @(#) $Id: io.test,v 1.69 2005/08/24 17:56:24 andreas_kupries Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -28,14 +29,14 @@ namespace eval ::tcl::test::io { namespace import ::tcltest::testConstraint namespace import ::tcltest::viewFile -testConstraint testchannel [llength [info commands testchannel]] -testConstraint exec [llength [info commands exec]] -testConstraint openpipe 1 -testConstraint fileevent [llength [info commands fileevent]] -testConstraint fcopy [llength [info commands fcopy]] -testConstraint testfevent [llength [info commands testfevent]] +testConstraint testchannel [llength [info commands testchannel]] +testConstraint exec [llength [info commands exec]] +testConstraint openpipe 1 +testConstraint fileevent [llength [info commands fileevent]] +testConstraint fcopy [llength [info commands fcopy]] +testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] -testConstraint testmainthread [llength [info commands testmainthread]] +testConstraint testmainthread [llength [info commands testmainthread]] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... @@ -7111,6 +7112,266 @@ test io-61.1 {Reset eof state after changing the eof char} -setup { removeFile eofchar } -result {77 = 23431} + +# Test the cutting and splicing of channels, this is incidentially the +# attach/detach facility of package Thread, but __without any +# safeguards__. It can also be used to emulate transfer of channels +# between threads, and is used for that here. + +test io-70.0 {Cutting & Splicing channels} {testchannel} { + set f [makeFile {... dummy ...} cutsplice] + set c [open $f r] + + set res {} + lappend res [catch {seek $c 0 start}] + testchannel cut $c + + lappend res [catch {seek $c 0 start}] + testchannel splice $c + + lappend res [catch {seek $c 0 start}] + close $c + + removeFile cutsplice + + set res +} {0 1 0} + + +# 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 + } +} + +test io-70.1 {Transfer channel} {testchannel testthread} { + set f [makeFile {... dummy ...} cutsplice] + set c [open $f r] + + set res {} + lappend res [catch {seek $c 0 start}] + testchannel cut $c + lappend res [catch {seek $c 0 start}] + + set tid [testthread create] + testthread send $tid [list set c $c] + lappend res [testthread send $tid { + testchannel splice $c + set res [catch {seek $c 0 start}] + close $c + set res + }] + + tcltest::threadReap + removeFile cutsplice + + set res +} {0 1 0} + +# ### ### ### ######### ######### ######### + +foreach {n msg expected} { + 0 {} {} + 1 {{message only}} {{message only}} + 2 {-options x} {-options x} + 3 {-options {x y} {the message}} {-options {x y} {the message}} + + 4 {-code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 5 {-code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 6 {-code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 7 {-code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 8 {-code error -level 0 -f ba snarf} {-code error -level 0 -f ba snarf} + 9 {-code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 10 {-code error -level 5 -f ba snarf} {-code error -level 0 -f ba snarf} + 11 {-code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 12 {-code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 13 {-code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 14 {-code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} + 15 {-code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} + 16 {-code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} + 17 {-code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} + 18 {-code error -level 0 -f ba} {-code error -level 0 -f ba} + 19 {-code ok -level 0 -f ba} {-code 1 -level 0 -f ba} + 20 {-code error -level 5 -f ba} {-code error -level 0 -f ba} + 21 {-code ok -level 5 -f ba} {-code 1 -level 0 -f ba} + 22 {-code boss -level 0 -f ba} {-code 1 -level 0 -f ba} + 23 {-code boss -level 5 -f ba} {-code 1 -level 0 -f ba} + 24 {-code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 25 {-code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 26 {-code error -level X -f ba snarf} {-code error -level 0 -f ba snarf} + 27 {-code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 28 {-code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 29 {-code 1 -level X -f ba} {-code 1 -level 0 -f ba} + 30 {-code 0 -level X -f ba} {-code 1 -level 0 -f ba} + 31 {-code error -level X -f ba} {-code error -level 0 -f ba} + 32 {-code ok -level X -f ba} {-code 1 -level 0 -f ba} + 33 {-code boss -level X -f ba} {-code 1 -level 0 -f ba} + + 34 {-code 1 -code 1 -level 0 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} + 35 {-code 1 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 36 {-code 1 -code 1 -level 5 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} + 37 {-code 1 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 38 {-code 1 -code error -level 0 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} + 39 {-code 1 -code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 40 {-code 1 -code error -level 5 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} + 41 {-code 1 -code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 42 {-code 1 -code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 43 {-code 1 -code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 44 {-code 1 -code 1 -level 0 -f ba} {-code 1 -code 1 -level 0 -f ba} + 45 {-code 1 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} + 46 {-code 1 -code 1 -level 5 -f ba} {-code 1 -code 1 -level 0 -f ba} + 47 {-code 1 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} + 48 {-code 1 -code error -level 0 -f ba} {-code 1 -code error -level 0 -f ba} + 49 {-code 1 -code ok -level 0 -f ba} {-code 1 -level 0 -f ba} + 50 {-code 1 -code error -level 5 -f ba} {-code 1 -code error -level 0 -f ba} + 51 {-code 1 -code ok -level 5 -f ba} {-code 1 -level 0 -f ba} + 52 {-code 1 -code boss -level 0 -f ba} {-code 1 -level 0 -f ba} + 53 {-code 1 -code boss -level 5 -f ba} {-code 1 -level 0 -f ba} + 54 {-code 1 -code 1 -level X -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} + 55 {-code 1 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 56 {-code 1 -code error -level X -f ba snarf} {-code 1 -code error -level 0 -f ba snarf} + 57 {-code 1 -code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 58 {-code 1 -code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 59 {-code 1 -code 1 -level X -f ba} {-code 1 -code 1 -level 0 -f ba} + 60 {-code 1 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} + 61 {-code 1 -code error -level X -f ba} {-code 1 -code error -level 0 -f ba} + 62 {-code 1 -code ok -level X -f ba} {-code 1 -level 0 -f ba} + 63 {-code 1 -code boss -level X -f ba} {-code 1 -level 0 -f ba} + + 64 {-code 0 -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 65 {-code 0 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 66 {-code 0 -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 67 {-code 0 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 68 {-code 0 -code error -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 69 {-code 0 -code ok -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 70 {-code 0 -code error -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 71 {-code 0 -code ok -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 72 {-code 0 -code boss -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 73 {-code 0 -code boss -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 74 {-code 0 -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} + 75 {-code 0 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} + 76 {-code 0 -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} + 77 {-code 0 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} + 78 {-code 0 -code error -level 0 -f ba} {-code 1 -level 0 -f ba} + 79 {-code 0 -code ok -level 0 -f ba} {-code 1 -level 0 -f ba} + 80 {-code 0 -code error -level 5 -f ba} {-code 1 -level 0 -f ba} + 81 {-code 0 -code ok -level 5 -f ba} {-code 1 -level 0 -f ba} + 82 {-code 0 -code boss -level 0 -f ba} {-code 1 -level 0 -f ba} + 83 {-code 0 -code boss -level 5 -f ba} {-code 1 -level 0 -f ba} + 84 {-code 0 -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 85 {-code 0 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 86 {-code 0 -code error -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 87 {-code 0 -code ok -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 88 {-code 0 -code boss -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + 89 {-code 0 -code 1 -level X -f ba} {-code 1 -level 0 -f ba} + 90 {-code 0 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} + 91 {-code 0 -code error -level X -f ba} {-code 1 -level 0 -f ba} + 92 {-code 0 -code ok -level X -f ba} {-code 1 -level 0 -f ba} + 93 {-code 0 -code boss -level X -f ba} {-code 1 -level 0 -f ba} + + 94 {-code 1 -code 1 -level 0 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} + 95 {-code 0 -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 96 {-code 1 -code 1 -level 5 -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} + 97 {-code 0 -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + 98 {-code error -code 1 -level 0 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} + 99 {-code ok -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + a0 {-code error -code 1 -level 5 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} + a1 {-code ok -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + a2 {-code boss -code 1 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + a3 {-code boss -code 1 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + a4 {-code 1 -code 1 -level 0 -f ba} {-code 1 -code 1 -level 0 -f ba} + a5 {-code 0 -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} + a6 {-code 1 -code 1 -level 5 -f ba} {-code 1 -code 1 -level 0 -f ba} + a7 {-code 0 -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} + a8 {-code error -code 1 -level 0 -f ba} {-code error -code 1 -level 0 -f ba} + a9 {-code ok -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} + b0 {-code error -code 1 -level 5 -f ba} {-code error -code 1 -level 0 -f ba} + b1 {-code ok -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} + b2 {-code boss -code 1 -level 0 -f ba} {-code 1 -level 0 -f ba} + b3 {-code boss -code 1 -level 5 -f ba} {-code 1 -level 0 -f ba} + b4 {-code 1 -code 1 -level X -f ba snarf} {-code 1 -code 1 -level 0 -f ba snarf} + b5 {-code 0 -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + b6 {-code error -code 1 -level X -f ba snarf} {-code error -code 1 -level 0 -f ba snarf} + b7 {-code ok -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + b8 {-code boss -code 1 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + b9 {-code 1 -code 1 -level X -f ba} {-code 1 -code 1 -level 0 -f ba} + c0 {-code 0 -code 1 -level X -f ba} {-code 1 -level 0 -f ba} + c1 {-code error -code 1 -level X -f ba} {-code error -code 1 -level 0 -f ba} + c2 {-code ok -code 1 -level X -f ba} {-code 1 -level 0 -f ba} + c3 {-code boss -code 1 -level X -f ba} {-code 1 -level 0 -f ba} + + c4 {-code 1 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + c5 {-code 0 -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + c6 {-code 1 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + c7 {-code 0 -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + c8 {-code error -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + c9 {-code ok -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + d0 {-code error -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + d1 {-code ok -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + d2 {-code boss -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf} + d3 {-code boss -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf} + d4 {-code 1 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} + d5 {-code 0 -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} + d6 {-code 1 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} + d7 {-code 0 -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} + d8 {-code error -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} + d9 {-code ok -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} + e0 {-code error -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} + e1 {-code ok -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} + e2 {-code boss -code 0 -level 0 -f ba} {-code 1 -level 0 -f ba} + e3 {-code boss -code 0 -level 5 -f ba} {-code 1 -level 0 -f ba} + e4 {-code 1 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + e5 {-code 0 -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + e6 {-code error -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + e7 {-code ok -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + e8 {-code boss -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf} + e9 {-code 1 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} + f0 {-code 0 -code 0 -level X -f ba} {-code 1 -level 0 -f ba} + f1 {-code error -code 0 -level X -f ba} {-code 1 -level 0 -f ba} + f2 {-code ok -code 0 -level X -f ba} {-code 1 -level 0 -f ba} + f3 {-code boss -code 0 -level X -f ba} {-code 1 -level 0 -f ba} +} { + test io-71.$n {Tcl_SetChannelError} {testchannel} { + + set f [makeFile {... dummy ...} cutsplice] + set c [open $f r] + + set res [testchannel setchannelerror $c [lrange $msg 0 end]] + close $c + removeFile cutsplice + + set res + } [lrange $expected 0 end] + + test io-72.$n {Tcl_SetChannelErrorInterp} {testchannel} { + + set f [makeFile {... dummy ...} cutsplice] + set c [open $f r] + + set res [testchannel setchannelerrorinterp $c [lrange $msg 0 end]] + close $c + removeFile cutsplice + + set res + } [lrange $expected 0 end] +} + +# ### ### ### ######### ######### ######### + # cleanup foreach file [list fooBar longfile script output test1 pipe my_script foo \ bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { 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 |