Merge commit '05fa4c89f20e9769db0e6c0b429cef2590771ace' as 'tcl8.6'

1 files changed, 1443 insertions, 0 deletions

diff --git a/tcl8.6/tests/thread.test b/tcl8.6/tests/thread.test
new file mode 100644
index 0000000..cc4c871
--- /dev/null
+++ b/tcl8.6/tests/thread.test
@@ -0,0 +1,1443 @@
+# Commands covered:  (test)thread
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# 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.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.2
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+# Some tests require the testthread command
+
+testConstraint testthread [expr {[info commands testthread] != {}}]
+
+# Some tests require the Thread package
+
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+
+# Some tests may not work under valgrind
+
+testConstraint notValgrind [expr {![testConstraint valgrind]}]
+
+set threadSuperKillScript {
+    rename catch ""
+    rename while ""
+    rename unknown ""
+    rename update ""
+    thread::release
+}
+
+proc getThreadErrorFromInfo { info } {
+    set list [split $info \n]
+    set idx [lsearch -glob $list "*eval*unwound*"]
+    if {$idx != -1} then {
+        return [lindex $list $idx]
+    }
+    set idx [lsearch -glob $list "*eval*canceled*"]
+    if {$idx != -1} then {
+        return [lindex $list $idx]
+    }
+    return ""; # some other error we do not care about.
+}
+
+proc findThreadError { info } {
+    foreach error [lreverse $info] {
+        set error [getThreadErrorFromInfo $error]
+        if {[string length $error] > 0} then {
+            return $error
+        }
+    }
+    return ""; # some other error we do not care about.
+}
+
+proc ThreadError {id info} {
+    global threadSawError
+    if {[string length [getThreadErrorFromInfo $info]] > 0} then {
+        global threadId threadError
+        set threadId $id
+        lappend threadError($id) $info
+    }
+    set threadSawError($id) true; # signal main thread to exit [vwait].
+}
+
+if {[testConstraint thread]} {
+    thread::errorproc ThreadError
+}
+
+if {[testConstraint testthread]} {
+    proc drainEventQueue {} {
+	while {[set x [testthread event]]} {
+	    #puts "WARNING: drained $x event(s) on main thread"
+	}
+    }
+
+    testthread errorproc ThreadError
+}
+
+# Some tests require manual draining of the event queue
+
+testConstraint drainEventQueue [expr {[info commands drainEventQueue] != {}}]
+
+test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} {
+    llength [thread::names]
+} 1
+test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} {
+    set serverthread [thread::create -preserved]
+    set numthreads [llength [thread::names]]
+    thread::release $serverthread
+    set numthreads
+} {2}
+test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} {
+    thread::create {set x 5}
+    foreach try {0 1 2 4 5 6} {
+	# Try various ways to yield
+	update
+	after 10
+	set l [llength [thread::names]]
+	if {$l == 1} {
+	    break
+	}
+    }
+    set l
+} {1}
+test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
+    thread::create {{*}{}}
+    update
+    after 10
+    llength [thread::names]
+} {1}
+test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} {
+    set serverthread [thread::create -preserved]
+    set five [thread::send $serverthread {set x 5}]
+    thread::release $serverthread
+    set five
+} 5
+test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} {
+    set serverthread [thread::create -preserved {set z 5 ; thread::wait}]
+    set five [thread::send $serverthread {set z}]
+    thread::release $serverthread
+    set five
+} 5
+
+# The tests above also cover:
+# TclCreateThread, except when pthread_create fails
+# NewThread, safe and regular
+# ThreadErrorProc, except for printing to standard error
+
+test thread-2.1 {ListUpdateInner and ListRemove} {thread} {
+    catch {unset tid}
+    foreach t {0 1 2} {
+	upvar #0 t$t tid
+	set tid [thread::create -preserved]
+    }
+    foreach t {0 1 2} {
+	upvar #0 t$t tid
+	thread::release $tid
+    }
+    llength [thread::names]
+} 1
+
+test thread-3.1 {TclThreadList} {thread} {
+    catch {unset tid}
+    set len [llength [thread::names]]
+    set l1  {}
+    foreach t {0 1 2} {
+	lappend l1 [thread::create -preserved]
+    }
+    set l2 [thread::names]
+    set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]]
+    foreach t $l1 {
+	thread::release $t
+    }
+    list $len $c
+} {1 0}
+
+test thread-4.1 {TclThreadSend to self} {thread} {
+    catch {unset x}
+    thread::send [thread::id] {
+	set x 4
+    }
+    set x
+} {4}
+test thread-4.2 {TclThreadSend -async} {thread} {
+    set len [llength [thread::names]]
+    set serverthread [thread::create -preserved]
+    thread::send -async $serverthread {
+	after 1 {thread::release}
+    }
+    set two [llength [thread::names]]
+    after 100 {set done 1}
+    vwait done
+    list $len [llength [thread::names]] $two
+} {1 1 2}
+test thread-4.3 {TclThreadSend preserve errorInfo} {thread} {
+    set len [llength [thread::names]]
+    set serverthread [thread::create -preserved]
+    set x [catch {thread::send $serverthread {set undef}} msg]
+    set savedErrorInfo $::errorInfo
+    thread::release $serverthread
+    list $len $x $msg $savedErrorInfo
+} {1 1 {can't read "undef": no such variable} {can't read "undef": no such variable
+    while executing
+"set undef"
+    invoked from within
+"thread::send $serverthread {set undef}"}}
+test thread-4.4 {TclThreadSend preserve code} {thread} {
+    set len [llength [thread::names]]
+    set serverthread [thread::create -preserved]
+    set ::errorInfo {}
+    set x [catch {thread::send $serverthread {set ::errorInfo {}; break}} msg]
+    set savedErrorInfo $::errorInfo
+    thread::release $serverthread
+    list $len $x $msg $savedErrorInfo
+} {1 3 {} {}}
+test thread-4.5 {TclThreadSend preserve errorCode} {thread} {
+    set serverthread [thread::create]
+    set x [catch {thread::send $serverthread {error ERR INFO CODE}} msg]
+    set savedErrorCode $::errorCode
+    thread::release $serverthread
+    list $x $msg $savedErrorCode
+} {1 ERR CODE}
+
+
+test thread-5.0 {Joining threads} {thread} {
+    set serverthread [thread::create -joinable -preserved]
+    thread::send -async $serverthread {after 1000 ; thread::release}
+    thread::join $serverthread
+} {0}
+test thread-5.1 {Joining threads after the fact} {thread} {
+    set serverthread [thread::create -joinable -preserved]
+    thread::send -async $serverthread {thread::release}
+    after 2000
+    thread::join $serverthread
+} {0}
+test thread-5.2 {Try to join a detached thread} {thread} {
+    set serverthread [thread::create -preserved]
+    thread::send -async $serverthread {after 1000 ; thread::release}
+    catch {set res [thread::join $serverthread]} msg
+    while {[llength [thread::names]] > 1} {
+	after 20
+    }
+    lrange $msg 0 2
+} {cannot join thread}
+
+test thread-6.1 {freeing very large object trees in a thread} thread {
+    # conceptual duplicate of obj-32.1
+    set serverthread [thread::create -preserved]
+    thread::send -async $serverthread {
+	set x {}
+	for {set i 0} {$i<100000} {incr i} {
+	    set x [list $x {}]
+	}
+	unset x
+    }
+    thread::release -wait $serverthread
+} 0
+
+# TIP #285: Script cancellation support
+test thread-7.4 {cancel: pure bytecode loop} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.5 {cancel: pure inside-command loop} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.6 {cancel: pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.7 {cancel: pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.8 {cancel: pure bytecode loop custom result} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread "the eval was canceled"]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was canceled}}
+test thread-7.9 {cancel: pure inside-command loop custom result} -constraints {
+    thread
+    drainEventQueue
+} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::cancel $serverthread "the eval was canceled"]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was canceled}}
+test thread-7.10 {cancel: pure bytecode loop custom result -unwind} -constraints {
+    thread
+    drainEventQueue
+} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread "the eval was unwound"]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was unwound}}
+test thread-7.11 {cancel: pure inside-command loop custom result -unwind} -constraints {
+    thread
+    drainEventQueue
+} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::cancel -unwind $serverthread "the eval was unwound"]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was unwound}}
+test thread-7.12 {cancel: after} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+	    set foo 1
+	}
+	after 30000
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.13 {cancel: after -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+	    set foo 1
+	}
+	after 30000
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.14 {cancel: vwait} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+	    set foo 1
+	}
+	vwait forever
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.15 {cancel: vwait -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+	    set foo 1
+	}
+	vwait forever
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.16 {cancel: expr} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    expr {[while {1} {incr x}]}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.17 {cancel: expr -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    expr {[while {1} {incr x}]}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.18 {cancel: expr bignum} {thread drainEventQueue knownBug} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+        set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+        $i eval {
+            if {![info exists foo]} then {
+                # signal the primary thread that we are ready
+                # to be canceled now (we are running).
+                thread::send %ID% [list set ::threadIdStarted [thread::id]]
+                set foo 1
+            }
+            #
+            # BUGBUG: 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 [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread); # WARNING: Never returns (see above).
+    thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above).
+    list $res [expr {[info exists ::threadIdStarted] ? \
+                  $::threadIdStarted == $serverthread : 0}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 0 {}}
+test thread-7.19 {cancel: expr bignum -unwind} {thread drainEventQueue knownBug} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+        set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+        $i eval {
+            if {![info exists foo]} then {
+                # signal the primary thread that we are ready
+                # to be canceled now (we are running).
+                thread::send %ID% [list set ::threadIdStarted [thread::id]]
+                set foo 1
+            }
+            #
+            # BUGBUG: 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 [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread); # WARNING: Never returns (see above).
+    thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above).
+    list $res [expr {[info exists ::threadIdStarted] ? \
+                  $::threadIdStarted == $serverthread : 0}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 0 {}}
+test thread-7.20 {cancel: subst} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    subst {[while {1} {incr x}]}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.21 {cancel: subst -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    subst {[while {1} {incr x}]}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.22 {cancel: slave interp} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.23 {cancel: slave interp -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    set while while; $while {1} {}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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 [thread::cancel $serverthread]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 0 {}}
+test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	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).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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 [thread::cancel $serverthread]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 0 {}}
+test thread-7.26 {cancel: send async cancel bad interp path} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	[string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		update
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    catch {thread::send $serverthread {interp cancel -- bad}} msg
+    thread::send -async $serverthread {interp cancel -unwind}
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list [expr {$::threadIdStarted == $serverthread}] $msg
+} {1 {could not find interpreter "bad"}}
+test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create -- -unwind]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    proc foobar {} {
+		while {1} {
+		    if {![info exists foo]} then {
+			# signal the primary thread that we are ready
+			# to be canceled now (we are running).
+			thread::send %ID% [list set ::threadIdStarted [thread::id]]
+			set foo 1
+		    }
+		    update
+		}
+	    }
+	    foobar
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::send -async $serverthread {interp cancel -- -unwind}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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 [thread::send -async $serverthread {interp cancel}]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	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).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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 [thread::send -async $serverthread {interp cancel}]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.30 {cancel: send async thread cancel nested catch inside pure bytecode loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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 [thread::send -async $serverthread {thread::cancel [thread::id]}]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.31 {cancel: send async thread cancel nested catch pure inside-command loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	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).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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 [thread::send -async $serverthread {thread::cancel [thread::id]}]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	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).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::send -async $serverthread {interp cancel -unwind}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	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).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::send -async $serverthread {interp cancel -unwind}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.36 {cancel: send async thread cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.37 {cancel: send async thread cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	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).
+		    thread::send %ID% [list set ::threadIdStarted [thread::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
+    set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+
+test thread-8.1 {threaded fork stress} -constraints {thread} -setup {
+    unset -nocomplain ::threadCount ::execCount ::threads ::thread
+    set ::threadCount 10
+    set ::execCount 10
+} -body {
+    set ::threads [list]
+    for {set i 0} {$i < $::threadCount} {incr i} {
+	lappend ::threads [thread::create -joinable [string map \
+		[list %execCount% $::execCount] {
+	    proc execLs {} {
+		if {$::tcl_platform(platform) eq "windows"} then {
+		    return [exec $::env(COMSPEC) /c DIR]
+		} else {
+		    return [exec /bin/ls]
+		}
+	    }
+	    set j {%execCount%}; while {[incr j -1]} {execLs}
+	}]]
+    }
+    foreach ::thread $::threads {
+	thread::join $::thread
+    }
+} -cleanup {
+    unset -nocomplain ::threadCount ::execCount ::threads ::thread
+} -result {}
+
+# cleanup
+::tcltest::cleanupTests
+return