* generic/tcl.h:

	* generic/tclInt.h:
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclNamesp.c (Tcl_PopCallFrame): Rewritten tailcall
	implementation, ::unsupported::atProcExit is (temporarily?)
	gone. The new approach is much simpler, and also closer to being
	correct. This commit fixes [Bug 2649975] and [Bug 2695587].

	* tests/coroutine.test:    Moved the tests to their own files,
	* tests/tailcall.test:     removed the unsupported.test. Added
	* tests/unsupported.test:  tests for the fixed bugs.

1 files changed, 0 insertions, 914 deletions

diff --git a/tests/unsupported.test b/tests/unsupported.test
deleted file mode 100644
index 0c706b8..0000000
--- a/tests/unsupported.test
+++ /dev/null
@@ -1,914 +0,0 @@
-# Commands covered:  tailcall, atProcExit, coroutine, yield
-#
-# This file contains a collection of tests for experimental commands that are
-# found in ::tcl::unsupported. The tests will migrate to normal test files
-# if/when the commands find their way into the core.
-#
-# Copyright (c) 2008 by Miguel Sofer.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unsupported.test,v 1.15 2008/10/14 18:49:47 dgp Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
-
-testConstraint testnrelevels [llength [info commands testnrelevels]]
-testConstraint atProcExit [llength [info commands ::tcl::unsupported::atProcExit]]
-
-if {[namespace exists tcl::unsupported]} {
-    namespace eval tcl::unsupported namespace export *
-    namespace import tcl::unsupported::*
-}
-
-#
-# The tests that risked blowing the C stack on failure have been removed: we
-# can now actually measure using testnrelevels.
-#
-
-if {[testConstraint testnrelevels]} {
-    namespace eval testnre {
-	#
-	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
-	# cmdFrame level, callFrame level, tosPtr and callback depth 
-	#
-	variable last [testnrelevels] 
-	proc depthDiff {} {
-	    variable last
-	    set depth [testnrelevels]
-	    set res {}
-	    foreach t $depth l $last {
-		lappend res [expr {$t-$l}]
-	    }
-	    set last $depth
-	    return $res
-	}
-	proc setabs {} {
-	    uplevel 1 variable abs -[lindex [testnrelevels] 0]
-	}
-
-	variable body0 {
-	    set x [depthDiff]
-	    if {[incr i] > 10} {
-		variable abs
-		incr abs [lindex [testnrelevels] 0]
-		return [list [lrange $x 0 3] $abs]
-	    }
-	}
-	proc makebody txt {
-	    variable body0
-	    return "$body0; $txt"
-	}
-	namespace export *
-    }
-    namespace import testnre::*
-}
-
-#
-# Test atProcExit
-#
-
-test unsupported-A.1 {atProcExit works} -constraints {atProcExit} -setup {
-    variable x x y y
-    proc a {} {
-	variable x 0 y 0
-	atProcExit set ::x 1
-	set x 2
-	set y $x
-	set x 3
-    }
-    proc b {} a
-} -body {
-    list [b] $x $y 
-} -cleanup {
-    unset x y
-    rename a {}
-    rename b {}
-} -result {3 1 2}
-
-test unsupported-A.2 {atProcExit} -constraints {atProcExit} -setup {
-    variable x x y x
-    proc a {} {
-	variable x 0 y 0
-	atProcExit set ::x 1
-	set x 2
-	set y $x
-	set x 3
-    }
-} -body {
-    list [a] $x $y 
-} -cleanup {
-    unset x y
-    rename a {}
-} -result {3 1 2}
-
-test unsupported-A.3 {atProcExit} -constraints {atProcExit} -setup {
-    variable x x y y
-    proc a {} {
-	variable x 0 y 0
-	atProcExit lappend ::x 1
-	lappend x 2
-	atProcExit lappend ::x 3
-	lappend y $x
-	lappend x 4
-	return 5
-    }
-} -body {
-    list [a] $x $y 
-} -cleanup {
-    unset x y
-    rename a {}
-} -result {5 {0 2 4 3 1} {0 {0 2}}}
-
-test unsupported-A.4 {atProcExit errors} -constraints {atProcExit} -setup {
-    variable x x y y
-    proc a {} {
-	variable x 0 y 0
-	atProcExit lappend ::x 1
-	lappend x 2
-	atProcExit lappend ::x 3
-	lappend y $x
-	lappend x 4
-	error foo
-    }
-} -body {
-    list [a] $x $y 
-} -cleanup {
-    unset x y
-    rename a {}
-} -returnCodes error -result foo
-
-test unsupported-A.5 {atProcExit errors} -constraints {atProcExit} -setup {
-    variable x x y y
-    proc a {} {
-	variable x 0 y 0
-	atProcExit error foo
-	lappend x 2
-	atProcExit lappend ::x 3
-	lappend y $x
-	lappend x 4
-	return 5
-    }
-} -body {
-    list [a] $x $y 
-} -cleanup {
-    unset x y
-    rename a {}
-} -result {5 {0 2 4 3} {0 {0 2}}}
-
-test unsupported-A.6 {atProcExit errors} -constraints {atProcExit} -setup {
-    variable x x y y
-    proc a {} {
-	variable x 0 y 0
-	atProcExit lappend ::x 1
-	lappend x 2
-	atProcExit error foo
-	lappend y $x
-	lappend x 4
-	return 5
-    }
-} -body {
-    list [a] $x $y 
-} -cleanup {
-    unset x y
-    rename a {}
-} -result {5 {0 2 4} {0 {0 2}}}
-
-test unsupported-A.7 {atProcExit non-proc} -constraints {atProcExit} -body {
-    atProcExit set x 2
-    set x 1
-} -cleanup {
-    unset -nocomplain x
-} -match glob -result *atProcExit* -returnCodes error
-
-test unsupported-A.8 {atProcExit and eval} -constraints {knownBug atProcExit} -setup {
-    proc a {} {
-	eval atProcExit lappend ::x 2
-	set ::x 1
-    }
-} -body {
-    list [a] $::x
-} -cleanup {
-    unset -nocomplain ::x
-} -result {1 2}
-
-test unsupported-A9 {atProcExit and uplevel} -constraints {knownBug atProcExit} -setup {
-    proc a {} {
-	uplevel 1 [list atProcExit set ::x 2]
-	set ::x 1
-    }
-} -body {
-    list [a] $::x
-} -cleanup {
-    unset -nocomplain ::x
-} -result {1 2}
-
-
-#
-# Test tailcalls
-#
-
-test unsupported-T.0 {tailcall is constant space} -constraints testnrelevels -setup {
-    proc a i {
-	if {[incr i] > 10} {
-	    return [depthDiff]
-	}
-	depthDiff
-	tailcall a $i
-    }
-} -body {
-    a 0
-} -cleanup {
-    rename a {}
-} -result {0 0 0 0 0 0}
-
-test unsupported-T.1 {tailcall} -body {
-    namespace eval a {
-	variable x *::a
-	proc xset {} {
-	    set tmp {}
-	    set ns {[namespace current]}
-	    set level [info level]
-	    for {set i 0} {$i <= [info level]} {incr i} {
-		uplevel #$i "set x $i$ns"
-		lappend tmp "$i [info level $i]"
-	    }
-	    lrange $tmp 1 end
-	}
-	proc foo {} {tailcall xset; set x noreach}
-    }
-    namespace eval b {
-	variable x *::b
-	proc xset args {error b::xset}
-	proc moo {} {set x 0; variable y [::a::foo]; set x}
-    }
-    variable x *::
-    proc xset args {error ::xset}
-    list [::b::moo] | $x $a::x $b::x | $::b::y 
-} -cleanup {
-    unset x
-    rename xset {}
-    namespace delete a b
-} -result {1::b | 0:: *::a *::b | {{1 ::b::moo} {2 xset}}}
-
-
-test unsupported-T.2 {tailcall in non-proc} -body {
-    namespace eval a [list tailcall set x 1]
-} -match glob -result *tailcall* -returnCodes error
-
-test unsupported-T.3 {tailcall falls off tebc} -body {
-    unset -nocomplain x
-    proc foo {} {tailcall set x 1}
-    list [catch foo msg] $msg [set x]
-} -cleanup {
-    rename foo {}
-    unset x
-} -result {0 1 1}
-
-test unsupported-T.4 {tailcall falls off tebc} -body {
-    set x 2
-    proc foo {} {tailcall set x 1}
-    foo
-    set x
-} -cleanup {
-    rename foo {}
-    unset x
-} -result 1
-
-test unsupported-T.5 {tailcall falls off tebc} -body {
-    set x 2
-    namespace eval bar {
-	variable x 3
-	proc foo {} {tailcall set x 1}
-    }
-    bar::foo
-    list $x $bar::x
-} -cleanup {
-    unset x
-    namespace delete bar
-} -result {1 3}
-
-test unsupported-T.6 {tailcall does remove callframes} -body {
-    proc foo {} {info level}
-    proc moo {} {tailcall foo}
-    proc boo {} {expr {[moo] - [info level]}}
-    boo
-} -cleanup {
-    rename foo {}
-    rename moo {}
-    rename boo {}
-} -result 1
-
-test unsupported-T.7 {tailcall does return} -setup {
-    namespace eval ::foo {
-	variable res {}
-	proc a {} {
-	    variable res
-	    append res a
-	    tailcall set x 1
-	    append res a
-	}
-	proc b {} {
-	    variable res
-	    append res b
-	    a
-	    append res b
-	}
-	proc c {} {
-	    variable res
-	    append res c
-	    b
-	    append res c
-	}
-    }
-} -body {
-    namespace eval ::foo c
-} -cleanup {
-    namespace delete ::foo
-} -result cbabc
-
-test unsupported-T.8 {tailcall tailcall} -setup {
-    namespace eval ::foo {
-	variable res {}
-	proc a {} {
-	    variable res
-	    append res a
-	    tailcall tailcall set x 1
-	    append res a
-	}
-	proc b {} {
-	    variable res
-	    append res b
-	    a
-	    append res b
-	}
-	proc c {} {
-	    variable res
-	    append res c
-	    b
-	    append res c
-	}
-    }
-} -body {
-    namespace eval ::foo c
-} -cleanup {
-    namespace delete ::foo
-} -match glob -result *tailcall* -returnCodes error
-
-test unsupported-T.9 {tailcall factorial} -setup {
-    proc fact {n {b 1}} {
-	if {$n == 1} {
-	    return $b
-	}
-	tailcall fact [expr {$n-1}] [expr {$n*$b}]
-    }
-} -body {
-    list [fact 1] [fact 5] [fact 10] [fact 15]
-} -cleanup {
-    rename fact {}
-} -result {1 120 3628800 1307674368000}
-
-test unsupported-T.10 {tailcall and eval} -constraints {knownBug atProcExit} -setup {
-    proc a {} {
-	eval [list tailcall lappend ::x 2]
-	set ::x 1
-    }
-} -body {
-    list [a] $::x
-} -cleanup {
-    unset -nocomplain ::x
-} -result {1 2}
-
-test unsupported-T.11 {tailcall and uplevel} -constraints {knownBug atProcExit} -setup {
-    proc a {} {
-	uplevel 1 [list tailcall set ::x 2]
-	set ::x 1
-    }
-} -body {
-    list [a] $::x
-} -cleanup {
-    unset -nocomplain ::x
-} -result {1 2}
-
-#
-#  Test both together
-#
-
-test unsupported-AT.1 {atProcExit and tailcall} -constraints {
-    atProcExit
-} -setup {
-    variable x x y y
-    proc a {} {
-	variable x 0 y 0
-	atProcExit lappend ::x 1
-	lappend x 2
-	atProcExit lappend ::x 3
-	tailcall lappend ::x 6
-	lappend y $x
-	lappend x 4
-	return 5
-    }
-} -body {
-    list [a] $x $y
-} -cleanup {
-    unset x y
-    rename a {}
-} -result {{0 2 3 1 6} {0 2 3 1 6} 0}
-
-#
-# Test coroutines
-#
-
-set lambda [list {{start 0} {stop 10}} {
-    # init
-    set i    $start
-    set imax $stop
-    yield
-    
-    while {$i < $imax} {
-	yield [expr {$i*$stop}]
-	incr i
-    }
-}]
-	
-
-test unsupported-C.1.1 {coroutine basic} -setup {
-    coroutine foo ::apply $lambda
-    set res {}
-} -body {
-    for {set k 1} {$k < 4} {incr k} {
-	lappend res [foo]
-    }
-    set res
-} -cleanup {
-    rename foo {}
-    unset res
-} -result {0 10 20}
-
-test unsupported-C.1.2 {coroutine basic} -setup {
-    coroutine foo ::apply $lambda 2 8
-    set res {}
-} -body {
-    for {set k 1} {$k < 4} {incr k} {
-	lappend res [foo]
-    }
-    set res
-} -cleanup {
-    rename foo {}
-    unset res
-} -result {16 24 32}
-
-test unsupported-C.1.3 {yield returns new arg} -setup {
-    set body {
-	# init
-	set i    $start
-	set imax $stop
-	yield
-	
-	while {$i < $imax} {
-	    set stop [yield [expr {$i*$stop}]]
-	    incr i
-	}
-    }
-    coroutine foo ::apply [list {{start 2} {stop 10}} $body] 
-    set res {}
-} -body {
-    for {set k 1} {$k < 4} {incr k} {
-	lappend res [foo $k]
-    }
-    set res
-} -cleanup {
-    rename foo {}
-    unset res
-} -result {20 6 12}
-
-test unsupported-C.1.4 {yield in nested proc} -setup {
-    proc moo {} {
-	upvar 1 i i stop stop
-	yield [expr {$i*$stop}]
-    }
-    set body {
-	# init
-	set i    $start
-	set imax $stop
-	yield
-
-	while {$i < $imax} {
-	    moo
-	    incr i
-	}
-    }
-    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
-    set res {}
-} -body {
-    for {set k 1} {$k < 4} {incr k} {
-	lappend res [foo $k]
-    }
-    set res
-} -cleanup {
-    rename foo {}
-    rename moo {}
-    unset body res
-} -result {0 10 20}
-
-test unsupported-C.1.5 {just yield} -body {
-    coroutine foo yield
-    list [foo] [catch foo msg] $msg
-} -cleanup {
-    unset msg
-} -result {{} 1 {invalid command name "foo"}}
-
-test unsupported-C.1.6 {just yield} -body {
-    coroutine foo [list yield]
-    list [foo] [catch foo msg] $msg
-} -cleanup {
-    unset msg
-} -result {{} 1 {invalid command name "foo"}}
-
-test unsupported-C.1.7 {yield in nested uplevel} -setup {
-    set body {
-	# init
-	set i    $start
-	set imax $stop
-	yield
-
-	while {$i < $imax} {
-	    uplevel 0 [list yield [expr {$i*$stop}]]
-	    incr i
-	}
-    }
-    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
-    set res {}
-} -body {
-    for {set k 1} {$k < 4} {incr k} {
-	lappend res [eval foo $k]
-    }
-    set res
-} -cleanup {
-    rename foo {}
-    unset body res
-} -result {0 10 20}
-
-test unsupported-C.1.8 {yield in nested uplevel} -setup {
-    set body {
-	# init
-	set i    $start
-	set imax $stop
-	yield
-	
-	while {$i < $imax} {
-	    uplevel 0 yield [expr {$i*$stop}]
-	    incr i
-	}
-    }
-    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
-    set res {}
-} -body {
-    for {set k 1} {$k < 4} {incr k} {
-	lappend res [eval foo $k]
-    }
-    set res
-} -cleanup {
-    rename foo {}
-    unset body res
-} -result {0 10 20}
-
-test unsupported-C.1.9 {yield in nested eval} -setup {
-    proc moo {} {
-	upvar 1 i i stop stop
-	yield [expr {$i*$stop}]
-    }
-    set body {
-	# init
-	set i    $start
-	set imax $stop
-	yield
-
-	while {$i < $imax} {
-	    eval moo
-	    incr i
-	}
-    }
-    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
-    set res {}
-} -body {
-    for {set k 1} {$k < 4} {incr k} {
-	lappend res [foo $k]
-    }
-    set res
-} -cleanup {
-    rename moo {}
-    unset body res
-} -result {0 10 20}
-
-test unsupported-C.1.10 {yield in nested eval} -setup {
-    set body {
-	# init
-	set i    $start
-	set imax $stop
-	yield
-	
-	while {$i < $imax} {
-	    eval yield [expr {$i*$stop}]
-	    incr i
-	}
-    }
-    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
-    set res {}
-} -body {
-    for {set k 1} {$k < 4} {incr k} {
-	lappend res [eval foo $k]
-    }
-    set res
-} -cleanup {
-    unset body res
-} -result {0 10 20}
-
-test unsupported-C.1.11 {yield outside coroutine} -setup {
-    proc moo {} {
-	upvar 1 i i stop stop
-	yield [expr {$i*$stop}]
-    }
-} -body {
-    variable i 5 stop 6
-    moo
-} -cleanup {
-    rename moo {}
-    unset i stop
-} -returnCodes error -result {yield can only be called in a coroutine}
-
-test unsupported-C.1.12 {proc as coroutine} -setup {
-    set body {
-	# init
-	set i    $start
-	set imax $stop
-	yield
-	
-	while {$i < $imax} {
-	    uplevel 0 [list yield [expr {$i*$stop}]]
-	    incr i
-	}
-    }
-    proc moo {{start 0} {stop 10}} $body
-    coroutine foo moo 2 8
-} -body {
-    list [foo] [foo]
-} -cleanup {
-    unset body
-    rename moo {}
-    rename foo {}
-} -result {16 24}
-
-test unsupported-C.2.1 {self deletion on return} -body {
-    coroutine foo set x 3
-    foo
-} -returnCodes error -result {invalid command name "foo"}
-
-test unsupported-C.2.2 {self deletion on return} -body {
-    coroutine foo ::apply [list {} {yield; yield 1; return 2}]
-    list [foo] [foo] [catch foo msg] $msg
-} -result {1 2 1 {invalid command name "foo"}}
-
-test unsupported-C.2.3 {self deletion on error return} -body {
-    coroutine foo ::apply [list {} {yield;yield 1; error ouch!}]
-    list [foo] [catch foo msg] $msg [catch foo msg] $msg
-} -result {1 1 ouch! 1 {invalid command name "foo"}}
-
-test unsupported-C.2.4 {self deletion on other return} -body {
-    coroutine foo ::apply [list {} {yield;yield 1; return -code 100 ouch!}]
-    list [foo] [catch foo msg] $msg [catch foo msg] $msg
-} -result {1 100 ouch! 1 {invalid command name "foo"}}
-
-test unsupported-C.2.5 {deletion of suspended coroutine} -body {
-    coroutine foo ::apply [list {} {yield; yield 1; return 2}]
-    list [foo] [rename foo {}] [catch foo msg] $msg
-} -result {1 {} 1 {invalid command name "foo"}}
-
-test unsupported-C.2.6 {deletion of running coroutine} -body {
-    coroutine foo ::apply [list {} {yield; rename foo {}; yield 1; return 2}]
-    list [foo] [catch foo msg] $msg
-} -result {1 1 {invalid command name "foo"}}
-
-test unsupported-C.3.1 {info level computation} -setup {
-    proc a {} {while 1 {yield [info level]}}
-    proc b {} foo
-} -body {
-    # note that coroutines execute in uplevel #0
-    set l0 [coroutine foo a]
-    set l1 [foo]
-    set l2 [b]
-    list $l0 $l1 $l2
-} -cleanup {
-    rename a {}
-    rename b {}
-} -result {1 1 1}
-
-test unsupported-C.3.2 {info frame computation} -setup {
-    proc a {} {while 1 {yield [info frame]}}
-    proc b {} foo
-} -body {
-    set l0 [coroutine foo a]
-    set l1 [foo]
-    set l2 [b]
-    expr {$l2 - $l1}
-} -cleanup {
-    rename a {}
-    rename b {}
-} -result 1
-
-test unsupported-C.3.3 {info coroutine} -setup {
-    proc a {} {info coroutine}
-    proc b {} a
-} -body {
-    b
-} -cleanup {
-    rename a {}
-    rename b {}
-} -result {}
-
-test unsupported-C.3.4 {info coroutine} -setup {
-    proc a {} {info coroutine}
-    proc b {} a
-} -body {
-    coroutine foo b
-} -cleanup {
-    rename a {}
-    rename b {}
-} -result ::foo
-
-test unsupported-C.3.5 {info coroutine} -setup {
-    proc a {} {info coroutine}
-    proc b {} {rename [info coroutine] {}; a}
-} -body {
-    coroutine foo b
-} -cleanup {
-    rename a {}
-    rename b {}
-} -result {}
-
-
-test unsupported-C.4.1 {bug #2093188} -setup {
-    proc foo {} {
-	set v 1
-	trace add variable v {write unset} bar
-	yield
-	set v 2
-	yield
-	set v 3
-    }
-    proc bar args {lappend ::res $args}
-    coroutine a foo
-} -body {
-    list [a] [a] $::res
-} -cleanup {
-    rename foo {}
-    rename bar {}
-    unset ::res
-} -result {{} 3 {{v {} write} {v {} write} {v {} unset}}}
-
-test unsupported-C.4.2 {bug #2093188} -setup {
-    proc foo {} {
-	set v 1
-	trace add variable v {read unset} bar
-	yield
-	set v 2
-	set v
-	yield
-	set v 3
-    }
-    proc bar args {lappend ::res $args}
-    coroutine a foo
-} -body {
-    list [a] [a] $::res
-} -cleanup {
-    rename foo {}
-    rename bar {}
-    unset ::res
-} -result {{} 3 {{v {} read} {v {} unset}}}
-
-test unsupported-C.4.3 {bug #2093947} -setup {
-    proc foo {} {
-	set v 1
-	trace add variable v {write unset} bar
-	yield
-	set v 2
-	yield
-	set v 3
-    }
-    proc bar args {lappend ::res $args}
-} -body {
-    coroutine a foo
-    a
-    a
-    coroutine a foo
-    a
-    rename a {}
-    set ::res
-} -cleanup {
-    rename foo {}
-    rename bar {}
-    unset ::res
-} -result {{v {} write} {v {} write} {v {} unset} {v {} write} {v {} unset}}
-
-test unsupported-C.5.1 {right numLevels on coro return} -constraints {testnrelevels} \
--setup {
-    proc nestedYield {{val {}}} {
-	yield $val
-    }
-    proc getNumLevel {} {
-	# remove the level for this proc's call
-	expr {[lindex [testnrelevels] 1] - 1}
-    }
-    proc relativeLevel base {
-	# remove the level for this proc's call	
-	expr {[getNumLevel] - $base - 1}
-    }
-    proc foo {} {
-	while 1 {
-	    nestedYield
-	}
-    }
-    set res {}
-} -body {
-    set base [getNumLevel]
-    lappend res [relativeLevel $base]
-    eval {coroutine a foo}
-
-    # back to base level
-    lappend res [relativeLevel $base]
-    a
-    lappend res [relativeLevel $base]
-    eval a
-    lappend res [relativeLevel $base]
-    eval {eval a}
-    lappend res [relativeLevel $base]
-    rename a {}
-    lappend res [relativeLevel $base]
-    set res
-} -cleanup {
-    rename foo {}
-    rename nestedYield {}
-    rename getNumLevel {}
-    rename relativeLevel {}
-    unset res
-} -result {0 0 0 0 0 0}
-
-test unsupported-C.5.2 {right numLevels within coro} -constraints {testnrelevels} \
--setup {
-    proc nestedYield {{val {}}} {
-	yield $val
-    }
-    proc getNumLevel {} {
-	# remove the level for this proc's call
-	expr {[lindex [testnrelevels] 1] - 1}
-    }
-    proc relativeLevel base {
-	# remove the level for this proc's call	
-	expr {[getNumLevel] - $base - 1}
-    }
-    proc foo base {
-	while 1 {
-	    set base [nestedYield [relativeLevel $base]]
-	}
-    }
-    set res {}
-} -body {
-    lappend res [eval {coroutine a foo [getNumLevel]}]
-    lappend res [a [getNumLevel]]
-    lappend res [eval {a [getNumLevel]}]
-    lappend res [eval {eval {a [getNumLevel]}}]
-    set base [lindex $res 0]
-    foreach x $res[set res {}] {
-	lappend res [expr {$x-$base}]
-    }
-    set res
-} -cleanup {
-    rename a {}
-    rename foo {}
-    rename nestedYield {}
-    rename getNumLevel {}
-    rename relativeLevel {}
-    unset res
-} -result {0 0 0 0}
-
-
-
-# cleanup
-::tcltest::cleanupTests
-
-
-unset -nocomplain lambda
-
-if {[testConstraint atProcExit]} {
-    namespace forget tcl::unsupported::atProcExit
-}
-
-if {[testConstraint testnrelevels]} {
-    namespace forget testnre::*
-    namespace delete testnre
-}
-
-return