summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorandreask <andreask>2012-05-09 19:03:42 (GMT)
committerandreask <andreask>2012-05-09 19:03:42 (GMT)
commitb085bdf17a65111cfda61a55fbe5aeedd61b5954 (patch)
tree1d159e1e4d62e1f4663acff9227232291be7888c /tests
parentabdeb8de335b3ad784fed7e0338bcfc9cbd3d99e (diff)
downloadtcl-b085bdf17a65111cfda61a55fbe5aeedd61b5954.zip
tcl-b085bdf17a65111cfda61a55fbe5aeedd61b5954.tar.gz
tcl-b085bdf17a65111cfda61a55fbe5aeedd61b5954.tar.bz2
* tests/ioCmd.test [Bug 3522560]: Added a test which crashes the
core if it were not disabled as knownBug. For a reflected channel transfered to a different thread the [chan postevent] run in the handler thread tries to execute the owner threads's fileevent scripts by itself, wrongly reaching across thread boundaries.
Diffstat (limited to 'tests')
-rw-r--r--tests/ioCmd.test114
1 files changed, 114 insertions, 0 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 1d34861..17c4952 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -2616,6 +2616,120 @@ test iocmd.tf-24.16 {chan write, note the background flush setup by close due to
} -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \
-constraints {testchannel thread knownBug}
+test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
+ -constraints {testchannel thread knownBug} -setup {
+ # This test exposes how the execution of postevent in the handler thread causes
+ # a crash if we are not properly injecting the events into the owning thread instead.
+ # With the injection the test will simply complete without crash.
+
+ set beat 10000
+ set drive 999
+ set data ...---...
+
+ proc LOG {text} {
+ #puts stderr "[thread::id]: $text"
+ return
+ }
+
+ proc POST {hi} {
+ LOG "-> [info level 0]"
+ chan postevent $hi read
+ LOG "<- [info level 0]"
+
+ set ::timer [after $::drive [info level 0]]
+ return
+ }
+
+ proc HANDLER {op ch args} {
+ lappend ::res [lrange [info level 0] 1 end]
+ LOG "-> [info level 0]"
+ set ret {}
+ switch -glob -- $op {
+ init* {set ret {initialize finalize watch read}}
+ watch {
+ set l [lindex $args 0]
+ if {[llength $l]} {
+ set ::timer [after $::drive [list POST $ch]]
+ } else {
+ after cancel $::timer
+ }
+ }
+ finalize {
+ catch { after cancel $::timer }
+ after 500 {set ::forever now}
+ }
+ read {
+ set ret $::data
+ set ::data {} ; # Next is EOF.
+ }
+ }
+ LOG "<- [info level 0] : $ret"
+ return $ret
+ }
+} -body {
+ LOG BEGIN
+ set ch [chan create {read} HANDLER]
+
+ set tid [thread::create {
+ proc LOG {text} {
+ #puts stderr "\t\t\t\t\t\t[thread::id]: $text"
+ return
+ }
+ LOG THREAD-STARTED
+ load {} Tcltest
+ proc bgerror s {
+ LOG BGERROR:$s
+ }
+ vwait forever
+ LOG THREAD-DONE
+ }]
+
+ testchannel cut $ch
+ thread::send $tid [list set thech $ch]
+ thread::send $tid [list set beat $beat]
+ thread::send -async $tid {
+ LOG SPLICE-BEG
+ testchannel splice $thech
+ LOG SPLICE-END
+ proc PROCESS {ch} {
+ LOG "-> [info level 0]"
+ if {[eof $ch]} {
+ close $ch
+ set ::done 1
+ set c <<EOF>>
+ } else {
+ set c [read $ch 1]
+ }
+ LOG "GOTCHAR: $c"
+ LOG "<- [info level 0]"
+ }
+ LOG THREAD-FILEEVENT
+ fconfigure $thech -translation binary -blocking 0
+ fileevent $thech readable [list PROCESS $thech]
+ LOG THREAD-NOEVENT-LOOP
+ set done 0
+ while {!$done} {
+ after $beat
+ LOG THREAD-HEARTBEAT
+ update
+ }
+ LOG THREAD-LOOP-DONE
+ thread::exit
+ }
+
+ LOG MAIN_WAITING
+ vwait forever
+ LOG MAIN_DONE
+
+ set res
+} -cleanup {
+ rename LOG {}
+ rename POST {}
+ rename HANDLER {}
+ unset beat drive data forever res tid ch
+} -match glob \
+ -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}}
+
# --- === *** ###########################
# method cgetall