TIP 285 Implementation

1 files changed, 1191 insertions, 3 deletions

diff --git a/tests/thread.test b/tests/thread.test
index 9f5562e..97de497 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -6,11 +6,12 @@
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: thread.test,v 1.18 2007/12/13 15:26:07 dgp Exp $
+# RCS: @(#) $Id: thread.test,v 1.19 2008/06/13 05:45:15 mistachkin Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -25,7 +26,8 @@ if {[testConstraint testthread]} {
     testthread errorproc ThreadError
 
     proc ThreadError {id info} {
-	global threadError
+	global threadId threadError
+	set threadId $id
 	set threadError $info
     }
 
@@ -40,7 +42,7 @@ test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
 } {1 {wrong # args: should be "testthread option ?args?"}}
 test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
     list [catch {testthread foo} msg] $msg
-} {1 {bad option "foo": must be create, exit, id, join, names, send, wait, or errorproc}}
+} {1 {bad option "foo": must be cancel, create, event, exit, id, join, names, send, wait, or errorproc}}
 test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {testthread} {
     list [threadReap] [llength [testthread names]]
 } {1 1}
@@ -253,6 +255,1192 @@ test thread-6.1 {freeing very large object trees in a thread} testthread {
     set res
 } {0}
 
+# TIP #285: Script cancellation support
+test thread-7.1 {cancel: args} {testthread} {
+    set x [catch {testthread cancel} msg]
+    list $x $msg
+} {1 {wrong # args: should be "testthread cancel ?-unwind? id ?result?"}}
+test thread-7.2 {cancel: nonint} {testthread} {
+    set x [catch {testthread cancel abc} msg]
+    list $x $msg
+} {1 {expected integer but got "abc"}}
+test thread-7.3 {cancel: bad id} {testthread} {
+    set tid [expr $::tcltest::mainThread + 10]
+    set x [catch {testthread cancel $tid} msg]
+    list $x $msg
+} {1 {invalid thread id}}
+test thread-7.4 {cancel: pure bytecode loop} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval canceled}}
+test thread-7.5 {cancel: pure inside-command loop} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    set while while
+	    $while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval canceled}}
+test thread-7.6 {cancel: pure bytecode loop -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.7 {cancel: pure inside-command loop -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+    	  proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    set while while
+	    $while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.8 {cancel: pure bytecode loop custom result} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread "the eval was canceled"]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {the eval was canceled}}
+test thread-7.9 {cancel: pure inside-command loop custom result} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+    	  proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    set while while
+	    $while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread "the eval was canceled"]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {the eval was canceled}}
+test thread-7.10 {cancel: pure bytecode loop custom result -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread "the eval was unwound"]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {the eval was unwound}}
+test thread-7.11 {cancel: pure inside-command loop custom result -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+    	  proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    set while while
+	    $while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread "the eval was unwound"]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {the eval was unwound}}
+test thread-7.12 {cancel: after} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    testthread send [testthread id -main] \
+		    [list set ::threadIdStarted [testthread id]]
+	    set foo 1
+	}
+	after 30000
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval canceled}}
+test thread-7.13 {cancel: after -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    testthread send [testthread id -main] \
+		    [list set ::threadIdStarted [testthread id]]
+	    set foo 1
+	}
+	after 30000
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.14 {cancel: vwait} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    testthread send [testthread id -main] \
+		    [list set ::threadIdStarted [testthread id]]
+	    set foo 1
+	}
+	vwait forever
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval canceled}}
+test thread-7.15 {cancel: vwait -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    testthread send [testthread id -main] \
+		    [list set ::threadIdStarted [testthread id]]
+	    set foo 1
+	}
+	vwait forever
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.16 {cancel: expr} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	set i [interp create]
+	interp alias $i testthread {} testthread
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    expr {[while {1} {incr x}]}
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval canceled}}
+test thread-7.17 {cancel: expr -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	set i [interp create]
+	interp alias $i testthread {} testthread
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    expr {[while {1} {incr x}]}
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.18 {cancel: expr bignum} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	set i [interp create]
+	interp alias $i testthread {} testthread
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    #
+      # TODO: This will not cancel because libtommath
+      #       does not check Tcl_Canceled.
+      #
+	    expr {2**99999}
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 0 {}}
+test thread-7.19 {cancel: expr bignum -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	set i [interp create]
+	interp alias $i testthread {} testthread
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    #
+      # TODO: This will not cancel because libtommath
+      #       does not check Tcl_Canceled.
+      #
+	    expr {2**99999}
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 0 {}}
+test thread-7.20 {cancel: subst} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	set i [interp create]
+	interp alias $i testthread {} testthread
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    subst {[while {1} {incr x}]}
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval canceled}}
+test thread-7.21 {cancel: subst -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	set i [interp create]
+	interp alias $i testthread {} testthread
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    subst {[while {1} {incr x}]}
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.22 {cancel: slave interp} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	set i [interp create]
+	interp alias $i testthread {} testthread
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    while {1} {}
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval canceled}}
+test thread-7.23 {cancel: slave interp -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	set i [interp create]
+	interp alias $i testthread {} testthread
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		testthread send [testthread id -main] \
+			[list set ::threadIdStarted [testthread id]]
+		set foo 1
+	    }
+	    set while while; $while {1} {}
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.24 {cancel: nested catch inside pure bytecode loop} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    after 1000; # wait for ThreadErrorProc to be called.
+    while {[testthread event]} {}; # force events to service
+    catch {testthread send $serverthread {testthread exit}}
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 0 {}}
+test thread-7.25 {cancel: nested catch inside pure inside-command loop} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel $serverthread]
+    after 1000; # wait for ThreadErrorProc to be called.
+    while {[testthread event]} {}; # force events to service
+    catch {testthread send $serverthread {testthread exit}}
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 0 {}}
+test thread-7.26 {cancel: send async cancel bad interp path} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		update
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    catch {testthread send $serverthread {interp cancel -- bad}} msg
+    threadReap
+    list [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+		  $msg
+} {1 {could not find interpreter "bad"}}
+test thread-7.27 {cancel: send async cancel -- switch} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	interp create -- -unwind
+	interp alias -unwind testthread {} testthread
+	interp eval -unwind {
+	    proc foobar {} {
+		while {1} {
+		    if {![info exists foo]} then {
+			# signal the primary thread that we are ready
+			# to be canceled now (we are running).
+			testthread send [testthread id -main] \
+				[list set ::threadIdStarted [testthread id]]
+			set foo 1
+		    }
+		    update
+		}
+	    }
+	    foobar
+	}
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {interp cancel -- -unwind}]
+    after 1000; # wait for ThreadErrorProc to be called.
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval canceled}}
+test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {interp cancel}]
+    after 1000; # wait for ThreadErrorProc to be called.
+    while {[testthread event]} {}; # force events to service
+    catch {testthread send $serverthread {testthread exit}}
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 0 {}}
+test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {interp cancel}]
+    after 1000; # wait for ThreadErrorProc to be called.
+    while {[testthread event]} {}; # force events to service
+    catch {testthread send $serverthread {testthread exit}}
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 0 {}}
+test thread-7.30 {cancel: send async testthread cancel nested catch inside pure bytecode loop} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {testthread cancel [testthread id]}]
+    after 1000; # wait for ThreadErrorProc to be called.
+    while {[testthread event]} {}; # force events to service
+    catch {testthread send $serverthread {testthread exit}}
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 0 {}}
+test thread-7.31 {cancel: send async testthread cancel nested catch pure inside-command loop} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {testthread cancel [testthread id]}]
+    after 1000; # wait for ThreadErrorProc to be called.
+    while {[testthread event]} {}; # force events to service
+    catch {testthread send $serverthread {testthread exit}}
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 0 {}}
+test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# No bytecode at all here...
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# No bytecode at all here...
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread cancel -unwind $serverthread]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {interp cancel -unwind}]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {interp cancel -unwind}]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.36 {cancel: send async testthread cancel nested catch inside pure bytecode loop -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {testthread cancel -unwind [testthread id]}]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+test thread-7.37 {cancel: send async testthread cancel nested catch inside pure inside-command loop -unwind} {testthread} {
+    threadReap
+    unset -nocomplain ::threadError ::threadId ::threadIdStarted
+    set serverthread [testthread create -joinable {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    testthread send [testthread id -main] \
+			    [list set ::threadIdStarted [testthread id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [testthread send -async $serverthread {testthread cancel -unwind [testthread id]}]
+    testthread join $serverthread
+    while {[testthread event]} {}; # force events to service
+    threadReap
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError] ? \
+		  [lindex [split $::threadError \n] 0] : "" }]
+} {{} 1 1 {eval unwound}}
+
 # cleanup
 ::tcltest::cleanupTests
 return