Created branch dgp-refactor-merge-syntheticdgp_refactor_mergedgp_refactor_merge_synthetic

1 files changed, 914 insertions, 0 deletions

diff --git a/tests/unsupported.test b/tests/unsupported.test
new file mode 100644
index 0000000..0c706b8
--- /dev/null
+++ b/tests/unsupported.test
@@ -0,0 +1,914 @@
+# 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