merge trunk

1 files changed, 120 insertions, 0 deletions

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 4c08229..5eb0206 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -18,6 +18,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # Custom constraints used in this file
 testConstraint fcopy		[llength [info commands fcopy]]
 testConstraint testchannel	[llength [info commands testchannel]]
@@ -2575,6 +2578,7 @@ test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at thi
     set res
 } -cleanup {
     proc foo {args} {onfinal; set ::done-24.15 1; return 3}
+    after 1000 {set ::done-24.15 2}
     vwait done-24.15
     rename foo {}
     unset res
@@ -2603,16 +2607,132 @@ test iocmd.tf-24.16 {chan write, note the background flush setup by close due to
     proc foo {args} { onfinal; note BG ; track ; set ::endbody-24.16 1}
     # Flush (sic!) the event-queue to capture the write from a
     # BG-flush.
+    after 1000 {set ::endbody-24.16 2}
     vwait endbody-24.16
     set res
 } -cleanup {
     proc foo {args} {onfinal; set ::done-24.16 1; return 3}
+    after 1000 {set ::done-24.16 2}
     vwait done-24.16
     rename foo {}
     unset res
 } -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \
     -constraints {testchannel thread}
 
+test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
+    -constraints {testchannel thread} -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