# 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.
#
# RCS: @(#) $Id: thread.test,v 1.21 2009/10/18 08:00:40 mistachkin Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] != {}}]

if {[testConstraint testthread]} {
    testthread errorproc ThreadError

    proc ThreadError {id info} {
	global threadId threadError
	set threadId $id
	set threadError $info
    }

    proc ThreadNullError {id info} {
	# ignore
    }
}


test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
    list [catch {testthread} msg] $msg
} {1 {wrong # args: should be "testthread option ?arg ...?"}}
test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
    list [catch {testthread foo} msg] $msg
} {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}
test thread-1.4 {Tcl_ThreadObjCmd: thread create } {testthread} {
    threadReap
    set serverthread [testthread create]
    update
    set numthreads [llength [testthread names]]
    threadReap
    set numthreads
} {2}
test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {testthread} {
    threadReap
    testthread create {set x 5}
    foreach try {0 1 2 4 5 6} {
	# Try various ways to yield
	update
	after 10
	set l [llength [testthread names]]
	if {$l == 1} {
	    break
	}
    }
    threadReap
    set l
} {1}
test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {testthread} {
    threadReap
    testthread create {testthread exit}
    update
    after 10
    set result [llength [testthread names]]
    threadReap
    set result
} {1}
test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {testthread} {
    set x [catch {testthread id x} msg]
    list $x $msg
} {1 {wrong # args: should be "testthread id"}}
test thread-1.8 {Tcl_ThreadObjCmd: thread id} {testthread} {
    string compare [testthread id] $::tcltest::mainThread
} {0}
test thread-1.9 {Tcl_ThreadObjCmd: thread names args} {testthread} {
    set x [catch {testthread names x} msg]
    list $x $msg
} {1 {wrong # args: should be "testthread names"}}
test thread-1.10 {Tcl_ThreadObjCmd: thread id} {testthread} {
    string compare [testthread names] $::tcltest::mainThread
} {0}
test thread-1.11 {Tcl_ThreadObjCmd: send args} {testthread} {
    set x [catch {testthread send} msg]
    list $x $msg
} {1 {wrong # args: should be "testthread send ?-async? id script"}}
test thread-1.12 {Tcl_ThreadObjCmd: send nonint} {testthread} {
    set x [catch {testthread send abc command} msg]
    list $x $msg
} {1 {expected integer but got "abc"}}
test thread-1.13 {Tcl_ThreadObjCmd: send args} {testthread} {
    threadReap
    set serverthread [testthread create]
    set five [testthread send $serverthread {set x 5}]
    threadReap
    set five
} 5
test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {testthread} {
    set tid [expr $::tcltest::mainThread + 10]
    set x [catch {testthread send $tid {set x 5}} msg]
    list $x $msg
} {1 {invalid thread id}}
test thread-1.15 {Tcl_ThreadObjCmd: wait} {testthread} {
    threadReap
    set serverthread [testthread create {set z 5 ; testthread wait}]
    set five [testthread send $serverthread {set z}]
    threadReap
    set five
} 5
test thread-1.16 {Tcl_ThreadObjCmd: errorproc args} {testthread} {
    set x [catch {testthread errorproc foo bar} msg]
    list $x $msg
} {1 {wrong # args: should be "testthread errorproc proc"}}
test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {testthread} {
    testthread errorproc foo
    testthread errorproc ThreadError
} {}

# 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} {testthread} {
    threadReap
    catch {unset tid}
    foreach t {0 1 2} {
	upvar #0 t$t tid
	set tid [testthread create]
    }
    threadReap
} 1

test thread-3.1 {TclThreadList} {testthread} {
    threadReap
    catch {unset tid}
    set len [llength [testthread names]]
    set l1  {}
    foreach t {0 1 2} {
	lappend l1 [testthread create]
    }
    set l2 [testthread names]
    list $l1 $l2
    set c [string compare \
	    [lsort -integer [concat $::tcltest::mainThread $l1]] \
	    [lsort -integer $l2]]
    threadReap
    list $len $c
} {1 0}

test thread-4.1 {TclThreadSend to self} {testthread} {
    catch {unset x}
    testthread send [testthread id] {
	set x 4
    }
    set x
} {4}
test thread-4.2 {TclThreadSend -async} {testthread} {
    threadReap
    set len [llength [testthread names]]
    set serverthread [testthread create]
    testthread send -async $serverthread {
	after 1000
	testthread exit
    }
    set two [llength [testthread names]]
    after 1500 {set done 1}
    vwait done
    threadReap
    list $len [llength [testthread names]] $two
} {1 1 2}
test thread-4.3 {TclThreadSend preserve errorInfo} {testthread} {
    threadReap
    set len [llength [testthread names]]
    set serverthread [testthread create]
    set x [catch {testthread send $serverthread {set undef}} msg]
    set savedErrorInfo $::errorInfo
    threadReap
    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
"testthread send $serverthread {set undef}"}}
test thread-4.4 {TclThreadSend preserve code} {testthread} {
    threadReap
    set len [llength [testthread names]]
    set serverthread [testthread create]
    set ::errorInfo {}
    set x [catch {testthread send $serverthread {set ::errorInfo {}; break}} msg]
    set savedErrorInfo $::errorInfo
    threadReap
    list $len $x $msg $savedErrorInfo
} {1 3 {} {}}
test thread-4.5 {TclThreadSend preserve errorCode} {testthread} {
    threadReap
    set ::tcltest::mainThread [testthread names]
    set serverthread [testthread create]
    set x [catch {testthread send $serverthread {error ERR INFO CODE}} msg]
    set savedErrorCode $::errorCode
    threadReap
    list $x $msg $savedErrorCode
} {1 ERR CODE}


test thread-5.0 {Joining threads} {testthread} {
    threadReap
    set serverthread [testthread create -joinable]
    testthread send -async $serverthread {after 1000 ; testthread exit}
    set res [testthread join $serverthread]
    threadReap
    set res
} {0}
test thread-5.1 {Joining threads after the fact} {testthread} {
    threadReap
    set serverthread [testthread create -joinable]
    testthread send -async $serverthread {testthread exit}
    after 2000
    set res [testthread join $serverthread]
    threadReap
    set res
} {0}
test thread-5.2 {Try to join a detached thread} {testthread} {
    threadReap
    set serverthread [testthread create]
    testthread send -async $serverthread {after 1000 ; testthread exit}
    catch {set res [testthread join $serverthread]} msg
    threadReap
    lrange $msg 0 2
} {cannot join thread}

test thread-6.1 {freeing very large object trees in a thread} testthread {
    # conceptual duplicate of obj-32.1
    threadReap
    set serverthread [testthread create -joinable]
    testthread send -async $serverthread {
	set x {}
	for {set i 0} {$i<100000} {incr i} {
	    set x [list $x {}]
	}
	unset x
	testthread exit
    }
    catch {set res [testthread join $serverthread]} msg
    threadReap
    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