Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/ioCmd.test @ 45

Last change on this file since 45 was 25, checked in by landauf, 18 years ago

added tcl to libs
File size: 105.6 KB
RevLine 
[25]1# -*- tcl -*-
2# Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
3#                   fblocked, fconfigure, open, channel, fcopy
4#
5# This file contains a collection of tests for one or more of the Tcl
6# built-in commands.  Sourcing this file into Tcl runs the tests and
7# generates output for errors.  No output means no errors were found.
8#
9# Copyright (c) 1991-1994 The Regents of the University of California.
10# Copyright (c) 1994-1996 Sun Microsystems, Inc.
11# Copyright (c) 1998-1999 by Scriptics Corporation.
12#
13# See the file "license.terms" for information on usage and redistribution
14# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15#
16# RCS: @(#) $Id: ioCmd.test,v 1.36 2008/03/11 22:28:34 das Exp $
17
18if {[lsearch [namespace children] ::tcltest] == -1} {
19    package require tcltest 2
20    namespace import -force ::tcltest::*
21}
22
23# Custom constraints used in this file
24testConstraint fcopy            [llength [info commands fcopy]]
25testConstraint testchannel      [llength [info commands testchannel]]
26testConstraint testthread       [llength [info commands testthread]]
27
28#----------------------------------------------------------------------
29
30test iocmd-1.1 {puts command} {
31   list [catch {puts} msg] $msg
32} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
33test iocmd-1.2 {puts command} {
34   list [catch {puts a b c d e f g} msg] $msg
35} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
36test iocmd-1.3 {puts command} {
37   list [catch {puts froboz -nonewline kablooie} msg] $msg
38} {1 {bad argument "kablooie": should be "nonewline"}}
39test iocmd-1.4 {puts command} {
40   list [catch {puts froboz hello} msg] $msg
41} {1 {can not find channel named "froboz"}}
42test iocmd-1.5 {puts command} {
43   list [catch {puts stdin hello} msg] $msg
44} {1 {channel "stdin" wasn't opened for writing}}
45
46set path(test1) [makeFile {} test1]
47
48test iocmd-1.6 {puts command} {
49    set f [open $path(test1) w]
50    fconfigure $f -translation lf -eofchar {}
51    puts -nonewline $f foobar
52    close $f
53    file size $path(test1)
54} 6
55test iocmd-1.7 {puts command} {
56    set f [open $path(test1) w]
57    fconfigure $f -translation lf -eofchar {}
58    puts $f foobar
59    close $f
60    file size $path(test1)
61} 7
62test iocmd-1.8 {puts command} {
63    set f [open $path(test1) w]
64    fconfigure $f -translation lf -eofchar {} -encoding iso8859-1
65    puts -nonewline $f [binary format a4a5 foo bar]
66    close $f
67    file size $path(test1)
68} 9
69
70test iocmd-2.1 {flush command} {
71   list [catch {flush} msg] $msg
72} {1 {wrong # args: should be "flush channelId"}}
73test iocmd-2.2 {flush command} {
74   list [catch {flush a b c d e} msg] $msg
75} {1 {wrong # args: should be "flush channelId"}}
76test iocmd-2.3 {flush command} {
77   list [catch {flush foo} msg] $msg
78} {1 {can not find channel named "foo"}}
79test iocmd-2.4 {flush command} {
80   list [catch {flush stdin} msg] $msg
81} {1 {channel "stdin" wasn't opened for writing}}
82
83test iocmd-3.1 {gets command} {
84   list [catch {gets} msg] $msg
85} {1 {wrong # args: should be "gets channelId ?varName?"}}
86test iocmd-3.2 {gets command} {
87   list [catch {gets a b c d e f g} msg] $msg
88} {1 {wrong # args: should be "gets channelId ?varName?"}}
89test iocmd-3.3 {gets command} {
90   list [catch {gets aaa} msg] $msg
91} {1 {can not find channel named "aaa"}}
92test iocmd-3.4 {gets command} {
93   list [catch {gets stdout} msg] $msg
94} {1 {channel "stdout" wasn't opened for reading}}
95test iocmd-3.5 {gets command} {
96    set f [open $path(test1) w]
97    puts $f [binary format a4a5 foo bar]
98    close $f
99    set f [open $path(test1) r]
100    set result [gets $f]
101    close $f
102    set x foo\x00
103    set x "${x}bar\x00\x00"
104    string compare $x $result
105} 0
106
107test iocmd-4.1 {read command} {
108   list [catch {read} msg] $msg
109} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
110test iocmd-4.2 {read command} {
111   list [catch {read a b c d e f g h} msg] $msg
112} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
113test iocmd-4.3 {read command} {
114   list [catch {read aaa} msg] $msg
115} {1 {can not find channel named "aaa"}}
116test iocmd-4.4 {read command} {
117   list [catch {read -nonewline} msg] $msg
118} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
119test iocmd-4.5 {read command} {
120   list [catch {read -nonew file4} msg] $msg $::errorCode
121} {1 {can not find channel named "-nonew"} {TCL LOOKUP CHANNEL -nonew}}
122test iocmd-4.6 {read command} {
123   list [catch {read stdout} msg] $msg
124} {1 {channel "stdout" wasn't opened for reading}}
125test iocmd-4.7 {read command} {
126   list [catch {read -nonewline stdout} msg] $msg
127} {1 {channel "stdout" wasn't opened for reading}}
128test iocmd-4.8 {read command with incorrect combination of arguments} {
129    file delete $path(test1)
130    set f [open $path(test1) w]
131    puts $f "Two lines: this one"
132    puts $f "and this one"
133    close $f
134    set f [open $path(test1)]
135    set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode]
136    close $f
137    set x
138} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE}
139test iocmd-4.9 {read command} {
140    list [catch {read stdin foo} msg] $msg $::errorCode
141} {1 {bad argument "foo": should be "nonewline"} NONE}
142test iocmd-4.10 {read command} {
143    list [catch {read file107} msg] $msg $::errorCode
144} {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}}
145set path(test3) [makeFile {} test3]
146test iocmd-4.11 {read command} {
147    set f [open $path(test3) w]
148    set x [list [catch {read $f} msg] $msg $::errorCode]
149    close $f
150    string compare [string tolower $x] \
151        [list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
152} 0
153test iocmd-4.12 {read command} {
154    set f [open $path(test1)]
155    set x [list [catch {read $f 12z} msg] $msg $::errorCode]
156    close $f
157    set x
158} {1 {expected integer but got "12z"} NONE}
159
160test iocmd-5.1 {seek command} {
161    list [catch {seek} msg] $msg
162} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
163test iocmd-5.2 {seek command} {
164    list [catch {seek a b c d e f g} msg] $msg
165} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
166test iocmd-5.3 {seek command} {
167    list [catch {seek stdin gugu} msg] $msg
168} {1 {expected integer but got "gugu"}}
169test iocmd-5.4 {seek command} {
170    list [catch {seek stdin 100 gugu} msg] $msg
171} {1 {bad origin "gugu": must be start, current, or end}}
172
173test iocmd-6.1 {tell command} {
174    list [catch {tell} msg] $msg
175} {1 {wrong # args: should be "tell channelId"}}
176test iocmd-6.2 {tell command} {
177    list [catch {tell a b c d e} msg] $msg
178} {1 {wrong # args: should be "tell channelId"}}
179test iocmd-6.3 {tell command} {
180    list [catch {tell aaa} msg] $msg
181} {1 {can not find channel named "aaa"}}
182
183test iocmd-7.1 {close command} {
184    list [catch {close} msg] $msg
185} {1 {wrong # args: should be "close channelId"}}
186test iocmd-7.2 {close command} {
187    list [catch {close a b c d e} msg] $msg
188} {1 {wrong # args: should be "close channelId"}}
189test iocmd-7.3 {close command} {
190    list [catch {close aaa} msg] $msg
191} {1 {can not find channel named "aaa"}}
192
193test iocmd-8.1 {fconfigure command} {
194    list [catch {fconfigure} msg] $msg
195} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
196test iocmd-8.2 {fconfigure command} {
197    list [catch {fconfigure a b c d e f} msg] $msg
198} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
199test iocmd-8.3 {fconfigure command} {
200    list [catch {fconfigure a b} msg] $msg
201} {1 {can not find channel named "a"}}
202test iocmd-8.4 {fconfigure command} {
203    file delete $path(test1)
204    set f1 [open $path(test1) w]
205    set x [list [catch {fconfigure $f1 froboz} msg] $msg]
206    close $f1
207    set x
208} {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
209test iocmd-8.5 {fconfigure command} {
210    list [catch {fconfigure stdin -buffering froboz} msg] $msg
211} {1 {bad value for -buffering: must be one of full, line, or none}}
212test iocmd-8.6 {fconfigure command} {
213    list [catch {fconfigure stdin -translation froboz} msg] $msg
214} {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}}
215test iocmd-8.7 {fconfigure command} {
216    file delete $path(test1)
217    set f1 [open $path(test1) w]
218    fconfigure $f1 -translation lf -eofchar {} -encoding unicode
219    set x [fconfigure $f1]
220    close $f1
221    set x
222} {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf}
223test iocmd-8.8 {fconfigure command} {
224    file delete $path(test1)
225    set f1 [open $path(test1) w]
226    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
227                -eofchar {} -encoding unicode
228    set x ""
229    lappend x [fconfigure $f1 -buffering]
230    lappend x [fconfigure $f1]
231    close $f1
232    set x
233} {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}}
234test iocmd-8.9 {fconfigure command} {
235    file delete $path(test1)
236    set f1 [open $path(test1) w]
237    fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
238                -eofchar {} -encoding binary
239    set x [fconfigure $f1]
240    close $f1
241    set x
242} {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf}
243test iocmd-8.10 {fconfigure command} {
244    list [catch {fconfigure a b} msg] $msg
245} {1 {can not find channel named "a"}}
246set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
247test iocmd-8.11 {fconfigure command} {
248    set chan [open $path(fconfigure.dummy) r]
249    set res [list [catch {fconfigure $chan -froboz blarfo} msg] $msg]
250    close $chan
251    set res
252} {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
253test iocmd-8.12 {fconfigure command} {
254    set chan [open $path(fconfigure.dummy) r]
255    set res [list [catch {fconfigure $chan -b blarfo} msg] $msg]
256    close $chan
257    set res
258} {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
259test iocmd-8.13 {fconfigure command} {
260    set chan [open $path(fconfigure.dummy) r]
261    set res [list [catch {fconfigure $chan -buffer blarfo} msg] $msg]
262    close $chan
263    set res
264} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
265removeFile fconfigure.dummy
266test iocmd-8.14 {fconfigure command} {
267    fconfigure stdin -buffers
268} 4096
269test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup {
270    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
271    set port [lindex [fconfigure $srv -sockname] 2]
272    proc iocmdSRV {sock ip port} {close $sock}
273    set cli [socket 127.0.0.1 $port]
274} -body {
275    fconfigure $cli -blah
276} -cleanup {
277    close $cli
278    close $srv
279    unset cli srv port
280    rename iocmdSRV {}
281} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}
282test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
283    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
284    set port [lindex [fconfigure $srv -sockname] 2]
285    proc iocmdSRV {sock ip port} {close $sock}
286    set cli [socket 127.0.0.1 $port]
287} -body {
288    expr {[lindex [fconfigure $cli -peername] 2] == $port}
289} -cleanup {
290    close $cli
291    close $srv
292    unset cli srv port
293    rename iocmdSRV {}
294} -result 1
295test iocmd-8.17 {fconfigure command / tcp channel} -constraints nonPortable -setup {
296    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
297    set port [lindex [fconfigure $srv -sockname] 2]
298    proc iocmdSRV {sock ip port} {close $sock}
299    set cli [socket 127.0.0.1 $port]
300} -body {
301    # It is possible that you don't get the connection reset by peer
302    # error but rather a valid answer. Depends on the tcp implementation
303    update
304    puts $cli "blah"
305    flush $cli;                 # that flush could/should fail too
306    update
307    regsub -all {can([^:])+: } [catch {fconfigure $cli -peername} msg] {}
308} -cleanup {
309    close $cli
310    close $srv
311    unset cli srv port
312    rename iocmdSRV {}
313} -result 1
314test iocmd-8.18 {fconfigure command / unix tty channel} -constraints {nonPortable unix} -setup {
315    set tty ""
316} -body {
317    # might fail if /dev/ttya is unavailable
318    set tty [open /dev/ttya]
319    fconfigure $tty -blah blih
320} -cleanup {
321    if {$tty ne ""} {
322        close $tty
323    }
324} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}
325test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable win} -setup {
326    set tty ""
327} -body {
328    # might fail early if com1 is unavailable
329    set tty [open com1]
330    fconfigure $tty -blah blih
331} -cleanup {
332    if {$tty ne ""} {
333        close $tty
334    }
335} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar}
336# TODO: Test parsing of serial channel options (nonportable, since requires an
337# open channel to work with).
338
339test iocmd-9.1 {eof command} {
340    list [catch {eof} msg] $msg $::errorCode
341} {1 {wrong # args: should be "eof channelId"} NONE}
342test iocmd-9.2 {eof command} {
343    list [catch {eof a b} msg] $msg $::errorCode
344} {1 {wrong # args: should be "eof channelId"} NONE}
345test iocmd-9.3 {eof command} {
346    catch {close file100}
347    list [catch {eof file100} msg] $msg $::errorCode
348} {1 {can not find channel named "file100"} {TCL LOOKUP CHANNEL file100}}
349
350# The tests for Tcl_ExecObjCmd are in exec.test
351
352test iocmd-10.1 {fblocked command} {
353    list [catch {fblocked} msg] $msg
354} {1 {wrong # args: should be "fblocked channelId"}}
355test iocmd-10.2 {fblocked command} {
356    list [catch {fblocked a b c d e f g} msg] $msg
357} {1 {wrong # args: should be "fblocked channelId"}}
358test iocmd-10.3 {fblocked command} {
359    list [catch {fblocked file1000} msg] $msg
360} {1 {can not find channel named "file1000"}}
361test iocmd-10.4 {fblocked command} {
362    list [catch {fblocked stdout} msg] $msg
363} {1 {channel "stdout" wasn't opened for reading}}
364test iocmd-10.5 {fblocked command} {
365    fblocked stdin
366} 0
367
368set path(test4) [makeFile {} test4]
369set path(test5) [makeFile {} test5]
370
371file delete $path(test5)
372test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
373    set f [open $path(test4) w]
374    close $f
375    list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
376} {1 {can't write input to command: standard input was redirected} NONE}
377test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
378    list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
379} {1 {can't read output from command: standard output was redirected} NONE}
380test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
381    list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
382} {1 {can't read output from command: standard output was redirected} NONE}
383
384test iocmd-12.1 {POSIX open access modes: RDONLY} {
385    file delete $path(test1)
386    set f [open $path(test1) w]
387    puts $f "Two lines: this one"
388    puts $f "and this one"
389    close $f
390    set f [open $path(test1) RDONLY]
391    set x [list [gets $f] [catch {puts $f Test} msg] $msg]
392    close $f
393    string compare $x \
394        "{Two lines: this one} 1 [list [format "channel \"%s\" wasn't opened for writing" $f]]"
395} 0
396test iocmd-12.2 {POSIX open access modes: RDONLY} -match regexp -body {
397    file delete $path(test3)
398    open $path(test3) RDONLY
399} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
400test iocmd-12.3 {POSIX open access modes: WRONLY} -match regexp -body {
401    file delete $path(test3)
402    open $path(test3) WRONLY
403} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
404#
405# Test 13.4 relies on assigning the same channel name twice.
406#
407test iocmd-12.4 {POSIX open access modes: WRONLY} {unix} {
408    file delete $path(test3)
409    set f [open $path(test3) w]
410    fconfigure $f -eofchar {}
411    puts $f xyzzy
412    close $f
413    set f [open $path(test3) WRONLY]
414    fconfigure $f -eofchar {}
415    puts -nonewline $f "ab"
416    seek $f 0 current
417    set x [list [catch {gets $f} msg] $msg]
418    close $f
419    set f [open $path(test3) r]
420    fconfigure $f -eofchar {}
421    lappend x [gets $f]
422    close $f
423    set y [list 1 [format "channel \"%s\" wasn't opened for reading" $f] abzzy]
424    string compare $x $y
425} 0
426test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body {
427    file delete $path(test3)
428    open $path(test3) RDWR
429} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
430test iocmd-12.6 {POSIX open access modes: errors} {
431    concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$::errorInfo
432} "1 unmatched open brace in list
433unmatched open brace in list
434    while processing open access modes \"FOO {BAR BAZ\"
435    invoked from within
436\"open \$path(test3) \"FOO \\{BAR BAZ\"\""
437test iocmd-12.7 {POSIX open access modes: errors} {
438  list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg
439} {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC}}
440test iocmd-12.8 {POSIX open access modes: errors} {
441    list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg
442} {1 {access mode must include either RDONLY, WRONLY, or RDWR}}
443close [open $path(test3) w]
444test iocmd-12.9 {POSIX open access modes: BINARY} {
445    list [catch {open $path(test1) BINARY} msg] $msg
446} {1 {access mode must include either RDONLY, WRONLY, or RDWR}}
447test iocmd-12.10 {POSIX open access modes: BINARY} {
448    set f [open $path(test1) {WRONLY BINARY TRUNC}]
449    puts $f a
450    puts $f b
451    puts -nonewline $f c        ;# contents are now 5 bytes: a\nb\nc
452    close $f
453    set f [open $path(test1) r]
454    fconfigure $f -translation binary
455    set result [string length [read $f]]
456    close $f
457    set result
458} 5
459test iocmd-12.11 {POSIX open access modes: BINARY} {
460    set f [open $path(test1) {WRONLY BINARY TRUNC}]
461    puts $f \u0248              ;# gets truncated to \u0048
462    close $f
463    set f [open $path(test1) r]
464    fconfigure $f -translation binary
465    set result [read -nonewline $f]
466    close $f
467    set result
468} \u0048
469
470test iocmd-13.1 {errors in open command} {
471    list [catch {open} msg] $msg
472} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
473test iocmd-13.2 {errors in open command} {
474    list [catch {open a b c d} msg] $msg
475} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
476test iocmd-13.3 {errors in open command} {
477    list [catch {open $path(test1) x} msg] $msg
478} {1 {illegal access mode "x"}}
479test iocmd-13.4 {errors in open command} {
480    list [catch {open $path(test1) rw} msg] $msg
481} {1 {illegal access mode "rw"}}
482test iocmd-13.5 {errors in open command} {
483    list [catch {open $path(test1) r+1} msg] $msg
484} {1 {illegal access mode "r+1"}}
485test iocmd-13.6 {errors in open command} {
486    set msg [list [catch {open _non_existent_} msg] $msg $::errorCode]
487    regsub [file join {} _non_existent_] $msg "_non_existent_" msg
488    string tolower $msg
489} {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
490test iocmd-13.7 {errors in open command} {
491    list [catch {open $path(test1) b} msg] $msg
492} {1 {illegal access mode "b"}}
493test iocmd-13.8 {errors in open command} {
494    list [catch {open $path(test1) rbb} msg] $msg
495} {1 {illegal access mode "rbb"}}
496test iocmd-13.9 {errors in open command} {
497    list [catch {open $path(test1) r++} msg] $msg
498} {1 {illegal access mode "r++"}}
499test iocmd-13.10.1 {open for append, a mode} -setup {
500    set log   [makeFile {} out]
501    set chans {}
502} -body {
503    foreach i { 0 1 2 3 4 5 6 7 8 9 } {
504        puts [set ch [open $log a]] $i
505        lappend chans $ch
506    }
507    foreach ch $chans {catch {close $ch}}
508    lsort [split [string trim [viewFile out]] \n]
509} -cleanup {
510    removeFile out
511    # Ensure that channels are gone, even if body failed to do so
512    foreach ch $chans {catch {close $ch}}
513} -result {0 1 2 3 4 5 6 7 8 9}
514test iocmd-13.10.2 {open for append, O_APPEND} -setup {
515    set log   [makeFile {} out]
516    set chans {}
517} -body {
518    foreach i { 0 1 2 3 4 5 6 7 8 9 } {
519        puts [set ch [open $log {WRONLY CREAT APPEND}]] $i
520        lappend chans $ch
521    }
522    foreach ch $chans {catch {close $ch}}
523    lsort [split [string trim [viewFile out]] \n]
524} -cleanup {
525    removeFile out
526    # Ensure that channels are gone, even if body failed to do so
527    foreach ch $chans {catch {close $ch}}
528} -result {0 1 2 3 4 5 6 7 8 9}
529
530test iocmd-14.1 {file id parsing errors} {
531    list [catch {eof gorp} msg] $msg $::errorCode
532} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}}
533test iocmd-14.2 {file id parsing errors} {
534    list [catch {eof filex} msg] $msg
535} {1 {can not find channel named "filex"}}
536test iocmd-14.3 {file id parsing errors} {
537    list [catch {eof file12a} msg] $msg
538} {1 {can not find channel named "file12a"}}
539test iocmd-14.4 {file id parsing errors} {
540    list [catch {eof file123} msg] $msg
541} {1 {can not find channel named "file123"}}
542test iocmd-14.5 {file id parsing errors} {
543    list [catch {eof stdout} msg] $msg
544} {0 0}
545test iocmd-14.6 {file id parsing errors} {
546    list [catch {eof stdin} msg] $msg
547} {0 0}
548test iocmd-14.7 {file id parsing errors} {
549    list [catch {eof stdout} msg] $msg
550} {0 0}
551test iocmd-14.8 {file id parsing errors} {
552    list [catch {eof stderr} msg] $msg
553} {0 0}
554test iocmd-14.9 {file id parsing errors} {
555    list [catch {eof stderr1} msg] $msg
556} {1 {can not find channel named "stderr1"}}
557
558set f [open $path(test1) w]
559close $f
560
561set expect "1 {can not find channel named \"$f\"}"
562test iocmd-14.10 {file id parsing errors} {
563    list [catch {eof $f} msg] $msg
564} $expect
565
566test iocmd-15.1 {Tcl_FcopyObjCmd} {fcopy} {
567    list [catch {fcopy} msg] $msg
568} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
569test iocmd-15.2 {Tcl_FcopyObjCmd} {fcopy} {
570    list [catch {fcopy 1} msg] $msg
571} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
572test iocmd-15.3 {Tcl_FcopyObjCmd} {fcopy} {
573    list [catch {fcopy 1 2 3 4 5 6 7} msg] $msg
574} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
575test iocmd-15.4 {Tcl_FcopyObjCmd} {fcopy} {
576    list [catch {fcopy 1 2 3} msg] $msg
577} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
578test iocmd-15.5 {Tcl_FcopyObjCmd} {fcopy} {
579    list [catch {fcopy 1 2 3 4 5} msg] $msg
580} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
581
582set path(test2) [makeFile {} test2]
583set f [open $path(test1) w]
584close $f
585set rfile [open $path(test1) r]
586set wfile [open $path(test2) w]
587
588test iocmd-15.6 {Tcl_FcopyObjCmd} {fcopy} {
589    list [catch {fcopy foo $wfile} msg] $msg
590} {1 {can not find channel named "foo"}}
591test iocmd-15.7 {Tcl_FcopyObjCmd} {fcopy} {
592    list [catch {fcopy $rfile foo} msg] $msg
593} {1 {can not find channel named "foo"}}
594test iocmd-15.8 {Tcl_FcopyObjCmd} {fcopy} {
595    list [catch {fcopy $wfile $wfile} msg] $msg
596} "1 {channel \"$wfile\" wasn't opened for reading}"
597test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} {
598    list [catch {fcopy $rfile $rfile} msg] $msg
599} "1 {channel \"$rfile\" wasn't opened for writing}"
600test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} {
601    list [catch {fcopy $rfile $wfile foo bar} msg] $msg
602} {1 {bad switch "foo": must be -size or -command}}
603test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} {
604    list [catch {fcopy $rfile $wfile -size foo} msg] $msg
605} {1 {expected integer but got "foo"}}
606test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
607    list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg
608} {1 {expected integer but got "foo"}}
609
610close $rfile
611close $wfile
612
613# ### ### ### ######### ######### #########
614## Testing the reflected channel.
615
616test iocmd-20.0 {chan, wrong#args} {
617    catch {chan} msg
618    set msg
619} {wrong # args: should be "chan subcommand ?argument ...?"}
620test iocmd-20.1 {chan, unknown method} {
621    catch {chan foo} msg
622    set msg
623} {unknown or ambiguous subcommand "foo": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, pending, postevent, puts, read, seek, tell, or truncate}
624
625# --- --- --- --------- --------- ---------
626# chan create, and method "initalize"
627
628test iocmd-21.0 {chan create, wrong#args, not enough} {
629    catch {chan create} msg
630    set msg
631} {wrong # args: should be "chan create mode cmdprefix"}
632test iocmd-21.1 {chan create, wrong#args, too many} {
633    catch {chan create a b c} msg
634    set msg
635} {wrong # args: should be "chan create mode cmdprefix"}
636test iocmd-21.2 {chan create, invalid r/w mode, empty} {
637    proc foo {} {}
638    catch {chan create {} foo} msg
639    rename foo {}
640    set msg
641} {bad mode list: is empty}
642test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
643    proc foo {} {}
644    catch {chan create {c} foo} msg
645    rename foo {}
646    set msg
647} {bad mode "c": must be read or write}
648test iocmd-21.4 {chan create, bad handler, not a list} {
649    catch {chan create {r w} "foo \{"} msg
650    set msg
651} {unmatched open brace in list}
652test iocmd-21.5 {chan create, bad handler, not a command} {
653    catch {chan create {r w} foo} msg
654    set msg
655} {invalid command name "foo"}
656test iocmd-21.6 {chan create, initialize failed, bad signature} {
657    proc foo {} {}
658    catch {chan create {r w} foo} msg
659    rename foo {}
660    set msg
661} {wrong # args: should be "foo"}
662test iocmd-21.7 {chan create, initialize failed, bad signature} {
663    proc foo {} {}
664    catch {chan create {r w} ::foo} msg
665    rename foo {}
666    set msg
667} {wrong # args: should be "::foo"}
668test iocmd-21.8 {chan create, initialize failed, bad result, not a list} -body {
669    proc foo {args} {return "\{"}
670    catch {chan create {r w} foo} msg
671    rename foo {}
672    set ::errorInfo
673} -match glob -result {chan handler "foo initialize" returned non-list: *}
674test iocmd-21.9 {chan create, initialize failed, bad result, not a list} -body {
675    proc foo {args} {return \{\{\}}
676    catch {chan create {r w} foo} msg
677    rename foo {}
678    set msg
679} -match glob -result {chan handler "foo initialize" returned non-list: *}
680test iocmd-21.10 {chan create, initialize failed, bad result, empty list} -body {
681    proc foo {args} {}
682    catch {chan create {r w} foo} msg
683    rename foo {}
684    set msg
685} -match glob -result {*all required methods*}
686test iocmd-21.11 {chan create, initialize failed, bad result, bogus method name} -body {
687    proc foo {args} {return 1}
688    catch {chan create {r w} foo} msg
689    rename foo {}
690    set msg
691} -match glob -result {*bad method "1": must be *}
692test iocmd-21.12 {chan create, initialize failed, bad result, bogus method name} -body {
693    proc foo {args} {return {a b c}}
694    catch {chan create {r w} foo} msg
695    rename foo {}
696    set msg
697} -match glob -result {*bad method "c": must be *}
698test iocmd-21.13 {chan create, initialize failed, bad result, required methods missing} -body {
699    proc foo {args} {return {initialize finalize}}
700    catch {chan create {r w} foo} msg
701    rename foo {}
702    set msg
703} -match glob -result {*all required methods*}
704test iocmd-21.14 {chan create, initialize failed, bad result, mode/handler mismatch} -body {
705    proc foo {args} {return {initialize finalize watch read}}
706    catch {chan create {r w} foo} msg
707    rename foo {}
708    set msg
709} -match glob -result {*lacks a "write" method}
710test iocmd-21.15 {chan create, initialize failed, bad result, mode/handler mismatch} -body {
711    proc foo {args} {return {initialize finalize watch write}}
712    catch {chan create {r w} foo} msg
713    rename foo {}
714    set msg
715} -match glob -result {*lacks a "read" method}
716test iocmd-21.16 {chan create, initialize failed, bad result, cget(all) mismatch} -body {
717    proc foo {args} {return {initialize finalize watch cget write read}}
718    catch {chan create {r w} foo} msg
719    rename foo {}
720    set msg
721} -match glob -result {*supports "cget" but not "cgetall"}
722test iocmd-21.17 {chan create, initialize failed, bad result, cget(all) mismatch} -body {
723    proc foo {args} {return {initialize finalize watch cgetall read write}}
724    catch {chan create {r w} foo} msg
725    rename foo {}
726    set msg
727} -match glob -result {*supports "cgetall" but not "cget"}
728test iocmd-21.18 {chan create, initialize ok, creates channel} -match glob -body {
729    proc foo {args} {
730        global  res
731        lappend res $args
732        if {[lindex $args 0] ne "initialize"} {return}
733        return {initialize finalize watch read write}
734    }
735    set res {}
736    lappend res [file channel rc*]
737    lappend res [chan create {r w} foo]
738    lappend res [close [lindex $res end]]
739    lappend res [file channel rc*]
740    rename foo {}
741    set res
742} -result {{} {initialize rc* {read write}} rc* {finalize rc*} {} {}}
743test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match glob -body {
744    proc foo {args} {
745        global  res
746        lappend res $args
747        return {}
748    }
749    set res {}
750    lappend res [file channel rc*]
751    lappend res [catch {chan create {r w} foo} msg]
752    lappend res $msg
753    lappend res [file channel rc*]
754    rename foo {}
755    set res
756} -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
757
758# --- --- --- --------- --------- ---------
759# Helper commands to record the arguments to handler methods.
760
761proc note  {item}  {global res; lappend res $item; return}
762proc track {}      {upvar args item; note $item; return}
763proc notes {items} {foreach i $items {note $i}}
764# This forces the return options to be in the order that the test expects!
765proc noteOpts opts {global res; lappend res [dict merge {
766    -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
767} $opts]; return}
768
769# Helper command, canned result for 'initialize' method.
770# Gets the optional methods as arguments. Use return features
771# to post the result higher up.
772
773proc init {args} {
774    lappend args initialize finalize watch read write
775    return -code return $args
776}
777proc oninit {args} {
778    upvar args hargs
779    if {[lindex $hargs 0] ne "initialize"} {return}
780    lappend args initialize finalize watch read write
781    return -code return $args
782}
783proc onfinal {} {
784    upvar args hargs
785    if {[lindex $hargs 0] ne "finalize"} {return}
786    return -code return ""
787}
788
789# --- --- --- --------- --------- ---------
790# method finalize
791
792test iocmd-22.1 {chan finalize, handler destruction has no effect on channel} -match glob -body {
793    set res {}
794    proc foo {args} {track; oninit; return}
795    note [set c [chan create {r w} foo]]
796    rename foo {}
797    note [file channels rc*]
798    note [catch {close $c} msg]; note $msg
799    note [file channels rc*]
800    set res
801} -result {{initialize rc* {read write}} rc* rc* 1 {invalid command name "foo"} {}}
802test iocmd-22.2 {chan finalize, for close} -match glob -body {
803    set res {}
804    proc foo {args} {track; oninit; return {}}
805    note [set c [chan create {r w} foo]]
806    close $c
807    # Close deleted the channel.
808    note [file channels rc*]
809    # Channel destruction does not kill handler command!
810    note [info command foo]
811    rename foo {}
812    set res
813} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
814test iocmd-22.3 {chan finalize, for close, error, close error} -match glob -body {
815    set res {}
816    proc foo {args} {track; oninit; return -code error 5}
817    note [set c [chan create {r w} foo]]
818    note [catch {close $c} msg]; note $msg
819    # Channel is gone despite error.
820    note [file channels rc*]
821    rename foo {}
822    set res
823} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
824test iocmd-22.4 {chan finalize, for close, error, close error} -match glob -body {
825    set res {}
826    proc foo {args} {track; oninit; error FOO}
827    note [set c [chan create {r w} foo]]
828    note [catch {close $c} msg]; note $msg; note $::errorInfo
829    rename foo {}
830    set res
831} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO {FOO
832*"close $c"}}
833test iocmd-22.5 {chan finalize, for close, arbitrary result, ignored} -match glob -body {
834    set res {}
835    proc foo {args} {track; oninit; return SOMETHING}
836    note [set c [chan create {r w} foo]]
837    note [catch {close $c} msg]; note $msg
838    rename foo {}
839    set res
840} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
841test iocmd-22.6 {chan finalize, for close, break, close error} -match glob -body {
842    set res {}
843    proc foo {args} {track; oninit; return -code 3}
844    note [set c [chan create {r w} foo]]
845    note [catch {close $c} msg]; note $msg
846    rename foo {}
847    set res
848} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
849test iocmd-22.7 {chan finalize, for close, continue, close error} -match glob -body {
850    set res {}
851    proc foo {args} {track; oninit; return -code 4}
852    note [set c [chan create {r w} foo]]
853    note [catch {close $c} msg]; note $msg
854    rename foo {}
855    set res
856} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
857test iocmd-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
858    set res {}
859    proc foo {args} {track; oninit; return -code 777 BANG}
860    note [set c [chan create {r w} foo]]
861    note [catch {close $c} msg]; note $msg
862    rename foo {}
863    set res
864} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
865test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -setup {
866    set res {}
867} -body {
868    proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
869    note [set c [chan create {r w} foo]]
870    note [catch {close $c} msg opt]; note $msg; noteOpts $opt
871    return $res
872} -cleanup {
873    rename foo {}
874} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
875
876# --- === *** ###########################
877# method read
878
879test iocmd-23.1 {chan read, regular data return} -match glob -body {
880    set res {}
881    proc foo {args} {
882        oninit; onfinal; track
883        return snarf
884    }
885    set c [chan create {r w} foo]
886    note [read $c 10]
887    close $c
888    rename foo {}
889    set res
890} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
891test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
892    set res {}
893    proc foo {args} {
894        oninit; onfinal; track
895        return [string repeat snarf 1000]
896    }
897    set c [chan create {r w} foo]
898    note [catch {read $c 2} msg]; note $msg
899    close $c
900    rename foo {}
901    set res
902} -result {{read rc* 4096} 1 {read delivered more than requested}}
903test iocmd-23.3 {chan read, for non-readable channel} -match glob -body {
904    set res {}
905    proc foo {args} {
906        oninit; onfinal; track; note MUST_NOT_HAPPEN
907    }
908    set c [chan create {w} foo]
909    note [catch {read $c 2} msg]; note $msg
910    close $c
911    rename foo {}
912    set res
913} -result {1 {channel "rc*" wasn't opened for reading}}
914test iocmd-23.4 {chan read, error return} -match glob -body {
915    set res {}
916    proc foo {args} {
917        oninit; onfinal; track
918        return -code error BOOM!
919    }
920    set c [chan create {r w} foo]
921    note [catch {read $c 2} msg]; note $msg
922    close $c
923    rename foo {}
924    set res
925} -result {{read rc* 4096} 1 BOOM!}
926test iocmd-23.5 {chan read, break return is error} -match glob -body {
927    set res {}
928    proc foo {args} {
929        oninit; onfinal; track
930        return -code break BOOM!
931    }
932    set c [chan create {r w} foo]
933    note [catch {read $c 2} msg]; note $msg
934    close $c
935    rename foo {}
936    set res
937} -result {{read rc* 4096} 1 *bad code*}
938test iocmd-23.6 {chan read, continue return is error} -match glob -body {
939    set res {}
940    proc foo {args} {
941        oninit; onfinal; track
942        return -code continue BOOM!
943    }
944    set c [chan create {r w} foo]
945    note [catch {read $c 2} msg]; note $msg
946    close $c
947    rename foo {}
948    set res
949} -result {{read rc* 4096} 1 *bad code*}
950test iocmd-23.7 {chan read, custom return is error} -match glob -body {
951    set res {}
952    proc foo {args} {
953        oninit; onfinal; track
954        return -code 777 BOOM!
955    }
956    set c [chan create {r w} foo]
957    note [catch {read $c 2} msg]; note $msg
958    close $c
959    rename foo {}
960    set res
961} -result {{read rc* 4096} 1 *bad code*}
962test iocmd-23.8 {chan read, level is squashed} -match glob -body {
963    set res {}
964    proc foo {args} {
965        oninit; onfinal; track
966        return -level 55 -code 777 BOOM!
967    }
968    set c [chan create {r w} foo]
969    note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
970    close $c
971    rename foo {}
972    set res
973} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
974
975# --- === *** ###########################
976# method write
977
978test iocmd-24.1 {chan write, regular write} -match glob -body {
979    set res {}
980    proc foo {args} {
981        oninit; onfinal; track
982        set     written [string length [lindex $args 2]]
983        note   $written
984        return $written
985    }
986    set c [chan create {r w} foo]
987    puts -nonewline $c snarf; flush $c
988    close $c
989    rename foo {}
990    set res
991} -result {{write rc* snarf} 5}
992test iocmd-24.2 {chan write, partial write is ok} -match glob -body {
993    set res {}
994    proc foo {args} {
995        oninit; onfinal; track
996        set     written [string length [lindex $args 2]]
997        if {$written > 10} {set written [expr {$written / 2}]}
998        note   $written
999        return $written
1000    }
1001    set c [chan create {r w} foo]
1002    puts -nonewline $c snarfsnarfsnarf; flush $c
1003    close $c
1004    rename foo {}
1005    set res
1006} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
1007test iocmd-24.3 {chan write, failed write} -match glob -body {
1008    set res {}
1009    proc foo {args} {oninit; onfinal; track; note -1; return -1}
1010    set c [chan create {r w} foo]
1011    puts -nonewline $c snarfsnarfsnarf; flush $c
1012    close $c
1013    rename foo {}
1014    set res
1015} -result {{write rc* snarfsnarfsnarf} -1}
1016test iocmd-24.4 {chan write, non-writable channel} -match glob -body {
1017    set res {}
1018    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
1019    set c [chan create {r} foo]
1020    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]; note $msg
1021    close $c
1022    rename foo {}
1023    set res
1024} -result {1 {channel "rc*" wasn't opened for writing}}
1025test iocmd-24.5 {chan write, bad result, more written than data} -match glob -body {
1026    set res {}
1027    proc foo {args} {oninit; onfinal; track; return 10000}
1028    set c [chan create {r w} foo]
1029    note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg
1030    close $c
1031    rename foo {}
1032    set res
1033} -result {{write rc* snarf} 1 {write wrote more than requested}}
1034test iocmd-24.6 {chan write, bad result, zero-length write} -match glob -body {
1035    set res {}
1036    proc foo {args} {oninit; onfinal; track; return 0}
1037    set c [chan create {r w} foo]
1038    note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg
1039    close $c
1040    rename foo {}
1041    set res
1042} -result {{write rc* snarf} 1 {write wrote more than requested}}
1043test iocmd-24.7 {chan write, failed write, error return} -match glob -body {
1044    set res {}
1045    proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
1046    set c [chan create {r w} foo]
1047    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
1048    note $msg
1049    close $c
1050    rename foo {}
1051    set res
1052} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
1053test iocmd-24.8 {chan write, failed write, error return} -match glob -body {
1054    set res {}
1055    proc foo {args} {oninit; onfinal; track; error BOOM!}
1056    set c [chan create {r w} foo]
1057    notes [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
1058    note $msg
1059    close $c
1060    rename foo {}
1061    set res
1062} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
1063test iocmd-24.9 {chan write, failed write, break return is error} -match glob -body {
1064    set res {}
1065    proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
1066    set c [chan create {r w} foo]
1067    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
1068    note $msg
1069    close $c
1070    rename foo {}
1071    set res
1072} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
1073test iocmd-24.10 {chan write, failed write, continue return is error} -match glob -body {
1074    set res {}
1075    proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
1076    set c [chan create {r w} foo]
1077    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
1078    note $msg
1079    close $c
1080    rename foo {}
1081    set res
1082} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
1083test iocmd-24.11 {chan write, failed write, custom return is error} -match glob -body {
1084    set res {}
1085    proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
1086    set c [chan create {r w} foo]
1087    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
1088    note $msg
1089    close $c
1090    rename foo {}
1091    set res
1092} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
1093test iocmd-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
1094    set res {}
1095    proc foo {args} {oninit; onfinal; track; return BANG}
1096    set c [chan create {r w} foo]
1097    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
1098    note $msg
1099    close $c
1100    rename foo {}
1101    set res
1102} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}}
1103test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body {
1104    set res {}
1105    proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
1106    set c [chan create {r w} foo]
1107    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
1108    note $msg
1109    noteOpts $opt
1110    close $c
1111    rename foo {}
1112    set res
1113} -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}}
1114
1115# --- === *** ###########################
1116# method cgetall
1117
1118test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body {
1119    set res {}
1120    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
1121    set c [chan create {r w} foo]
1122    note [fconfigure $c]
1123    close $c
1124    rename foo {}
1125    set res
1126} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
1127test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
1128    set res {}
1129    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
1130    set c [chan create {r w} foo]
1131    note [fconfigure $c]
1132    close $c
1133    rename foo {}
1134    set res
1135} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
1136test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
1137    set res {}
1138    proc foo {args} {
1139        oninit cget cgetall; onfinal; track
1140        return "-bar foo -snarf x"
1141    }
1142    set c [chan create {r w} foo]
1143    note [fconfigure $c]
1144    close $c
1145    rename foo {}
1146    set res
1147} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
1148test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
1149    set res {}
1150    proc foo {args} {
1151        oninit cget cgetall; onfinal; track
1152        return "-bar"
1153    }
1154    set c [chan create {r w} foo]
1155    note [catch {fconfigure $c} msg]; note $msg
1156    close $c
1157    rename foo {}
1158    set res
1159} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
1160test iocmd-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
1161    set res {}
1162    proc foo {args} {
1163        oninit cget cgetall; onfinal; track
1164        return "\{"
1165    }
1166    set c [chan create {r w} foo]
1167    note [catch {fconfigure $c} msg]; note $msg
1168    close $c
1169    rename foo {}
1170    set res
1171} -result {{cgetall rc*} 1 {unmatched open brace in list}}
1172test iocmd-25.6 {chan configure, cgetall, error return} -match glob -body {
1173    set res {}
1174    proc foo {args} {
1175        oninit cget cgetall; onfinal; track
1176        return -code error BOOM!
1177    }
1178    set c [chan create {r w} foo]
1179    note [catch {fconfigure $c} msg]; note $msg
1180    close $c
1181    rename foo {}
1182    set res
1183} -result {{cgetall rc*} 1 BOOM!}
1184test iocmd-25.7 {chan configure, cgetall, break return is error} -match glob -body {
1185    set res {}
1186    proc foo {args} {
1187        oninit cget cgetall; onfinal; track
1188        return -code break BOOM!
1189    }
1190    set c [chan create {r w} foo]
1191    note [catch {fconfigure $c} msg]; note $msg
1192    close $c
1193    rename foo {}
1194    set res
1195} -result {{cgetall rc*} 1 *bad code*}
1196test iocmd-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
1197    set res {}
1198    proc foo {args} {
1199        oninit cget cgetall; onfinal; track
1200        return -code continue BOOM!
1201    }
1202    set c [chan create {r w} foo]
1203    note [catch {fconfigure $c} msg]; note $msg
1204    close $c
1205    rename foo {}
1206    set res
1207} -result {{cgetall rc*} 1 *bad code*}
1208test iocmd-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
1209    set res {}
1210    proc foo {args} {
1211        oninit cget cgetall; onfinal; track
1212        return -code 777 BOOM!
1213    }
1214    set c [chan create {r w} foo]
1215    note [catch {fconfigure $c} msg]; note $msg
1216    close $c
1217    rename foo {}
1218    set res
1219} -result {{cgetall rc*} 1 *bad code*}
1220test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
1221    set res {}
1222    proc foo {args} {
1223        oninit cget cgetall; onfinal; track
1224        return -level 55 -code 777 BANG
1225    }
1226    set c [chan create {r w} foo]
1227    note [catch {fconfigure $c} msg opt]; note $msg; noteOpts $opt
1228    close $c
1229    rename foo {}
1230    set res
1231} -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}}
1232
1233# --- === *** ###########################
1234# method configure
1235
1236test iocmd-26.1 {chan configure, set standard option} -match glob -body {
1237    set res {}
1238    proc foo {args} {
1239        oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
1240    }
1241    set c [chan create {r w} foo]
1242    note [fconfigure $c -translation lf]
1243    close $c
1244    rename foo {}
1245    set res
1246} -result {{}}
1247test iocmd-26.2 {chan configure, set option, error return} -match glob -body {
1248    set res {}
1249    proc foo {args} {
1250        oninit configure; onfinal; track
1251        return -code error BOOM!
1252    }
1253    set c [chan create {r w} foo]
1254    note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
1255    close $c
1256    rename foo {}
1257    set res
1258} -result {{configure rc* -rc-foo bar} 1 BOOM!}
1259test iocmd-26.3 {chan configure, set option, ok return} -match glob -body {
1260    set res {}
1261    proc foo {args} {oninit configure; onfinal; track; return}
1262    set c [chan create {r w} foo]
1263    note [fconfigure $c -rc-foo bar]
1264    close $c
1265    rename foo {}
1266    set res
1267} -result {{configure rc* -rc-foo bar} {}}
1268test iocmd-26.4 {chan configure, set option, break return is error} -match glob -body {
1269    set res {}
1270    proc foo {args} {
1271        oninit configure; onfinal; track
1272        return -code break BOOM!
1273    }
1274    set c [chan create {r w} foo]
1275    note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
1276    close $c
1277    rename foo {}
1278    set res
1279} -result {{configure rc* -rc-foo bar} 1 *bad code*}
1280test iocmd-26.5 {chan configure, set option, continue return is error} -match glob -body {
1281    set res {}
1282    proc foo {args} {
1283        oninit configure; onfinal; track
1284        return -code continue BOOM!
1285    }
1286    set c [chan create {r w} foo]
1287    note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
1288    close $c
1289    rename foo {}
1290    set res
1291} -result {{configure rc* -rc-foo bar} 1 *bad code*}
1292test iocmd-26.6 {chan configure, set option, custom return is error} -match glob -body {
1293    set res {}
1294    proc foo {args} {
1295        oninit configure; onfinal; track
1296        return -code 444 BOOM!
1297    }
1298    set c [chan create {r w} foo]
1299    note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
1300    close $c
1301    rename foo {}
1302    set res
1303} -result {{configure rc* -rc-foo bar} 1 *bad code*}
1304test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body {
1305    set res {}
1306    proc foo {args} {
1307        oninit configure; onfinal; track
1308        return -level 55 -code 444 BANG
1309    }
1310    set c [chan create {r w} foo]
1311    note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; noteOpts $opt
1312    close $c
1313    rename foo {}
1314    set res
1315} -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}}
1316
1317# --- === *** ###########################
1318# method cget
1319
1320test iocmd-27.1 {chan configure, get option, ok return} -match glob -body {
1321    set res {}
1322    proc foo {args} {oninit cget cgetall; onfinal; track; return foo}
1323    set c [chan create {r w} foo]
1324    note [fconfigure $c -rc-foo]
1325    close $c
1326    rename foo {}
1327    set res
1328} -result {{cget rc* -rc-foo} foo}
1329test iocmd-27.2 {chan configure, get option, error return} -match glob -body {
1330    set res {}
1331    proc foo {args} {
1332        oninit cget cgetall; onfinal; track
1333        return -code error BOOM!
1334    }
1335    set c [chan create {r w} foo]
1336    note [catch {fconfigure $c -rc-foo} msg]; note $msg
1337    close $c
1338    rename foo {}
1339    set res
1340} -result {{cget rc* -rc-foo} 1 BOOM!}
1341test iocmd-27.3 {chan configure, get option, break return is error} -match glob -body {
1342    set res {}
1343    proc foo {args} {
1344        oninit cget cgetall; onfinal; track
1345        return -code error BOOM!
1346    }
1347    set c [chan create {r w} foo]
1348    note [catch {fconfigure $c -rc-foo} msg]; note $msg
1349    close $c
1350    rename foo {}
1351    set res
1352} -result {{cget rc* -rc-foo} 1 BOOM!}
1353test iocmd-27.4 {chan configure, get option, continue return is error} -match glob -body {
1354    set res {}
1355    proc foo {args} {
1356        oninit cget cgetall; onfinal; track
1357        return -code continue BOOM!
1358    }
1359    set c [chan create {r w} foo]
1360    note [catch {fconfigure $c -rc-foo} msg]; note $msg
1361    close $c
1362    rename foo {}
1363    set res
1364} -result {{cget rc* -rc-foo} 1 *bad code*}
1365test iocmd-27.5 {chan configure, get option, custom return is error} -match glob -body {
1366    set res {}
1367    proc foo {args} {
1368        oninit cget cgetall; onfinal; track
1369        return -code 333 BOOM!
1370    }
1371    set c [chan create {r w} foo]
1372    note [catch {fconfigure $c -rc-foo} msg]; note $msg
1373    close $c
1374    rename foo {}
1375    set res
1376} -result {{cget rc* -rc-foo} 1 *bad code*}
1377test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body {
1378    set res {}
1379    proc foo {args} {
1380        oninit cget cgetall; onfinal; track
1381        return -level 77 -code 333 BANG
1382    }
1383    set c [chan create {r w} foo]
1384    note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; noteOpts $opt
1385    close $c
1386    rename foo {}
1387    set res
1388} -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}}
1389
1390# --- === *** ###########################
1391# method seek
1392
1393test iocmd-28.1 {chan tell, not supported by handler} -match glob -body {
1394    set res {}
1395    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
1396    set c [chan create {r w} foo]
1397    note [tell $c]
1398    close $c
1399    rename foo {}
1400    set res
1401} -result {-1}
1402test iocmd-28.2 {chan tell, error return} -match glob -body {
1403    set res {}
1404    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
1405    set c [chan create {r w} foo]
1406    note [catch {tell $c} msg]; note $msg
1407    close $c
1408    rename foo {}
1409    set res
1410} -result {{seek rc* 0 current} 1 BOOM!}
1411test iocmd-28.3 {chan tell, break return is error} -match glob -body {
1412    set res {}
1413    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
1414    set c [chan create {r w} foo]
1415    note [catch {tell $c} msg]; note $msg
1416    close $c
1417    rename foo {}
1418    set res
1419} -result {{seek rc* 0 current} 1 *bad code*}
1420test iocmd-28.4 {chan tell, continue return is error} -match glob -body {
1421    set res {}
1422    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
1423    set c [chan create {r w} foo]
1424    note [catch {tell $c} msg]; note $msg
1425    close $c
1426    rename foo {}
1427    set res
1428} -result {{seek rc* 0 current} 1 *bad code*}
1429test iocmd-28.5 {chan tell, custom return is error} -match glob -body {
1430    set res {}
1431    proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!}
1432    set c [chan create {r w} foo]
1433    note [catch {tell $c} msg]; note $msg
1434    close $c
1435    rename foo {}
1436    set res
1437} -result {{seek rc* 0 current} 1 *bad code*}
1438test iocmd-28.6 {chan tell, level is ignored} -match glob -body {
1439    set res {}
1440    proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
1441    set c [chan create {r w} foo]
1442    note [catch {tell $c} msg opt]; note $msg; noteOpts $opt
1443    close $c
1444    rename foo {}
1445    set res
1446} -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}}
1447test iocmd-28.7 {chan tell, regular return} -match glob -body {
1448    set res {}
1449    proc foo {args} {oninit seek; onfinal; track; return 88}
1450    set c [chan create {r w} foo]
1451    note [tell $c]
1452    close $c
1453    rename foo {}
1454    set res
1455} -result {{seek rc* 0 current} 88}
1456test iocmd-28.8 {chan tell, negative return} -match glob -body {
1457    set res {}
1458    proc foo {args} {oninit seek; onfinal; track; return -1}
1459    set c [chan create {r w} foo]
1460    note [catch {tell $c} msg]; note $msg
1461    close $c
1462    rename foo {}
1463    set res
1464} -result {{seek rc* 0 current} 1 {Tried to seek before origin}}
1465test iocmd-28.9 {chan tell, string return} -match glob -body {
1466    set res {}
1467    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
1468    set c [chan create {r w} foo]
1469    note [catch {tell $c} msg]; note $msg
1470    close $c
1471    rename foo {}
1472    set res
1473} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}}
1474test iocmd-28.10 {chan seek, not supported by handler} -match glob -body {
1475    set res {}
1476    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
1477    set c [chan create {r w} foo]
1478    note [catch {seek $c 0 start} msg]; note $msg
1479    close $c
1480    rename foo {}
1481    set res
1482} -result {1 {error during seek on "rc*": invalid argument}}
1483test iocmd-28.11 {chan seek, error return} -match glob -body {
1484    set res {}
1485    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
1486    set c [chan create {r w} foo]
1487    note [catch {seek $c 0 start} msg]; note $msg
1488    close $c
1489    rename foo {}
1490    set res
1491} -result {{seek rc* 0 start} 1 BOOM!}
1492test iocmd-28.12 {chan seek, break return is error} -match glob -body {
1493    set res {}
1494    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
1495    set c [chan create {r w} foo]
1496    note [catch {seek $c 0 start} msg]; note $msg
1497    close $c
1498    rename foo {}
1499    set res
1500} -result {{seek rc* 0 start} 1 *bad code*}
1501test iocmd-28.13 {chan seek, continue return is error} -match glob -body {
1502    set res {}
1503    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
1504    set c [chan create {r w} foo]
1505    note [catch {seek $c 0 start} msg]; note $msg
1506    close $c
1507    rename foo {}
1508    set res
1509} -result {{seek rc* 0 start} 1 *bad code*}
1510test iocmd-28.14 {chan seek, custom return is error} -match glob -body {
1511    set res {}
1512    proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!}
1513    set c [chan create {r w} foo]
1514    note [catch {seek $c 0 start} msg]; note $msg
1515    close $c
1516    rename foo {}
1517    set res
1518} -result {{seek rc* 0 start} 1 *bad code*}
1519test iocmd-28.15 {chan seek, level is ignored} -match glob -body {
1520    set res {}
1521    proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
1522    set c [chan create {r w} foo]
1523    note [catch {seek $c 0 start} msg opt]; note $msg; noteOpts $opt
1524    close $c
1525    rename foo {}
1526    set res
1527} -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}}
1528test iocmd-28.16 {chan seek, bogus return, negative location} -match glob -body {
1529    set res {}
1530    proc foo {args} {oninit seek; onfinal; track; return -45}
1531    set c [chan create {r w} foo]
1532    note [catch {seek $c 0 start} msg]; note $msg
1533    close $c
1534    rename foo {}
1535    set res
1536} -result {{seek rc* 0 start} 1 {Tried to seek before origin}}
1537test iocmd-28.17 {chan seek, bogus return, string return} -match glob -body {
1538    set res {}
1539    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
1540    set c [chan create {r w} foo]
1541    note [catch {seek $c 0 start} msg]; note $msg
1542    close $c
1543    rename foo {}
1544    set res
1545} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}}
1546test iocmd-28.18 {chan seek, ok result} -match glob -body {
1547    set res {}
1548    proc foo {args} {oninit seek; onfinal; track; return 23}
1549    set c [chan create {r w} foo]
1550    note [seek $c 0 current]
1551    close $c
1552    rename foo {}
1553    set res
1554} -result {{seek rc* 0 current} {}}
1555foreach {testname code} {
1556    iocmd-28.19.0 start
1557    iocmd-28.19.1 current
1558    iocmd-28.19.2 end
1559} {
1560    test $testname "chan seek, base conversion, $code" -match glob -body {
1561        set res {}
1562        proc foo {args} {oninit seek; onfinal; track; return 0}
1563        set c [chan create {r w} foo]
1564        note [seek $c 0 $code]
1565        close $c
1566        rename foo {}
1567        set res
1568    } -result [list [list seek rc* 0 $code] {}]
1569}
1570
1571# --- === *** ###########################
1572# method blocking
1573
1574test iocmd-29.1 {chan blocking, no handler support} -match glob -body {
1575    set res {}
1576    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
1577    set c [chan create {r w} foo]
1578    note [fconfigure $c -blocking]
1579    close $c
1580    rename foo {}
1581    set res
1582} -result {1}
1583test iocmd-29.2 {chan blocking, no handler support} -match glob -body {
1584    set res {}
1585    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
1586    set c [chan create {r w} foo]
1587    note [fconfigure $c -blocking 0]
1588    note [fconfigure $c -blocking]
1589    close $c
1590    rename foo {}
1591    set res
1592} -result {{} 0}
1593test iocmd-29.3 {chan blocking, retrieval, handler support} -match glob -body {
1594    set res {}
1595    proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return}
1596    set c [chan create {r w} foo]
1597    note [fconfigure $c -blocking]
1598    close $c
1599    rename foo {}
1600    set res
1601} -result {1}
1602test iocmd-29.4 {chan blocking, resetting, handler support} -match glob -body {
1603    set res {}
1604    proc foo {args} {oninit blocking; onfinal; track; return}
1605    set c [chan create {r w} foo]
1606    note [fconfigure $c -blocking 0]
1607    note [fconfigure $c -blocking]
1608    close $c
1609    rename foo {}
1610    set res
1611} -result {{blocking rc* 0} {} 0}
1612test iocmd-29.5 {chan blocking, setting, handler support} -match glob -body {
1613    set res {}
1614    proc foo {args} {oninit blocking; onfinal; track; return}
1615    set c [chan create {r w} foo]
1616    note [fconfigure $c -blocking 1]
1617    note [fconfigure $c -blocking]
1618    close $c
1619    rename foo {}
1620    set res
1621} -result {{blocking rc* 1} {} 1}
1622test iocmd-29.6 {chan blocking, error return} -match glob -body {
1623    set res {}
1624    proc foo {args} {oninit blocking; onfinal; track; error BOOM!}
1625    set c [chan create {r w} foo]
1626    note [catch {fconfigure $c -blocking 0} msg]; note $msg
1627    # Catch the close. It changes blocking mode internally, and runs into the error result.
1628    catch {close $c}
1629    rename foo {}
1630    set res
1631} -result {{blocking rc* 0} 1 BOOM!}
1632test iocmd-29.7 {chan blocking, break return is error} -match glob -body {
1633    set res {}
1634    proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!}
1635    set c [chan create {r w} foo]
1636    note [catch {fconfigure $c -blocking 0} msg]; note $msg
1637    catch {close $c}
1638    rename foo {}
1639    set res
1640} -result {{blocking rc* 0} 1 *bad code*}
1641test iocmd-29.8 {chan blocking, continue return is error} -match glob -body {
1642    set res {}
1643    proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!}
1644    set c [chan create {r w} foo]
1645    note [catch {fconfigure $c -blocking 0} msg]; note $msg
1646    catch {close $c}
1647    rename foo {}
1648    set res
1649} -result {{blocking rc* 0} 1 *bad code*}
1650test iocmd-29.9 {chan blocking, custom return is error} -match glob -body {
1651    set res {}
1652    proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!}
1653    set c [chan create {r w} foo]
1654    note [catch {fconfigure $c -blocking 0} msg]; note $msg
1655    catch {close $c}
1656    rename foo {}
1657    set res
1658} -result {{blocking rc* 0} 1 *bad code*}
1659test iocmd-29.10 {chan blocking, level is ignored} -match glob -setup {
1660    set res {}
1661} -body {
1662    proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
1663    set c [chan create {r w} foo]
1664    note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; noteOpts $opt
1665    catch {close $c}
1666    return $res
1667} -cleanup {
1668    rename foo {}
1669} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}}
1670test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
1671    set res {}
1672    proc foo {args} {oninit blocking; onfinal; track; return BOGUS}
1673    set c [chan create {r w} foo]
1674    note [catch {fconfigure $c -blocking 0} msg]; note $msg
1675    catch {close $c}
1676    rename foo {}
1677    set res
1678} -result {{blocking rc* 0} 0 {}}
1679
1680# --- === *** ###########################
1681# method watch
1682
1683test iocmd-30.1 {chan watch, read interest, some return} -match glob -body {
1684    set res {}
1685    proc foo {args} {oninit; onfinal; track; return IGNORED}
1686    set c [chan create {r w} foo]
1687    note [fileevent $c readable {set tick $tick}]
1688    close $c                    ;# 2nd watch, interest zero.
1689    rename foo {}
1690    set res
1691} -result {{watch rc* read} {} {watch rc* {}}}
1692test iocmd-30.2 {chan watch, write interest, error return} -match glob -body {
1693    set res {}
1694    proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED}
1695    set c [chan create {r w} foo]
1696    note [fileevent $c writable {set tick $tick}]
1697    note [fileevent $c writable {}]
1698    close $c
1699    rename foo {}
1700    set res
1701} -result {{watch rc* write} {} {watch rc* {}} {}}
1702test iocmd-30.3 {chan watch, accumulated interests} -match glob -body {
1703    set res {}
1704    proc foo {args} {oninit; onfinal; track; return}
1705    set c [chan create {r w} foo]
1706    note [fileevent $c writable {set tick $tick}]
1707    note [fileevent $c readable {set tick $tick}]
1708    note [fileevent $c writable {}]
1709    note [fileevent $c readable {}]
1710    close $c
1711    rename foo {}
1712    set res
1713} -result {{watch rc* write} {} {watch rc* {read write}} {} {watch rc* read} {} {watch rc* {}} {}}
1714test iocmd-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
1715    set res {}
1716    proc foo {args} {oninit; onfinal; track; return}
1717    set c [chan create {r w} foo]
1718    note [fileevent $c writable {set tick $tick}]
1719    note [fileevent $c readable {set tick $tick}] ;# Script is changing,
1720    note [fileevent $c readable {set tock $tock}] ;# interest does not.
1721    close $c            ;# 3rd and 4th watch, removing the event handlers.
1722    rename foo {}
1723    set res
1724} -result {{watch rc* write} {} {watch rc* {read write}} {} {} {watch rc* write} {watch rc* {}}}
1725
1726# --- === *** ###########################
1727# chan postevent
1728
1729test iocmd-31.1 {chan postevent, restricted to reflected channels} -match glob -body {
1730    set c [open [makeFile {} goo] r]
1731    catch {chan postevent $c {r w}} msg
1732    close $c
1733    removeFile goo
1734    set msg
1735} -result {can not find reflected channel named "file*"}
1736test iocmd-31.2 {chan postevent, unwanted events} -match glob -body {
1737    set res {}
1738    proc foo {args} {oninit; onfinal; track; return}
1739    set c [chan create {r w} foo]
1740    catch {chan postevent $c {r w}} msg; note $msg
1741    close $c
1742    rename foo {}
1743    set res
1744} -result {{tried to post events channel "rc*" is not interested in}}
1745test iocmd-31.3 {chan postevent, bad input, empty list} -match glob -body {
1746    set res {}
1747    proc foo {args} {oninit; onfinal; track; return}
1748    set c [chan create {r w} foo]
1749    catch {chan postevent $c {}} msg; note $msg
1750    close $c
1751    rename foo {}
1752    set res
1753} -result {{bad event list: is empty}}
1754test iocmd-31.4 {chan postevent, bad input, illlegal keyword} -match glob -body {
1755    set res {}
1756    proc foo {args} {oninit; onfinal; track; return}
1757    set c [chan create {r w} foo]
1758    catch {chan postevent $c goo} msg; note $msg
1759    close $c
1760    rename foo {}
1761    set res
1762} -result {{bad event "goo": must be read or write}}
1763test iocmd-31.5 {chan postevent, bad input, not a list} -match glob -body {
1764    set res {}
1765    proc foo {args} {oninit; onfinal; track; return}
1766    set c [chan create {r w} foo]
1767    catch {chan postevent $c "\{"} msg; note $msg
1768    close $c
1769    rename foo {}
1770    set res
1771} -result {{unmatched open brace in list}}
1772test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body {
1773    set res {}
1774    proc foo {args} {oninit; onfinal; track; return}
1775    set c [chan create {r w} foo]
1776    note [fileevent $c readable {note TOCK}]
1777    set stop [after 10000 {note TIMEOUT}]
1778    after  1000 {note [chan postevent $c r]}
1779    vwait ::res
1780    catch {after cancel $stop}
1781    close $c
1782    rename foo {}
1783    set res
1784} -result {{watch rc* read} {} TOCK {} {watch rc* {}}}
1785test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
1786    set res {}
1787    proc foo {args} {oninit; onfinal; track; return}
1788    set c [chan create {r w} foo]
1789    note [fileevent $c writable {note TOCK}]
1790    set stop [after 10000 {note TIMEOUT}]
1791    after  1000 {note [chan postevent $c w]}
1792    vwait ::res
1793    catch {after cancel $stop}
1794    close $c
1795    rename foo {}
1796    set res
1797} -result {{watch rc* write} {} TOCK {} {watch rc* {}}}
1798
1799# ### ### ### ######### ######### #########
1800## Same tests as above, but exercising the code forwarding and
1801## receiving driver operations to the originator thread.
1802
1803# -*- tcl -*-
1804# ### ### ### ######### ######### #########
1805## Testing the reflected channel (Thread forwarding).
1806#
1807## The id numbers refer to the original test without thread
1808## forwarding, and gaps due to tests not applicable to forwarding are
1809## left to keep this asociation.
1810
1811# Duplicate of code in "thread.test". Find a better way of doing this
1812# without duplication. Maybe placement into a proc which transforms to
1813# nop after the first call, and placement of its defintion in a
1814# central location.
1815
1816if {[testConstraint testthread]} {
1817    testthread errorproc ThreadError
1818
1819    proc ThreadError {id info} {
1820        global threadError
1821        set threadError $info
1822    }
1823    proc ThreadNullError {id info} {
1824        # ignore
1825    }
1826}
1827
1828# ### ### ### ######### ######### #########
1829## Helper command. Runs a script in a separate thread and returns the
1830## result. A channel is transfered into the thread as well, and list of
1831## configuation variables
1832
1833proc inthread {chan script args} {
1834    # Test thread.
1835
1836    set tid [testthread create]
1837
1838    # Init thread configuration.
1839    # - Listed variables
1840    # - Id of main thread
1841    # - A number of helper commands
1842
1843    foreach v $args {
1844        upvar 1 $v x
1845        testthread send $tid [list set $v $x]
1846    }
1847    testthread send $tid [list set mid $tcltest::mainThread]
1848    testthread send $tid {
1849        proc note {item} {global notes; lappend notes $item}
1850        proc notes {} {global notes; return $notes}
1851        proc noteOpts opts {global notes; lappend notes [dict merge {
1852            -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
1853        } $opts]}
1854    }
1855    testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
1856
1857    # Transfer channel (cut/splice aka detach/attach)
1858
1859    testchannel cut $chan
1860    testthread send $tid [list testchannel splice $chan]
1861
1862    # Run test script, also run local event loop!
1863    # The local event loop waits for the result to come back.
1864    # It is also necessary for the execution of forwarded channel
1865    # operations.
1866
1867    set ::tres ""
1868    testthread send -async $tid {
1869        after 500
1870        catch {s} res; # This runs the script, 's' was defined at (*)
1871        testthread send -async $mid [list set ::tres $res]
1872    }
1873    vwait ::tres
1874    # Remove test thread, and return the captured result.
1875
1876    tcltest::threadReap
1877    return $::tres
1878}
1879
1880# ### ### ### ######### ######### #########
1881
1882# ### ### ### ######### ######### #########
1883
1884test iocmd.tf-22.2 {chan finalize, for close} -match glob -body {
1885    set res {}
1886    proc foo {args} {track; oninit; return {}}
1887    note [set c [chan create {r w} foo]]
1888    note [inthread $c {
1889        close $c
1890        # Close the deleted the channel.
1891        file channels rc*
1892    } c]
1893    # Channel destruction does not kill handler command!
1894    note [info command foo]
1895    rename foo {}
1896    set res
1897} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
1898test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -body {
1899    set res {}
1900    proc foo {args} {track; oninit; return -code error 5}
1901    note [set c [chan create {r w} foo]]
1902    notes [inthread $c {
1903        note [catch {close $c} msg]; note $msg
1904        # Channel is gone despite error.
1905        note [file channels rc*]
1906        notes
1907    } c]
1908    rename foo {}
1909    set res
1910} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
1911test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -body {
1912    set res {}
1913    proc foo {args} {track; oninit; error FOO}
1914    note [set c [chan create {r w} foo]]
1915    notes [inthread $c {
1916        note [catch {close $c} msg]; note $msg
1917        notes
1918    } c]
1919    rename foo {}
1920    set res
1921} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
1922test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -body {
1923    set res {}
1924    proc foo {args} {track; oninit; return SOMETHING}
1925    note [set c [chan create {r w} foo]]
1926    notes [inthread $c {
1927        note [catch {close $c} msg]; note $msg
1928        notes
1929    } c]
1930    rename foo {}
1931    set res
1932} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
1933test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -body {
1934    set res {}
1935    proc foo {args} {track; oninit; return -code 3}
1936    note [set c [chan create {r w} foo]]
1937    notes [inthread $c {
1938        note [catch {close $c} msg]; note $msg
1939        notes
1940    } c]
1941    rename foo {}
1942    set res
1943} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
1944    -constraints {testchannel testthread}
1945test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob -body {
1946    set res {}
1947    proc foo {args} {track; oninit; return -code 4}
1948    note [set c [chan create {r w} foo]]
1949    notes [inthread $c {
1950        note [catch {close $c} msg]; note $msg
1951        notes
1952    } c]
1953    rename foo {}
1954    set res
1955} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
1956    -constraints {testchannel testthread}
1957test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
1958    set res {}
1959    proc foo {args} {track; oninit; return -code 777 BANG}
1960    note [set c [chan create {r w} foo]]
1961    notes [inthread $c {
1962        note [catch {close $c} msg]; note $msg
1963        notes
1964    } c]
1965    rename foo {}
1966    set res
1967} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
1968    -constraints {testchannel testthread}
1969test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match glob -body {
1970    set res {}
1971    proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
1972    note [set c [chan create {r w} foo]]
1973    notes [inthread $c {
1974        note [catch {close $c} msg opt]; note $msg; noteOpts $opt
1975        notes
1976    } c]
1977    rename foo {}
1978    set res
1979} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \
1980    -constraints {testchannel testthread}
1981
1982# --- === *** ###########################
1983# method read
1984
1985test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
1986    set res {}
1987    proc foo {args} {
1988        oninit; onfinal; track
1989        return snarf
1990    }
1991    set c [chan create {r w} foo]
1992    notes [inthread $c {
1993        note [read $c 10]
1994        close $c
1995        notes
1996    } c]
1997    rename foo {}
1998    set res
1999} -constraints {testchannel testthread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
2000test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
2001    set res {}
2002    proc foo {args} {
2003        oninit; onfinal; track
2004        return [string repeat snarf 1000]
2005    }
2006    set c [chan create {r w} foo]
2007    notes [inthread $c {
2008        note [catch {[read $c 2]} msg]; note $msg
2009        close $c
2010        notes
2011    } c]
2012    rename foo {}
2013    set res
2014} -constraints {testchannel testthread} -result {{read rc* 4096} 1 {read delivered more than requested}}
2015test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
2016    set res {}
2017    proc foo {args} {
2018        oninit; onfinal; track; note MUST_NOT_HAPPEN
2019    }
2020    set c [chan create {w} foo]
2021    notes [inthread $c {
2022        note [catch {[read $c 2]} msg]; note $msg
2023        close $c
2024        notes
2025    } c]
2026    rename foo {}
2027    set res
2028} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for reading}}
2029test iocmd.tf-23.4 {chan read, error return} -match glob -body {
2030    set res {}
2031    proc foo {args} {
2032        oninit; onfinal; track
2033        return -code error BOOM!
2034    }
2035    set c [chan create {r w} foo]
2036    notes [inthread $c {
2037        note [catch {read $c 2} msg]; note $msg
2038        close $c
2039        notes
2040    } c]
2041    rename foo {}
2042    set res
2043} -result {{read rc* 4096} 1 BOOM!} \
2044    -constraints {testchannel testthread}
2045test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
2046    set res {}
2047    proc foo {args} {
2048        oninit; onfinal; track
2049        return -code break BOOM!
2050    }
2051    set c [chan create {r w} foo]
2052    notes [inthread $c {
2053        note [catch {read $c 2} msg]; note $msg
2054        close $c
2055        notes
2056    } c]
2057    rename foo {}
2058    set res
2059} -result {{read rc* 4096} 1 *bad code*} \
2060    -constraints {testchannel testthread}
2061test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
2062    set res {}
2063    proc foo {args} {
2064        oninit; onfinal; track
2065        return -code continue BOOM!
2066    }
2067    set c [chan create {r w} foo]
2068    notes [inthread $c {
2069        note [catch {read $c 2} msg]; note $msg
2070        close $c
2071        notes
2072    } c]
2073    rename foo {}
2074    set res
2075} -result {{read rc* 4096} 1 *bad code*} \
2076    -constraints {testchannel testthread}
2077test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
2078    set res {}
2079    proc foo {args} {
2080        oninit; onfinal; track
2081        return -code 777 BOOM!
2082    }
2083    set c [chan create {r w} foo]
2084    notes [inthread $c {
2085        note [catch {read $c 2} msg]; note $msg
2086        close $c
2087        notes
2088    } c]
2089    rename foo {}
2090    set res
2091} -result {{read rc* 4096} 1 *bad code*} \
2092    -constraints {testchannel testthread}
2093test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
2094    set res {}
2095    proc foo {args} {
2096        oninit; onfinal; track
2097        return -level 55 -code 777 BOOM!
2098    }
2099    set c [chan create {r w} foo]
2100    notes [inthread $c {
2101        note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
2102        close $c
2103        notes
2104    } c]
2105    rename foo {}
2106    set res
2107} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
2108    -constraints {testchannel testthread}
2109
2110# --- === *** ###########################
2111# method write
2112
2113test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
2114    set res {}
2115    proc foo {args} {
2116        oninit; onfinal; track
2117        set     written [string length [lindex $args 2]]
2118        note   $written
2119        return $written
2120    }
2121    set c [chan create {r w} foo]
2122    inthread $c {
2123        puts -nonewline $c snarf; flush $c
2124        close $c
2125    } c
2126    rename foo {}
2127    set res
2128} -constraints {testchannel testthread} -result {{write rc* snarf} 5}
2129test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body {
2130    set res {}
2131    proc foo {args} {
2132        oninit; onfinal; track
2133        set     written [string length [lindex $args 2]]
2134        if {$written > 10} {set written [expr {$written / 2}]}
2135        note   $written
2136        return $written
2137    }
2138    set c [chan create {r w} foo]
2139    inthread $c {
2140        puts -nonewline $c snarfsnarfsnarf; flush $c
2141        close $c
2142    } c
2143    rename foo {}
2144    set res
2145} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
2146test iocmd.tf-24.3 {chan write, failed write} -match glob -body {
2147    set res {}
2148    proc foo {args} {oninit; onfinal; track; note -1; return -1}
2149    set c [chan create {r w} foo]
2150    inthread $c {
2151        puts -nonewline $c snarfsnarfsnarf; flush $c
2152        close $c
2153    } c
2154    rename foo {}
2155    set res
2156} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} -1}
2157test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body {
2158    set res {}
2159    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
2160    set c [chan create {r} foo]
2161    notes [inthread $c {
2162        note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
2163        note $msg
2164        close $c
2165        notes
2166    } c]
2167    rename foo {}
2168    set res
2169} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for writing}}
2170test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob -body {
2171    set res {}
2172    proc foo {args} {oninit; onfinal; track; return 10000}
2173    set c [chan create {r w} foo]
2174    notes [inthread $c {
2175        note [catch {puts -nonewline $c snarf; flush $c} msg]
2176        note $msg
2177        close $c
2178        notes
2179    } c]
2180    rename foo {}
2181    set res
2182} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}}
2183test iocmd.tf-24.6 {chan write, zero writes} -match glob -body {
2184    set res {}
2185    proc foo {args} {oninit; onfinal; track; return 0}
2186    set c [chan create {r w} foo]
2187    notes [inthread $c {
2188        note [catch {puts -nonewline $c snarf; flush $c} msg]
2189        note $msg
2190        close $c
2191        notes
2192    } c]
2193    rename foo {}
2194    set res
2195} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}}
2196test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body {
2197    set res {}
2198    proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
2199    set c [chan create {r w} foo]
2200    notes [inthread $c {
2201        note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
2202        note $msg
2203        close $c
2204        notes
2205    } c]
2206    rename foo {}
2207    set res
2208} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
2209    -constraints {testchannel testthread}
2210test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body {
2211    set res {}
2212    proc foo {args} {oninit; onfinal; track; error BOOM!}
2213    set c [chan create {r w} foo]
2214    notes [inthread $c {
2215        note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
2216        note $msg
2217        close $c
2218        notes
2219    } c]
2220    rename foo {}
2221    set res
2222} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
2223    -constraints {testchannel testthread}
2224test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob -body {
2225    set res {}
2226    proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
2227    set c [chan create {r w} foo]
2228    notes [inthread $c {
2229        note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
2230        note $msg
2231        close $c
2232        notes
2233    } c]
2234    rename foo {}
2235    set res
2236} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
2237    -constraints {testchannel testthread}
2238test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match glob -body {
2239    set res {}
2240    proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
2241    set c [chan create {r w} foo]
2242    notes [inthread $c {
2243        note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
2244        note $msg
2245        close $c
2246        notes
2247    } c]
2248    rename foo {}
2249    set res
2250} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
2251    -constraints {testchannel testthread}
2252test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match glob -body {
2253    set res {}
2254    proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
2255    set c [chan create {r w} foo]
2256    notes [inthread $c {
2257        note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
2258        note $msg
2259        close $c
2260        notes
2261    } c]
2262    rename foo {}
2263    set res
2264} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
2265    -constraints {testchannel testthread}
2266test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
2267    set res {}
2268    proc foo {args} {oninit; onfinal; track; return BANG}
2269    set c [chan create {r w} foo]
2270    notes [inthread $c {
2271        note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
2272        note $msg
2273        close $c
2274        notes
2275    } c]
2276    rename foo {}
2277    set res
2278} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} \
2279    -constraints {testchannel testthread}
2280test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -body {
2281    set res {}
2282    proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
2283    set c [chan create {r w} foo]
2284    notes [inthread $c {
2285        note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
2286        note $msg
2287        noteOpts $opt
2288        close $c
2289        notes
2290    } c]
2291    rename foo {}
2292    set res
2293} -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \
2294    -constraints {testchannel testthread}
2295
2296# --- === *** ###########################
2297# method cgetall
2298
2299test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body {
2300    set res {}
2301    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
2302    set c [chan create {r w} foo]
2303    notes [inthread $c {
2304        note [fconfigure $c]
2305        close $c
2306        notes
2307    } c]
2308    rename foo {}
2309    set res
2310} -constraints {testchannel testthread} \
2311    -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
2312test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
2313    set res {}
2314    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
2315    set c [chan create {r w} foo]
2316    notes [inthread $c {
2317        note [fconfigure $c]
2318        close $c
2319        notes
2320    } c]
2321    rename foo {}
2322    set res
2323} -constraints {testchannel testthread} \
2324    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
2325test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
2326    set res {}
2327    proc foo {args} {
2328        oninit cget cgetall; onfinal; track
2329        return "-bar foo -snarf x"
2330    }
2331    set c [chan create {r w} foo]
2332    notes [inthread $c {
2333        note [fconfigure $c]
2334        close $c
2335        notes
2336    } c]
2337    rename foo {}
2338    set res
2339} -constraints {testchannel testthread} \
2340    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
2341test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
2342    set res {}
2343    proc foo {args} {
2344        oninit cget cgetall; onfinal; track
2345        return "-bar"
2346    }
2347    set c [chan create {r w} foo]
2348    notes [inthread $c {
2349        note [catch {fconfigure $c} msg]
2350        note $msg
2351        close $c
2352        notes
2353    } c]
2354    rename foo {}
2355    set res
2356} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
2357test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
2358    set res {}
2359    proc foo {args} {
2360        oninit cget cgetall; onfinal; track
2361        return "\{"
2362    }
2363    set c [chan create {r w} foo]
2364    notes [inthread $c {
2365        note [catch {fconfigure $c} msg]
2366        note $msg
2367        close $c
2368        notes
2369    } c]
2370    rename foo {}
2371    set res
2372} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {unmatched open brace in list}}
2373test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body {
2374    set res {}
2375    proc foo {args} {
2376        oninit cget cgetall; onfinal; track
2377        return -code error BOOM!
2378    }
2379    set c [chan create {r w} foo]
2380    notes [inthread $c {
2381        note [catch {fconfigure $c} msg]
2382        note $msg
2383        close $c
2384        notes
2385    } c]
2386    rename foo {}
2387    set res
2388} -constraints {testchannel testthread} -result {{cgetall rc*} 1 BOOM!}
2389test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob -body {
2390    set res {}
2391    proc foo {args} {
2392        oninit cget cgetall; onfinal; track
2393        return -code break BOOM!
2394    }
2395    set c [chan create {r w} foo]
2396    notes [inthread $c {
2397        note [catch {fconfigure $c} msg]
2398        note $msg
2399        close $c
2400        notes
2401    } c]
2402    rename foo {}
2403    set res
2404} -result {{cgetall rc*} 1 *bad code*} \
2405    -constraints {testchannel testthread}
2406test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
2407    set res {}
2408    proc foo {args} {
2409        oninit cget cgetall; onfinal; track
2410        return -code continue BOOM!
2411    }
2412    set c [chan create {r w} foo]
2413    notes [inthread $c {
2414        note [catch {fconfigure $c} msg]
2415        note $msg
2416        close $c
2417        notes
2418    } c]
2419    rename foo {}
2420    set res
2421} -result {{cgetall rc*} 1 *bad code*} \
2422    -constraints {testchannel testthread}
2423test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
2424    set res {}
2425    proc foo {args} {
2426        oninit cget cgetall; onfinal; track
2427        return -code 777 BOOM!
2428    }
2429    set c [chan create {r w} foo]
2430    notes [inthread $c {
2431        note [catch {fconfigure $c} msg]
2432        note $msg
2433        close $c
2434        notes
2435    } c]
2436    rename foo {}
2437    set res
2438} -result {{cgetall rc*} 1 *bad code*} \
2439    -constraints {testchannel testthread}
2440test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
2441    set res {}
2442    proc foo {args} {
2443        oninit cget cgetall; onfinal; track
2444        return -level 55 -code 777 BANG
2445    }
2446    set c [chan create {r w} foo]
2447    notes [inthread $c {
2448        note [catch {fconfigure $c} msg opt]
2449        note $msg
2450        noteOpts $opt
2451        close $c
2452        notes
2453    } c]
2454    rename foo {}
2455    set res
2456} -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}} \
2457    -constraints {testchannel testthread}
2458
2459# --- === *** ###########################
2460# method configure
2461
2462test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
2463    set res {}
2464    proc foo {args} {
2465        oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
2466    }
2467    set c [chan create {r w} foo]
2468    notes [inthread $c {
2469        note [fconfigure $c -translation lf]
2470        close $c
2471        notes
2472    } c]
2473    rename foo {}
2474    set res
2475} -constraints {testchannel testthread} -result {{}}
2476test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body {
2477    set res {}
2478    proc foo {args} {
2479        oninit configure; onfinal; track
2480        return -code error BOOM!
2481    }
2482    set c [chan create {r w} foo]
2483    notes [inthread $c {
2484        note [catch {fconfigure $c -rc-foo bar} msg]
2485        note $msg
2486        close $c
2487        notes
2488    } c]
2489    rename foo {}
2490    set res
2491} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} 1 BOOM!}
2492test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body {
2493    set res {}
2494    proc foo {args} {oninit configure; onfinal; track; return}
2495    set c [chan create {r w} foo]
2496    notes [inthread $c {
2497        note [fconfigure $c -rc-foo bar]
2498        close $c
2499        notes
2500    } c]
2501    rename foo {}
2502    set res
2503} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} {}}
2504test iocmd.tf-26.4 {chan configure, set option, break return is error} -match glob -body {
2505    set res {}
2506    proc foo {args} {
2507        oninit configure; onfinal; track
2508        return -code break BOOM!
2509    }
2510    set c [chan create {r w} foo]
2511    notes [inthread $c {
2512        note [catch {fconfigure $c -rc-foo bar} msg]
2513        note $msg
2514        close $c
2515        notes
2516    } c]
2517    rename foo {}
2518    set res
2519} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
2520    -constraints {testchannel testthread}
2521test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body {
2522    set res {}
2523    proc foo {args} {
2524        oninit configure; onfinal; track
2525        return -code continue BOOM!
2526    }
2527    set c [chan create {r w} foo]
2528    notes [inthread $c {
2529        note [catch {fconfigure $c -rc-foo bar} msg]
2530        note $msg
2531        close $c
2532        notes
2533    } c]
2534    rename foo {}
2535    set res
2536} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
2537    -constraints {testchannel testthread}
2538test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body {
2539    set res {}
2540    proc foo {args} {
2541        oninit configure; onfinal; track
2542        return -code 444 BOOM!
2543    }
2544    set c [chan create {r w} foo]
2545    notes [inthread $c {
2546        note [catch {fconfigure $c -rc-foo bar} msg]
2547        note $msg
2548        close $c
2549        notes
2550    } c]
2551    rename foo {}
2552    set res
2553} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
2554    -constraints {testchannel testthread}
2555test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body {
2556    set res {}
2557    proc foo {args} {
2558        oninit configure; onfinal; track
2559        return -level 55 -code 444 BANG
2560    }
2561    set c [chan create {r w} foo]
2562    notes [inthread $c {
2563        note [catch {fconfigure $c -rc-foo bar} msg opt]
2564        note $msg
2565        noteOpts $opt
2566        close $c
2567        notes
2568    } c]
2569    rename foo {}
2570    set res
2571} -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}} \
2572    -constraints {testchannel testthread}
2573
2574# --- === *** ###########################
2575# method cget
2576
2577test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body {
2578    set res {}
2579    proc foo {args} {oninit cget cgetall; onfinal; track; return foo}
2580    set c [chan create {r w} foo]
2581    notes [inthread $c {
2582        note [fconfigure $c -rc-foo]
2583        close $c
2584        notes
2585    } c]
2586    rename foo {}
2587    set res
2588} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} foo}
2589test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body {
2590    set res {}
2591    proc foo {args} {
2592        oninit cget cgetall; onfinal; track
2593        return -code error BOOM!
2594    }
2595    set c [chan create {r w} foo]
2596    notes [inthread $c {
2597        note [catch {fconfigure $c -rc-foo} msg]
2598        note $msg
2599        close $c
2600        notes
2601    } c]
2602    rename foo {}
2603    set res
2604} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} 1 BOOM!}
2605test iocmd.tf-27.3 {chan configure, get option, break return is error} -match glob -body {
2606    set res {}
2607    proc foo {args} {
2608        oninit cget cgetall; onfinal; track
2609        return -code error BOOM!
2610    }
2611    set c [chan create {r w} foo]
2612    notes [inthread $c {
2613        note [catch {fconfigure $c -rc-foo} msg]
2614        note $msg
2615        close $c
2616        notes
2617    } c]
2618    rename foo {}
2619    set res
2620} -result {{cget rc* -rc-foo} 1 BOOM!} \
2621    -constraints {testchannel testthread}
2622test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match glob -body {
2623    set res {}
2624    proc foo {args} {
2625        oninit cget cgetall; onfinal; track
2626        return -code continue BOOM!
2627    }
2628    set c [chan create {r w} foo]
2629    notes [inthread $c {
2630        note [catch {fconfigure $c -rc-foo} msg]
2631        note $msg
2632        close $c
2633        notes
2634    } c]
2635    rename foo {}
2636    set res
2637} -result {{cget rc* -rc-foo} 1 *bad code*} \
2638    -constraints {testchannel testthread}
2639test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body {
2640    set res {}
2641    proc foo {args} {
2642        oninit cget cgetall; onfinal; track
2643        return -code 333 BOOM!
2644    }
2645    set c [chan create {r w} foo]
2646    notes [inthread $c {
2647        note [catch {fconfigure $c -rc-foo} msg]
2648        note $msg
2649        close $c
2650        notes
2651    } c]
2652    rename foo {}
2653    set res
2654} -result {{cget rc* -rc-foo} 1 *bad code*} \
2655    -constraints {testchannel testthread}
2656test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body {
2657    set res {}
2658    proc foo {args} {
2659        oninit cget cgetall; onfinal; track
2660        return -level 77 -code 333 BANG
2661    }
2662    set c [chan create {r w} foo]
2663    notes [inthread $c {
2664        note [catch {fconfigure $c -rc-foo} msg opt]
2665        note $msg
2666        noteOpts $opt
2667        close $c
2668        notes
2669    } c]
2670    rename foo {}
2671    set res
2672} -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}} \
2673    -constraints {testchannel testthread}
2674
2675# --- === *** ###########################
2676# method seek
2677
2678test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body {
2679    set res {}
2680    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
2681    set c [chan create {r w} foo]
2682    notes [inthread $c {
2683        note [tell $c]
2684        close $c
2685        notes
2686    } c]
2687    rename foo {}
2688    set res
2689} -result {-1} \
2690    -constraints {testchannel testthread}
2691test iocmd.tf-28.2 {chan tell, error return} -match glob -body {
2692    set res {}
2693    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
2694    set c [chan create {r w} foo]
2695    notes [inthread $c {
2696        note [catch {tell $c} msg]
2697        note $msg
2698        close $c
2699        notes
2700    } c]
2701    rename foo {}
2702    set res
2703} -result {{seek rc* 0 current} 1 BOOM!} \
2704    -constraints {testchannel testthread}
2705test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body {
2706    set res {}
2707    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
2708    set c [chan create {r w} foo]
2709    notes [inthread $c {
2710        note [catch {tell $c} msg]
2711        note $msg
2712        close $c
2713        notes
2714    } c]
2715    rename foo {}
2716    set res
2717} -result {{seek rc* 0 current} 1 *bad code*} \
2718    -constraints {testchannel testthread}
2719test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body {
2720    set res {}
2721    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
2722    set c [chan create {r w} foo]
2723    notes [inthread $c {
2724        note [catch {tell $c} msg]
2725        note $msg
2726        close $c
2727        notes
2728    } c]
2729    rename foo {}
2730    set res
2731} -result {{seek rc* 0 current} 1 *bad code*} \
2732    -constraints {testchannel testthread}
2733test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body {
2734    set res {}
2735    proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!}
2736    set c [chan create {r w} foo]
2737    notes [inthread $c {
2738        note [catch {tell $c} msg]
2739        note $msg
2740        close $c
2741        notes
2742    } c]
2743    rename foo {}
2744    set res
2745} -result {{seek rc* 0 current} 1 *bad code*} \
2746    -constraints {testchannel testthread}
2747test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body {
2748    set res {}
2749    proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
2750    set c [chan create {r w} foo]
2751    notes [inthread $c {
2752        note [catch {tell $c} msg opt]
2753        note $msg
2754        noteOpts $opt
2755        close $c
2756        notes
2757    } c]
2758    rename foo {}
2759    set res
2760} -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
2761    -constraints {testchannel testthread}
2762test iocmd.tf-28.7 {chan tell, regular return} -match glob -body {
2763    set res {}
2764    proc foo {args} {oninit seek; onfinal; track; return 88}
2765    set c [chan create {r w} foo]
2766    notes [inthread $c {
2767        note [tell $c]
2768        close $c
2769        notes
2770    } c]
2771    rename foo {}
2772    set res
2773} -result {{seek rc* 0 current} 88} \
2774    -constraints {testchannel testthread}
2775test iocmd.tf-28.8 {chan tell, negative return} -match glob -body {
2776    set res {}
2777    proc foo {args} {oninit seek; onfinal; track; return -1}
2778    set c [chan create {r w} foo]
2779    notes [inthread $c {
2780        note [catch {tell $c} msg]
2781        note $msg
2782        close $c
2783        notes
2784    } c]
2785    rename foo {}
2786    set res
2787} -result {{seek rc* 0 current} 1 {Tried to seek before origin}} \
2788    -constraints {testchannel testthread}
2789test iocmd.tf-28.9 {chan tell, string return} -match glob -body {
2790    set res {}
2791    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
2792    set c [chan create {r w} foo]
2793    notes [inthread $c {
2794        note [catch {tell $c} msg]
2795        note $msg
2796        close $c
2797        notes
2798    } c]
2799    rename foo {}
2800    set res
2801} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} \
2802    -constraints {testchannel testthread}
2803test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body {
2804    set res {}
2805    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
2806    set c [chan create {r w} foo]
2807    notes [inthread $c {
2808        note [catch {seek $c 0 start} msg]
2809        note $msg
2810        close $c
2811        notes
2812    } c]
2813    rename foo {}
2814    set res
2815} -result {1 {error during seek on "rc*": invalid argument}} \
2816    -constraints {testchannel testthread}
2817test iocmd.tf-28.11 {chan seek, error return} -match glob -body {
2818    set res {}
2819    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
2820    set c [chan create {r w} foo]
2821    notes [inthread $c {
2822        note [catch {seek $c 0 start} msg]
2823        note $msg
2824        close $c
2825        notes
2826    } c]
2827    rename foo {}
2828    set res
2829} -result {{seek rc* 0 start} 1 BOOM!} \
2830    -constraints {testchannel testthread}
2831test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body {
2832    set res {}
2833    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
2834    set c [chan create {r w} foo]
2835    notes [inthread $c {
2836        note [catch {seek $c 0 start} msg]
2837        note $msg
2838        close $c
2839        notes
2840    } c]
2841    rename foo {}
2842    set res
2843} -result {{seek rc* 0 start} 1 *bad code*} \
2844    -constraints {testchannel testthread}
2845test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body {
2846    set res {}
2847    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
2848    set c [chan create {r w} foo]
2849    notes [inthread $c {
2850        note [catch {seek $c 0 start} msg]
2851        note $msg
2852        close $c
2853        notes
2854    } c]
2855    rename foo {}
2856    set res
2857} -result {{seek rc* 0 start} 1 *bad code*} \
2858    -constraints {testchannel testthread}
2859test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body {
2860    set res {}
2861    proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!}
2862    set c [chan create {r w} foo]
2863    notes [inthread $c {
2864        note [catch {seek $c 0 start} msg]
2865        note $msg
2866        close $c
2867        notes
2868    } c]
2869    rename foo {}
2870    set res
2871} -result {{seek rc* 0 start} 1 *bad code*} \
2872    -constraints {testchannel testthread}
2873test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body {
2874    set res {}
2875    proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
2876    set c [chan create {r w} foo]
2877    notes [inthread $c {
2878        note [catch {seek $c 0 start} msg opt]
2879        note $msg
2880        noteOpts $opt
2881        close $c
2882        notes
2883    } c]
2884    rename foo {}
2885    set res
2886} -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
2887    -constraints {testchannel testthread}
2888test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -body {
2889    set res {}
2890    proc foo {args} {oninit seek; onfinal; track; return -45}
2891    set c [chan create {r w} foo]
2892    notes [inthread $c {
2893        note [catch {seek $c 0 start} msg]
2894        note $msg
2895        close $c
2896        notes
2897    } c]
2898    rename foo {}
2899    set res
2900} -result {{seek rc* 0 start} 1 {Tried to seek before origin}} \
2901    -constraints {testchannel testthread}
2902test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body {
2903    set res {}
2904    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
2905    set c [chan create {r w} foo]
2906    notes [inthread $c {
2907        note [catch {seek $c 0 start} msg]
2908        note $msg
2909        close $c
2910        notes
2911    } c]
2912    rename foo {}
2913    set res
2914} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} \
2915    -constraints {testchannel testthread}
2916test iocmd.tf-28.18 {chan seek, ok result} -match glob -body {
2917    set res {}
2918    proc foo {args} {oninit seek; onfinal; track; return 23}
2919    set c [chan create {r w} foo]
2920    notes [inthread $c {
2921        note [seek $c 0 current]
2922        close $c
2923        notes
2924    } c]
2925    rename foo {}
2926    set res
2927} -result {{seek rc* 0 current} {}} \
2928    -constraints {testchannel testthread}
2929foreach {testname code} {
2930    iocmd.tf-28.19.0 start
2931    iocmd.tf-28.19.1 current
2932    iocmd.tf-28.19.2 end
2933} {
2934    test $testname "chan seek, base conversion, $code" -match glob -body {
2935        set res {}
2936        proc foo {args} {oninit seek; onfinal; track; return 0}
2937        set c [chan create {r w} foo]
2938        notes [inthread $c {
2939            note [seek $c 0 $code]
2940            close $c
2941            notes
2942        } c code]
2943        rename foo {}
2944        set res
2945    } -result [list [list seek rc* 0 $code] {}] \
2946        -constraints {testchannel testthread}
2947}
2948
2949# --- === *** ###########################
2950# method blocking
2951
2952test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body {
2953    set res {}
2954    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
2955    set c [chan create {r w} foo]
2956    notes [inthread $c {
2957        note [fconfigure $c -blocking]
2958        close $c
2959        notes
2960    } c]
2961    rename foo {}
2962    set res
2963} -result {1} \
2964    -constraints {testchannel testthread}
2965test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body {
2966    set res {}
2967    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
2968    set c [chan create {r w} foo]
2969    notes [inthread $c {
2970        note [fconfigure $c -blocking 0]
2971        note [fconfigure $c -blocking]
2972        close $c
2973        notes
2974    } c]
2975    rename foo {}
2976    set res
2977} -result {{} 0} \
2978    -constraints {testchannel testthread}
2979test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body {
2980    set res {}
2981    proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return}
2982    set c [chan create {r w} foo]
2983    notes [inthread $c {
2984        note [fconfigure $c -blocking]
2985        close $c
2986        notes
2987    } c]
2988    rename foo {}
2989    set res
2990} -result {1} \
2991    -constraints {testchannel testthread}
2992test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body {
2993    set res {}
2994    proc foo {args} {oninit blocking; onfinal; track; return}
2995    set c [chan create {r w} foo]
2996    notes [inthread $c {
2997        note [fconfigure $c -blocking 0]
2998        note [fconfigure $c -blocking]
2999        close $c
3000        notes
3001    } c]
3002    rename foo {}
3003    set res
3004} -result {{blocking rc* 0} {} 0} \
3005    -constraints {testchannel testthread}
3006test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body {
3007    set res {}
3008    proc foo {args} {oninit blocking; onfinal; track; return}
3009    set c [chan create {r w} foo]
3010    notes [inthread $c {
3011        note [fconfigure $c -blocking 1]
3012        note [fconfigure $c -blocking]
3013        close $c
3014        notes
3015    } c]
3016    rename foo {}
3017    set res
3018} -result {{blocking rc* 1} {} 1} \
3019    -constraints {testchannel testthread}
3020test iocmd.tf-29.6 {chan blocking, error return} -match glob -body {
3021    set res {}
3022    proc foo {args} {oninit blocking; onfinal; track; error BOOM!}
3023    set c [chan create {r w} foo]
3024    notes [inthread $c {
3025        note [catch {fconfigure $c -blocking 0} msg]
3026        note $msg
3027        # Catch the close. It changes blocking mode internally, and runs into the error result.
3028        catch {close $c}
3029        notes
3030    } c]
3031    rename foo {}
3032    set res
3033} -result {{blocking rc* 0} 1 BOOM!} \
3034    -constraints {testchannel testthread}
3035test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body {
3036    set res {}
3037    proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!}
3038    set c [chan create {r w} foo]
3039    notes [inthread $c {
3040        note [catch {fconfigure $c -blocking 0} msg]
3041        note $msg
3042        catch {close $c}
3043        notes
3044    } c]
3045    rename foo {}
3046    set res
3047} -result {{blocking rc* 0} 1 *bad code*} \
3048    -constraints {testchannel testthread}
3049test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body {
3050    set res {}
3051    proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!}
3052    set c [chan create {r w} foo]
3053    notes [inthread $c {
3054        note [catch {fconfigure $c -blocking 0} msg]
3055        note $msg
3056        catch {close $c}
3057        notes
3058    } c]
3059    rename foo {}
3060    set res
3061} -result {{blocking rc* 0} 1 *bad code*} \
3062    -constraints {testchannel testthread}
3063test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body {
3064    set res {}
3065    proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!}
3066    set c [chan create {r w} foo]
3067    notes [inthread $c {
3068        note [catch {fconfigure $c -blocking 0} msg]
3069        note $msg
3070        catch {close $c}
3071        notes
3072    } c]
3073    rename foo {}
3074    set res
3075} -result {{blocking rc* 0} 1 *bad code*} \
3076    -constraints {testchannel testthread}
3077test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body {
3078    set res {}
3079    proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
3080    set c [chan create {r w} foo]
3081    notes [inthread $c {
3082        note [catch {fconfigure $c -blocking 0} msg opt]
3083        note $msg
3084        noteOpts $opt
3085        catch {close $c}
3086        notes
3087    } c]
3088    rename foo {}
3089    set res
3090} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} \
3091    -constraints {testchannel testthread}
3092test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
3093    set res {}
3094    proc foo {args} {oninit blocking; onfinal; track; return BOGUS}
3095    set c [chan create {r w} foo]
3096    notes [inthread $c {
3097        note [catch {fconfigure $c -blocking 0} msg]
3098        note $msg
3099        catch {close $c}
3100        notes
3101    } c]
3102    rename foo {}
3103    set res
3104} -result {{blocking rc* 0} 0 {}} \
3105    -constraints {testchannel testthread}
3106
3107# --- === *** ###########################
3108# method watch
3109
3110test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body {
3111    set res {}
3112    proc foo {args} {oninit; onfinal; track; return IGNORED}
3113    set c [chan create {r w} foo]
3114    notes [inthread $c {
3115        note [fileevent $c readable {set tick $tick}]
3116        close $c                ;# 2nd watch, interest zero.
3117        notes
3118    } c]
3119    rename foo {}
3120    set res
3121} -constraints {testchannel testthread} -result {{watch rc* read} {watch rc* {}} {}}
3122test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body {
3123    set res {}
3124    proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED}
3125    set c [chan create {r w} foo]
3126    notes [inthread $c {
3127        note [fileevent $c writable {set tick $tick}]
3128        note [fileevent $c writable {}]
3129        close $c
3130        notes
3131    } c]
3132    rename foo {}
3133    set res
3134} -constraints {testchannel testthread} -result {{watch rc* write} {watch rc* {}} {} {}}
3135test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body {
3136    set res {}
3137    proc foo {args} {oninit; onfinal; track; return}
3138    set c [chan create {r w} foo]
3139    notes [inthread $c {
3140        note [fileevent $c writable {set tick $tick}]
3141        note [fileevent $c readable {set tick $tick}]
3142        note [fileevent $c writable {}]
3143        note [fileevent $c readable {}]
3144        close $c
3145        notes
3146    } c]
3147    rename foo {}
3148    set res
3149} -constraints {testchannel testthread} \
3150    -result {{watch rc* write} {watch rc* {read write}} {watch rc* read} {watch rc* {}} {} {} {} {}}
3151test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
3152    set res {}
3153    proc foo {args} {oninit; onfinal; track; return}
3154    set c [chan create {r w} foo]
3155    notes [inthread $c {
3156        note [fileevent $c writable {set tick $tick}]
3157        note [fileevent $c readable {set tick $tick}] ;# Script is changing,
3158        note [fileevent $c readable {set tock $tock}] ;# interest does not.
3159        close $c        ;# 3rd and 4th watch, removing the event handlers.
3160        notes
3161    } c]
3162    rename foo {}
3163    set res
3164} -constraints {testchannel testthread} \
3165    -result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}}
3166
3167# --- === *** ###########################
3168# postevent
3169# Not possible from a thread not containing the command handler.
3170# Check that this is rejected.
3171
3172test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
3173    set res {}
3174    proc foo {args} {oninit; onfinal; track; return}
3175    set c [chan create {r w} foo]
3176    notes [inthread $c {
3177        catch {chan postevent $c r} msg
3178        note $msg
3179        close $c
3180        notes
3181    } c]
3182    rename foo {}
3183    set res
3184} -constraints {testchannel testthread} \
3185    -result {{can not find reflected channel named "rc*"}}
3186
3187# ### ### ### ######### ######### #########
3188
3189# ### ### ### ######### ######### #########
3190
3191rename track {}
3192# cleanup
3193foreach file [list test1 test2 test3 test4] {
3194    removeFile $file
3195}
3196# delay long enough for background processes to finish
3197after 500
3198foreach file [list test5] {
3199    removeFile $file
3200}
3201cleanupTests
3202return
Note: See TracBrowser for help on using the repository browser.