* tests/ioCmd.test: Extended testsuite for reflected channel

	implementation. Added test cases about how it handles if the rug
	is pulled out from under a channel (= killing threads,
	interpreters containing the tcl command for a channel, and channel
	sitting in a different interpreter/thread.)

	* generic/tclIORChan.c: Fixed the bugs exposed by the new
	testcases, redone most of the cleanup and exit handling.

1 files changed, 178 insertions, 1 deletions

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 5c6a330..fa5d058 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: ioCmd.test,v 1.36.2.4 2008/04/10 20:55:27 andreas_kupries Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.36.2.5 2008/04/24 18:50:42 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -758,6 +758,11 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
 
+# Stored in a script so that the threads and interpreters needing this
+# code do not need their own copy but can access this variable.
+
+set helperscript {
+
 proc note  {item}  {global res; lappend res $item; return}
 proc track {}      {upvar args item; note $item; return}
 proc notes {items} {foreach i $items {note $i}}
@@ -785,6 +790,10 @@ proc onfinal {} {
     if {[lindex $hargs 0] ne "finalize"} {return}
     return -code return ""
 }
+}
+
+# Set everything up in the main thread.
+eval $helperscript
 
 # --- --- --- --------- --------- ---------
 # method finalize
@@ -1808,6 +1817,90 @@ test iocmd-31.8 {chan postevent after close throws error} -match glob -setup {
     rename dummy {}
 } -returnCodes error -result {can not find reflected channel named "rc*"}
 
+# --- === *** ###########################
+# 'Pull the rug' tests. Create channel in a interpreter A, move to
+# other interpreter B, destroy the origin interpreter (A) before or
+# during access from B. Must not crash, must return proper errors.
+
+test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
+
+    set ida [interp create];#puts <<$ida>>
+    set idb [interp create];#puts <<$idb>>
+
+    # Magic to get the test* commands in the slaves
+    load {} Tcltest $ida
+    load {} Tcltest $idb
+
+    # Set up channel in interpreter
+    interp eval $ida $helperscript
+    set chan [interp eval $ida {
+	proc foo {args} {oninit seek; onfinal; track; return}
+	set chan [chan create {r w} foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd interpreter.
+    interp eval $ida [list testchannel cut    $chan]
+    interp eval $idb [list testchannel splice $chan]
+
+    # Kill origin interpreter, then access channel from 2nd interpreter.
+    interp delete $ida
+
+    set     res {}
+    lappend res [catch {interp eval $idb [list puts  $chan shoo]} msg] $msg
+    lappend res [catch {interp eval $idb [list tell  $chan]}      msg] $msg
+    lappend res [catch {interp eval $idb [list seek  $chan 1]}    msg] $msg
+    lappend res [catch {interp eval $idb [list gets  $chan]}      msg] $msg
+    lappend res [catch {interp eval $idb [list close $chan]}      msg] $msg
+    set res
+
+} -constraints {testchannel} \
+    -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+
+test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body {
+
+    set ida [interp create];#puts <<$ida>>
+    set idb [interp create];#puts <<$idb>>
+
+    # Magic to get the test* commands in the slaves
+    load {} Tcltest $ida
+    load {} Tcltest $idb
+
+    # Set up channel in thread
+    set chan [interp eval $ida $helperscript]
+    set chan [interp eval $ida {
+	proc foo {args} {
+	    oninit; onfinal; track;
+	    # destroy interpreter during channel access
+	    # Actually not possible for an interp to destory itself.
+	    interp delete {}
+	    return}
+	set chan [chan create {r w} foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd thread.
+    interp eval $ida [list testchannel cut    $chan]
+    interp eval $idb [list testchannel splice $chan]
+
+    # Run access from interpreter B, this will give us a synchronous
+    # response.
+
+    interp eval $idb [list set chan $chan]
+    interp eval $idb [list set mid $tcltest::mainThread]
+    set res [interp eval $idb {
+	# wait a bit, give the main thread the time to start its event
+	# loop to wait for the response from B
+	after 2000
+	catch { puts $chan shoo } res
+	set res
+    }]
+    set res
+} -constraints {testchannel impossible} \
+    -result {Owner lost}
+
 # ### ### ### ######### ######### #########
 ## Same tests as above, but exercising the code forwarding and
 ## receiving driver operations to the originator thread.
@@ -3196,6 +3289,90 @@ test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
 } -constraints {testchannel testthread} \
     -result {{can not find reflected channel named "rc*"}}
 
+# --- === *** ###########################
+# 'Pull the rug' tests. Create channel in a thread A, move to other
+# thread B, destroy the origin thread (A) before or during access from
+# B. Must not crash, must return proper errors.
+
+test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
+
+    #puts <<$tcltest::mainThread>>main
+    set tida [testthread create];#puts <<$tida>>
+    set tidb [testthread create];#puts <<$tidb>>
+
+    # Set up channel in thread
+    testthread send $tida $helperscript
+    set chan [testthread send $tida {
+	proc foo {args} {oninit seek; onfinal; track; return}
+	set chan [chan create {r w} foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd thread.
+    testthread send $tida [list testchannel cut    $chan]
+    testthread send $tidb [list testchannel splice $chan]
+
+    # Kill origin thread, then access channel from 2nd thread.
+    testthread send -async $tida {testthread exit}
+    after 100
+
+    set     res {}
+    lappend res [catch {testthread send $tidb [list puts  $chan shoo]} msg] $msg
+
+    lappend res [catch {testthread send $tidb [list tell  $chan]}      msg] $msg
+    lappend res [catch {testthread send $tidb [list seek  $chan 1]}    msg] $msg
+    lappend res [catch {testthread send $tidb [list gets  $chan]}      msg] $msg
+    lappend res [catch {testthread send $tidb [list close $chan]}      msg] $msg
+    tcltest::threadReap
+    set res
+
+} -constraints {testchannel testthread} \
+    -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+
+test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {
+
+    #puts <<$tcltest::mainThread>>main
+    set tida [testthread create];#puts <<$tida>>
+    set tidb [testthread create];#puts <<$tidb>>
+
+    # Set up channel in thread
+    set chan [testthread send $tida $helperscript]
+    set chan [testthread send $tida {
+	proc foo {args} {
+	    oninit; onfinal; track;
+	    # destroy thread during channel access
+	    testthread exit
+	    return}
+	set chan [chan create {r w} foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd thread.
+    testthread send $tida [list testchannel cut    $chan]
+    testthread send $tidb [list testchannel splice $chan]
+
+    # Run access from thread B, wait for response from A (A is not
+    # using event loop at this point, so the event pile up in the
+    # queue.
+
+    testthread send $tidb [list set chan $chan]
+    testthread send $tidb [list set mid $tcltest::mainThread]
+    testthread send -async $tidb {
+	# wait a bit, give the main thread the time to start its event
+	# loop to wait for the response from B
+	after 2000
+	catch { puts $chan shoo } res
+	testthread send -async $mid [list set ::res $res]
+    }
+    vwait ::res
+
+    tcltest::threadReap
+    set res
+} -constraints {testchannel testthread} \
+    -result {Owner lost}
+
 # ### ### ### ######### ######### #########
 
 # ### ### ### ######### ######### #########