summaryrefslogtreecommitdiffstats
path: root/tests/ioCmd.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/ioCmd.test')
-rw-r--r--tests/ioCmd.test173
1 files changed, 136 insertions, 37 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 03242be..f66480a 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -294,7 +294,7 @@ test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOr
close $srv
unset cli srv port
rename iocmdSRV {}
-} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -connecting, -peername, or -sockname}
test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $srv -sockname] 2]
@@ -349,7 +349,7 @@ test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable
close $tty
}
} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar}
-# TODO: Test parsing of serial channel options (nonportable, since requires an
+# TODO: Test parsing of serial channel options (nonPortable, since requires an
# open channel to work with).
test iocmd-9.1 {eof command} {
@@ -639,7 +639,7 @@ test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} {
} "1 {channel \"$rfile\" wasn't opened for writing}"
test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $rfile $wfile foo bar} msg] $msg
-} {1 {bad switch "foo": must be -size or -command}}
+} {1 {bad option "foo": must be -size or -command}}
test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $rfile $wfile -size foo} msg] $msg
} {1 {expected integer but got "foo"}}
@@ -793,6 +793,90 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
rename foo {}
set res
} -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+ proc foo {method chan args} {
+ switch -- $method blocking {
+ chan configure $chan -blocking [lindex $args 0]
+ return
+ } initialize {
+ return {initialize finalize watch blocking read write
+ configure cget cgetall}
+ } finalize {
+ return
+ }
+ }
+ set ch [chan create {read write} foo]
+} -body {
+ list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+ close $ch
+ rename foo {}
+} -match glob -result {1 {*nested eval*}}
+test iocmd-21.21 {[close] in [read] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ close $chan
+ return a
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ read $ch 0
+} -cleanup {
+ close $ch
+ rename foo {}
+} -result {}
+test iocmd-21.22 {[close] in [read] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return a
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ read $ch 1
+} -returnCodes error -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ chan configure $ch -translation binary
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.
@@ -935,7 +1019,7 @@ test iocmd-23.1 {chan read, regular data return} -match glob -body {
close $c
rename foo {}
set res
-} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+} -result {{read rc* 4096} {read rc* 4096} {watch rc* {}} snarfsnarf}
test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
set res {}
proc foo {args} {
@@ -947,7 +1031,7 @@ test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
close $c
rename foo {}
set res
-} -result {{read rc* 4096} 1 {read delivered more than requested}}
+} -result {{read rc* 4096} {watch rc* {}} 1 {read delivered more than requested}}
test iocmd-23.3 {chan read, for non-readable channel} -match glob -body {
set res {}
proc foo {args} {
@@ -970,7 +1054,7 @@ test iocmd-23.4 {chan read, error return} -match glob -body {
close $c
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM!}
+} -result {{read rc* 4096} {watch rc* {}} 1 BOOM!}
test iocmd-23.5 {chan read, break return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -982,7 +1066,7 @@ test iocmd-23.5 {chan read, break return is error} -match glob -body {
close $c
rename foo {}
set res
-} -result {{read rc* 4096} 1 *bad code*}
+} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*}
test iocmd-23.6 {chan read, continue return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -994,7 +1078,7 @@ test iocmd-23.6 {chan read, continue return is error} -match glob -body {
close $c
rename foo {}
set res
-} -result {{read rc* 4096} 1 *bad code*}
+} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*}
test iocmd-23.7 {chan read, custom return is error} -match glob -body {
set res {}
proc foo {args} {
@@ -1006,7 +1090,7 @@ test iocmd-23.7 {chan read, custom return is error} -match glob -body {
close $c
rename foo {}
set res
-} -result {{read rc* 4096} 1 *bad code*}
+} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*}
test iocmd-23.8 {chan read, level is squashed} -match glob -body {
set res {}
proc foo {args} {
@@ -1018,7 +1102,7 @@ test iocmd-23.8 {chan read, level is squashed} -match glob -body {
close $c
rename foo {}
set res
-} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
+} -result {{read rc* 4096} {watch rc* {}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
test iocmd-23.9 {chan read, no data means eof} -match glob -setup {
set res {}
proc foo {args} {
@@ -1034,7 +1118,7 @@ test iocmd-23.9 {chan read, no data means eof} -match glob -setup {
close $c
rename foo {}
unset res
-} -result {{read rc* 4096} {} 1}
+} -result {{read rc* 4096} {watch rc* {}} {} 1}
test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
set res {}
proc foo {args} {
@@ -1050,7 +1134,21 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo
close $c
rename foo {}
unset res
-} -result {{read rc* 4096} {} 0}
+} -result {{read rc* 4096} {watch rc* {}} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ set args [lassign $args sub id]
+ if {$sub ne "read"} {return}
+ close $id
+ return {}
+ }
+ set c [chan create {r} foo]
+ note [read $c]
+ rename foo {}
+ set res
+} -result {{read rc* 4096} {}}
# --- === *** ###########################
# method write
@@ -1350,14 +1448,14 @@ test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
test iocmd-26.1 {chan configure, set standard option} -match glob -body {
set res {}
proc foo {args} {
- oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
+ oninit configure; onfinal; track; return
}
set c [chan create {r w} foo]
note [fconfigure $c -translation lf]
close $c
rename foo {}
set res
-} -result {{}}
+} -result {{watch rc* {}} {}}
test iocmd-26.2 {chan configure, set option, error return} -match glob -body {
set res {}
proc foo {args} {
@@ -1895,7 +1993,7 @@ test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body {
close $c
rename foo {}
set res
-} -result {{watch rc* read} {} TOCK {} {watch rc* {}}}
+} -result {{watch rc* read} {} TOCK {watch rc* read} {} {watch rc* {}}}
test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return}
@@ -1908,7 +2006,7 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
close $c
rename foo {}
set res
-} -result {{watch rc* write} {} TOCK {} {watch rc* {}}}
+} -result {{watch rc* write} {} TOCK {watch rc* write} {} {watch rc* {}}}
test iocmd-31.8 {chan postevent after close throws error} -match glob -setup {
proc foo {args} {oninit; onfinal; track; return}
proc dummy args { return }
@@ -1978,13 +2076,13 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
proc foo {args} {
oninit; onfinal; track;
# destroy interpreter during channel access
- # Actually not possible for an interp to destroy itself.
- interp delete {}
- return}
+ suicide
+ }
set chan [chan create {r w} foo]
fconfigure $chan -buffering none
set chan
}]
+ interp alias $ida suicide {} interp delete $ida
# Move channel to 2nd thread.
interp eval $ida [list testchannel cut $chan]
@@ -2002,8 +2100,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
set res
}]
set res
-} -constraints {testchannel impossible} \
- -result {Owner lost}
+} -constraints {testchannel} -result {Owner lost}
test iocmd-32.2 {delete interp of reflected chan} {
# Bug 3034840
@@ -2203,7 +2300,7 @@ test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} {watch rc* {}} snarfsnarf}
test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
set res {}
proc foo {args} {
@@ -2218,7 +2315,7 @@ test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel thread} -result {{read rc* 4096} 1 {read delivered more than requested}}
+} -constraints {testchannel thread} -result {{read rc* 4096} {watch rc* {}} 1 {read delivered more than requested}}
test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
set res {}
proc foo {args} {
@@ -2247,7 +2344,7 @@ test iocmd.tf-23.4 {chan read, error return} -match glob -body {
} c]
rename foo {}
set res
-} -result {{read rc* 4096} 1 BOOM!} \
+} -result {{read rc* 4096} {watch rc* {}} 1 BOOM!} \
-constraints {testchannel thread}
test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
set res {}
@@ -2263,7 +2360,7 @@ test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
} c]
rename foo {}
set res
-} -result {{read rc* 4096} 1 *bad code*} \
+} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \
-constraints {testchannel thread}
test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
set res {}
@@ -2279,7 +2376,7 @@ test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
} c]
rename foo {}
set res
-} -result {{read rc* 4096} 1 *bad code*} \
+} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \
-constraints {testchannel thread}
test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
set res {}
@@ -2295,7 +2392,7 @@ test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
} c]
rename foo {}
set res
-} -result {{read rc* 4096} 1 *bad code*} \
+} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \
-constraints {testchannel thread}
test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
set res {}
@@ -2311,7 +2408,7 @@ test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
} c]
rename foo {}
set res
-} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
+} -result {{read rc* 4096} {watch rc* {}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
-constraints {testchannel thread}
test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
set res {}
@@ -2331,7 +2428,7 @@ test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
} -cleanup {
rename foo {}
unset res
-} -result {{read rc* 4096} {} 1} \
+} -result {{read rc* 4096} {watch rc* {}} {} 1} \
-constraints {testchannel thread}
test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
set res {}
@@ -2351,7 +2448,7 @@ test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match
} -cleanup {
rename foo {}
unset res
-} -result {{read rc* 4096} {} 0} \
+} -result {{read rc* 4096} {watch rc* {}} {} 0} \
-constraints {testchannel thread}
# --- === *** ###########################
@@ -2651,10 +2748,9 @@ test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
init* {set ret {initialize finalize watch read}}
watch {
set l [lindex $args 0]
+ catch {after cancel $::timer}
if {[llength $l]} {
set ::timer [after $::drive [list POST $ch]]
- } else {
- after cancel $::timer
}
}
finalize {
@@ -2717,7 +2813,9 @@ test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
update
}
LOG THREAD-LOOP-DONE
- thread::exit
+ #thread::exit
+ # Thread exits cause leaks; Use clean thread shutdown
+ set forever yourGirl
}
LOG MAIN_WAITING
@@ -2726,10 +2824,11 @@ test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
set res
} -cleanup {
+ after cancel $::timer
rename LOG {}
rename POST {}
rename HANDLER {}
- unset beat drive data forever res tid ch
+ unset beat drive data forever res tid ch timer
} -match glob \
-result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}}
@@ -2902,7 +3001,7 @@ test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -bod
test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
set res {}
proc foo {args} {
- oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
+ oninit configure; onfinal; track; return
}
set c [chan create {r w} foo]
notes [inthread $c {
@@ -2912,7 +3011,7 @@ test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
} c]
rename foo {}
set res
-} -constraints {testchannel thread} -result {{}}
+} -constraints {testchannel thread} -result {{watch rc* {}} {}}
test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body {
set res {}
proc foo {args} {
@@ -3671,7 +3770,7 @@ test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
# The test iocmd.tf-32.1 unavoidably exhibits a memory leak. We are testing
# the ability of the reflected channel system to react to the situation where
# the thread in which the driver routines runs exits during driver operations.
-# In this case, thread exit handlers signal back to the owner thread so that the
+# In this case, thread exit handlers signal back to the owner thread so that the
# channel operation does not hang. There's no way to test this without actually
# exiting a thread in mid-operation, and that action is unavoidably leaky (which
# is why [thread::exit] is advised against).