Implementation of TIP #257. Incomplete due to missing Win build support.

3 files changed, 1782 insertions, 12 deletions

diff --git a/tests/info.test b/tests/info.test
index a6fa48d..b6b708c 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: info.test,v 1.47 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: info.test,v 1.48 2008/05/31 11:42:20 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -675,16 +675,16 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
 } -result {wrong # args: should be "info subcommand ?argument ...?"}
 test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
     info gorp
-} -result {unknown or ambiguous subcommand "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
     info c
-} -result {unknown or ambiguous subcommand "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
     info l
-} -result {unknown or ambiguous subcommand "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
     info s
-} -result {unknown or ambiguous subcommand "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 
 ##
 # ### ### ### ######### ######### #########
diff --git a/tests/interp.test b/tests/interp.test
index 76d642b..2bbd7a3 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: interp.test,v 1.54 2008/03/02 19:12:41 msofer Exp $
+# RCS: @(#) $Id: interp.test,v 1.55 2008/05/31 11:42:20 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -2360,22 +2360,23 @@ test interp-28.1 {getting fooled by slave's namespace ?} {
     set r
 } {}
 
-test interp-28.2 {master's nsName cache should not cross} {
+test interp-28.2 {master's nsName cache should not cross} -setup {
     set i [interp create]
-    set res [$i eval {
+} -body {
+    $i eval {
 	set x {namespace children ::}
 	set y [list namespace children ::]
-	namespace delete [{*}$y]
+	namespace delete {*}[{*}$y]
 	set j [interp create]
 	$j eval {namespace delete {*}[namespace children ::]}
 	namespace eval foo {}
 	set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]]
 	interp delete $j
 	set res
-    }]
+    }
+} -cleanup {
     interp delete $i
-    set res
-} {::foo ::foo {} {}}
+} -result {::foo ::foo {} {}}
 
 # Part 29: recursion limit
 #  29.1.*  Argument checking
diff --git a/tests/oo.test b/tests/oo.test
new file mode 100644
index 0000000..087e786
--- /dev/null
+++ b/tests/oo.test
@@ -0,0 +1,1769 @@
+# This file contains a collection of tests for Tcl's built-in object system.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 2006-2008 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: oo.test,v 1.4 2008/05/31 11:42:20 dkf Exp $
+
+package require TclOO 0.4 ;# Must match value in configure.in
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
+
+proc initInterpreter name {
+    $name eval [list package ifneeded TclOO [package provide TclOO] \
+		    [package ifneeded TclOO [package provide TclOO]]]
+}
+
+test oo-0.1 {basic test of OO's ability to clean up its initial state} {
+    interp create t
+    initInterpreter t
+    t eval {
+	package require TclOO
+    }
+    interp delete t
+} {}
+test oo-0.2 {basic test of OO's ability to clean up its initial state} {
+    set i [interp create]
+    initInterpreter $i
+    interp eval $i {
+	package require TclOO
+	namespace delete ::
+    }
+} {}
+test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
+    leaktest {
+	[oo::object new] destroy
+    }
+} -constraints memory -result 0
+test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
+    leaktest {
+	oo::class create foo
+	foo new
+	foo destroy
+    }
+} -constraints memory -result 0
+
+test oo-1.1 {basic test of OO functionality: no classes} {
+    set result {}
+    lappend result [oo::object create foo]
+    lappend result [oo::objdefine foo {
+	method bar args {
+	    global result
+	    lappend result {*}$args
+	    return [llength $args]
+	}
+    }]
+    lappend result [foo bar a b c]
+    lappend result [foo destroy] [info commands foo]
+} {::foo {} a b c 3 {} {}}
+test oo-1.2 {basic test of OO functionality: no classes} -body {
+    oo::define oo::object method missingArgs
+} -returnCodes 1 -result "wrong # args: should be \"oo::define oo::object method name args body\""
+test oo-1.3 {basic test of OO functionality: no classes} {
+    catch {oo::define oo::object method missingArgs}
+    set errorInfo
+} "wrong # args: should be \"oo::define oo::object method name args body\"
+    while executing
+\"oo::define oo::object method missingArgs\""
+test oo-1.4 {basic test of OO functionality} -body {
+    oo::object create {}
+} -returnCodes 1 -result {object name must not be empty}
+test oo-1.5 {basic test of OO functionality} -body {
+    oo::object doesnotexist
+} -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}
+test oo-1.6 {basic test of OO functionality} -setup {
+    oo::object create aninstance
+} -body {
+    oo::objdefine aninstance unexport destroy
+    aninstance doesnotexist
+} -cleanup {
+    rename aninstance {}
+} -returnCodes 1 -result {object "::aninstance" has no visible methods}
+test oo-1.7 {basic test of OO functionality} -setup {
+    oo::object create aninstance
+} -body {
+    oo::objdefine aninstance {
+	# Do not do this in real code! Ever! This is *not* supported!
+	::oo::define::method ha ha ha
+    }
+} -returnCodes error -cleanup {
+    aninstance destroy
+} -result {attempt to misuse API}
+test oo-1.8 {basic test of OO functionality} -setup {
+    oo::object create obj
+    set result {}
+} -cleanup {
+    obj destroy
+} -body {
+    oo::objdefine obj method foo {} {return bar}
+    lappend result [obj foo]
+    oo::objdefine obj method foo {} {}
+    lappend result [obj foo]
+} -result {bar {}}
+test oo-1.9 {basic test of OO functionality} -setup {
+    oo::object create a
+    oo::object create b
+} -cleanup {
+    catch {a destroy}
+    b destroy
+} -body {
+    oo::objdefine a method foo {} { return A }
+    oo::objdefine b method foo {} { return B }
+    apply {{} {
+	set m foo
+	return [a $m],[a destroy],[b $m]
+    }}
+} -result A,,B
+test oo-1.10 {basic test of OO functionality} -body {
+    namespace eval foo {
+	namespace eval bar {
+	    oo::object create o
+	    namespace export o
+	}
+	namespace import bar::o
+    }
+    list [info object isa object foo::bar::o] [info object isa object foo::o]
+} -cleanup {
+    namespace delete foo
+} -result {1 1}
+test oo-1.11 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c super oo::class
+    info class super c
+} -result ::oo::class
+test oo-1.12 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c {super oo::class}
+    info class super c
+} -result ::oo::class
+test oo-1.13 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c self {forw a b}
+    info object forw c a
+} -result b
+test oo-1.14 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c self forw a b
+    info object forw c a
+} -result b
+test oo-1.15 {basic test of OO functionality: abbreviating} -setup {
+    oo::object create o
+} -cleanup {
+    o destroy
+} -body {
+    oo::objdefine o {forw a b}
+    info object forw o a
+} -result b
+test oo-1.16 {basic test of OO functionality: abbreviating} -setup {
+    oo::object create o
+} -cleanup {
+    o destroy
+} -body {
+    oo::objdefine o forw a b
+    info object forw o a
+} -result b
+
+test oo-2.1 {basic test of OO functionality: constructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as
+    # we're modifying the root object class's constructor
+    interp create subinterp
+    initInterpreter subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object constructor {} {
+	    lappend ::result [info level 0]
+	}
+	lappend result 1
+	lappend result 2 [oo::object create foo]
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 {oo::object create foo} 2 ::foo}
+test oo-2.2 {basic test of OO functionality: constructor} {
+    oo::class create testClass {
+	constructor {} {
+	    global result
+	    lappend result "[self]->construct"
+	}
+	method bar {} {
+	    global result
+	    lappend result "[self]->bar"
+	}
+    }
+    set result {}
+    [testClass create foo] bar
+    testClass destroy
+    return $result
+} {::foo->construct ::foo->bar}
+
+test oo-3.1 {basic test of OO functionality: destructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as
+    # we're modifying the root object class's constructor
+    interp create subinterp
+    initInterpreter subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object destructor {
+	    lappend ::result died
+	}
+	lappend result 1 [oo::object create foo]
+	lappend result 2 [rename foo {}]
+	oo::define oo::object destructor {}
+	return $result
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 ::foo died 2 {}}
+test oo-3.2 {basic test of OO functionality: destructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as
+    # we're modifying the root object class's constructor
+    interp create subinterp
+    initInterpreter subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object destructor {
+	    lappend ::result died
+	}
+	lappend result 1 [oo::object create foo]
+	lappend result 2 [rename foo {}]
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 ::foo died 2 {}}
+
+test oo-4.1 {basic test of OO functionality: export} {
+    set o [oo::object new]
+    set result {}
+    oo::objdefine $o method Foo {} {lappend ::result Foo; return}
+    lappend result [catch {$o Foo} msg] $msg
+    oo::objdefine $o export Foo
+    lappend result [$o Foo] [$o destroy]
+} {1 {unknown method "Foo": must be destroy} Foo {} {}}
+test oo-4.2 {basic test of OO functionality: unexport} {
+    set o [oo::object new]
+    set result {}
+    oo::objdefine $o method foo {} {lappend ::result foo; return}
+    lappend result [$o foo]
+    oo::objdefine $o unexport foo
+    lappend result [catch {$o foo} msg] $msg [$o destroy]
+} {foo {} 1 {unknown method "foo": must be destroy} {}}
+test oo-4.3 {exporting and error messages, Bug 1824958} -setup {
+    oo::class create testClass
+} -cleanup {
+    testClass destroy
+} -body {
+    oo::define testClass self export Bad
+    testClass Bad
+} -returnCodes 1 -result {unknown method "Bad": must be create, destroy or new}
+test oo-4.4 {exporting a class method from an object} -setup {
+    oo::class create testClass
+    testClass create testObject
+} -cleanup {
+    testClass destroy
+} -body {
+    oo::define testClass method Good {} { return ok }
+    oo::objdefine testObject export Good
+    testObject Good
+} -result ok
+
+test oo-5.1 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::objdefine oo::object method foo {} { return "in object" }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.2 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object self method foo {} { return "in object" }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.3 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::objdefine oo::object {
+	method foo {} { return "in object" }
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.4 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object {
+	self method foo {} { return "in object" }
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.5 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object {
+	self {
+	    method foo {} { return "in object" }
+	}
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+
+test oo-6.1 {OO: forward} {
+    oo::object create foo
+    oo::objdefine foo {
+	forward a lappend
+	forward b lappend result
+    }
+    set result {}
+    foo a result 1
+    foo b 2
+    foo destroy
+    return $result
+} {1 2}
+
+test oo-7.1 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {lappend ::result $x}
+    oo::define subClass superclass superClass
+    set result [list [catch {subClass doit bad} msg] $msg]
+    instance doit ok
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {1 {unknown method "doit": must be create, destroy or new} ok}
+test oo-7.2 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {
+	lappend ::result |$x|
+    }
+    oo::define subClass superclass superClass
+    oo::objdefine instance method doit x {
+	lappend ::result =$x=
+	next [incr x]
+    }
+    set result {}
+    instance doit 1
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {=1= |2|}
+test oo-7.3 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {
+	lappend ::result |$x|
+    }
+    oo::define subClass {
+	superclass superClass
+	method doit x {lappend ::result -$x-; next [incr x]}
+    }
+    oo::objdefine instance method doit x {
+	lappend ::result =$x=;
+	next [incr x]
+    }
+    set result {}
+    instance doit 1
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {=1= -2- |3|}
+test oo-7.4 {OO: inheritance from oo::class} -body {
+    oo::class create meta {
+	superclass oo::class
+	self {
+	    unexport create new
+	    method make {x {definitions {}}} {
+		if {![string match ::* $x]} {
+		    set ns [uplevel 1 {::namespace current}]
+		    set x ${ns}::$x
+		}
+		set o [my create $x]
+		lappend ::result "made $o"
+		oo::define $o $definitions
+		return $o
+	    }
+	}
+    }
+    set result [list [catch {meta create foo} msg] $msg]
+    lappend result [meta make classinstance {
+	lappend ::result "in definition script in [namespace current]"
+    }]
+    lappend result [classinstance create instance]
+} -cleanup {
+    catch {classinstance destroy}
+    catch {meta destroy}
+} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
+test oo-7.5 {OO: inheritance from oo::class in the secondary chain} -body {
+    oo::class create other
+    oo::class create meta {
+	superclass other oo::class
+	self {
+	    unexport create new
+	    method make {x {definitions {}}} {
+		if {![string match ::* $x]} {
+		    set ns [uplevel 1 {::namespace current}]
+		    set x ${ns}::$x
+		}
+		set o [my create $x]
+		lappend ::result "made $o"
+		oo::define $o $definitions
+		return $o
+	    }
+	}
+    }
+    set result [list [catch {meta create foo} msg] $msg]
+    lappend result [meta make classinstance {
+	lappend ::result "in definition script in [namespace current]"
+    }]
+    lappend result [classinstance create instance]
+} -cleanup {
+    catch {classinstance destroy}
+    catch {meta destroy}
+    catch {other destroy}
+} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
+test oo-7.6 {OO: inheritance 101 - overridden methods should be oblivious} -setup {
+    oo::class create Aclass
+    oo::class create Bclass
+    Bclass create Binstance
+} -body {
+    oo::define Aclass {
+	method incr {var step} {
+	    upvar 1 $var v
+	    ::incr v $step
+	}
+    }
+    oo::define Bclass {
+	superclass Aclass
+	method incr {var {step 1}} {
+	    global result
+	    lappend result $var $step
+	    set r [next $var $step]
+	    lappend result returning:$r
+	    return $r
+	}
+    }
+    set result {}
+    set x 10
+    lappend result x=$x
+    lappend result [Binstance incr x]
+    lappend result x=$x
+} -result {x=10 x 1 returning:11 11 x=11} -cleanup {
+    Aclass destroy
+}
+test oo-7.7 {OO: inheritance and errorInfo} -setup {
+    oo::class create A
+    oo::class create B
+    B create c
+} -body {
+    oo::define A method foo {} {error foo!}
+    oo::define B {
+	superclass A
+	method foo {} { next }
+    }
+    oo::objdefine c method foo {} { next }
+    catch {c ?} msg
+    set result [list $msg]
+    catch {c foo} msg
+    lappend result $msg $errorInfo
+} -cleanup {
+    A destroy
+} -result {{unknown method "?": must be destroy or foo} foo! {foo!
+    while executing
+"error foo!"
+    (class "::A" method "foo" line 1)
+    invoked from within
+"next "
+    (class "::B" method "foo" line 1)
+    invoked from within
+"next "
+    (object "::c" method "foo" line 1)
+    invoked from within
+"c foo"}}
+test oo-7.8 {OO: next at the end of the method chain} {
+    oo::class create foo {
+	method bar {} {lappend ::result [next] foo}
+    }
+    oo::class create foo2 {
+	superclass foo
+	method bar {} {lappend ::result [next] foo2}
+    }
+    set o [foo2 new]
+    set ::result ""
+    catch {$o bar}
+    foo destroy
+    return $result
+} {{} foo {{} foo} foo2}
+
+test oo-8.1 {OO: global must work in methods} {
+    oo::object create foo
+    oo::objdefine foo method bar x {global result; lappend result $x}
+    set result {}
+    foo bar this
+    foo bar is
+    lappend result a
+    foo bar test
+    foo destroy
+    return $result
+} {this is a test}
+
+test oo-9.1 {OO: multiple inheritance} -setup {
+    oo::class create A
+    oo::class create B
+    oo::class create C
+    oo::class create D
+    D create foo
+} -body {
+    oo::define A method test {} {lappend ::result A; return ok}
+    oo::define B {
+	superclass A
+	method test {} {lappend ::result B; next}
+    }
+    oo::define C {
+	superclass A
+	method test {} {lappend ::result C; next}
+    }
+    oo::define D {
+	superclass B C
+	method test {} {lappend ::result D; next}
+    }
+    set result {}
+    lappend result [foo test]
+} -cleanup {
+    D destroy
+    C destroy
+    B destroy
+    A destroy
+} -result {D B C A ok}
+test oo-9.2 {OO: multiple inheritance} -setup {
+    oo::class create A
+    oo::class create B
+    oo::class create C
+    oo::class create D
+    D create foo
+} -body {
+    oo::define A method test {} {lappend ::result A; return ok}
+    oo::define B {
+	superclass A
+	method test {} {lappend ::result B; next}
+    }
+    oo::define C {
+	superclass A
+	method test {} {lappend ::result C; next}
+    }
+    oo::define D {
+	superclass B C
+	method test {} {lappend ::result D; next}
+    }
+    set result {}
+    lappend result [foo test]
+} -cleanup {
+    A destroy
+} -result {D B C A ok}
+
+test oo-10.1 {OO: recursive invoke and modify} -setup {
+    [oo::class create C] create O
+} -cleanup {
+    C destroy
+} -body {
+    oo::define C method foo x {
+	lappend ::result $x
+	if {$x} {
+	    [self object] foo [incr x -1]
+	}
+    }
+    oo::objdefine O method foo x {
+	lappend ::result -$x-
+	if {$x == 1} {
+	    oo::objdefine O deletemethod foo
+	}
+	next $x
+    }
+    set result {}
+    O foo 2
+    return $result
+} -result {-2- 2 -1- 1 0}
+test oo-10.2 {OO: recursive invoke and modify} -setup {
+    oo::object create O
+} -cleanup {
+    O destroy
+} -body {
+    oo::objdefine O method foo {} {
+	oo::objdefine [self] method foo {} {
+	    error "not called"
+	}
+	return [format %s%s call ed]
+    }
+    O foo
+} -result called
+test oo-10.3 {OO: invoke and modify} -setup {
+    oo::class create A {
+	method a {} {return A.a}
+	method b {} {return A.b}
+	method c {} {return A.c}
+    }
+    oo::class create B {
+	superclass A
+	method a {} {return [next],B.a}
+	method b {} {return [next],B.b}
+	method c {} {return [next],B.c}
+    }
+    B create C
+    set result {}
+} -cleanup {
+    A destroy
+} -body {
+    lappend result [C a] [C b] [C c] -
+    oo::define B deletemethod b
+    lappend result [C a] [C b] [C c] -
+    oo::define B renamemethod a b
+    lappend result [C a] [C b] [C c] -
+    oo::define B deletemethod b c
+    lappend result [C a] [C b] [C c]
+} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
+
+test oo-11.1 {OO: cleanup} {
+    oo::object create foo
+    set result [list [catch {oo::object create foo} msg] $msg]
+    lappend result [foo destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.2 {OO: cleanup} {
+    oo::class create bar
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.3 {OO: cleanup} {
+    oo::class create bar0
+    oo::class create bar
+    oo::define bar superclass bar0
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar0 destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.4 {OO: cleanup} {
+    oo::class create bar0
+    oo::class create bar1
+    oo::define bar1 superclass bar0
+    oo::class create bar2
+    oo::define bar2 {
+	superclass bar0
+	destructor {lappend ::result destroyed}
+    }
+    oo::class create bar
+    oo::define bar superclass bar1 bar2
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \
+	[oo::object create bar2] [bar2 destroy]
+} {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}}
+
+test oo-12.1 {OO: filters} {
+    oo::class create Aclass
+    Aclass create Aobject
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+    }
+    oo::objdefine Aobject filter logFilter
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5]
+    Aclass destroy
+    return $result
+} {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345}
+test oo-12.2 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+    }
+    oo::objdefine Aobject filter logFilter
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
+} -cleanup {
+    Aclass destroy
+} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
+test oo-12.3 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+	filter logFilter
+    }
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
+} -cleanup {
+    Aclass destroy
+} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
+test oo-12.4 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.5 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.6 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return [my Bar3] }
+	method Bar3 {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.7 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method outerfoo {} { return [my InnerFoo] }
+	method InnerFoo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return [my Bar3] }
+	method Bar3 {} { return 1 }
+	method boo {} {
+	    lappend ::log [self target]
+	    if {[my Bar]} { next } else { error forbidden }
+	}
+	filter boo
+    }
+    set log {}
+    list [Aobject outerfoo] $log
+} -cleanup {
+    Aclass destroy
+} -result {foo {{::Aclass outerfoo} {::Aclass InnerFoo}}}
+
+test oo-13.1 {OO: changing an object's class} {
+    oo::class create Aclass
+    oo::define Aclass {method bar {} {lappend ::result "in A [self object]"}}
+    oo::class create Bclass
+    oo::define Bclass {method bar {} {lappend ::result "in B [self object]"}}
+    set result [Aclass create foo]
+    foo bar
+    oo::objdefine foo class Bclass
+    foo bar
+    Aclass destroy
+    lappend result [info command foo]
+    Bclass destroy
+    return $result
+} {::foo {in A ::foo} {in B ::foo} foo}
+test oo-13.2 {OO: changing an object's class} -body {
+    oo::object create foo
+    oo::objdefine foo class oo::class
+} -cleanup {
+    foo destroy
+} -returnCodes 1 -result {may not change a non-class object into a class object}
+test oo-13.3 {OO: changing an object's class} -body {
+    oo::class create foo
+    oo::objdefine foo class oo::object
+} -cleanup {
+    foo destroy
+} -returnCodes 1 -result {may not change a class object into a non-class object}
+# todo: changing a class subtype (metaclass) to another class subtype
+
+test oo-14.1 {OO: mixins} {
+    oo::class create Aclass
+    oo::define Aclass method bar {} {lappend ::result "[self object] in bar"}
+    oo::class create Bclass
+    oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}
+    oo::objdefine [Aclass create fooTest] mixin Bclass
+    oo::objdefine [Aclass create fooTest2] mixin Bclass
+    set result [list [catch {fooTest ?} msg] $msg]
+    fooTest bar
+    fooTest boo
+    fooTest2 bar
+    fooTest2 boo
+    oo::objdefine fooTest2 mixin
+    lappend result [Bclass destroy] [info command fooTest*] [Aclass destroy]
+} {1 {unknown method "?": must be bar, boo or destroy} {::fooTest in bar} {::fooTest in boo} {::fooTest2 in bar} {::fooTest2 in boo} {} fooTest2 {}}
+test oo-14.2 {OO: mixins} {
+    oo::class create Aclass {
+	method bar {} {return "[self object] in bar"}
+    }
+    oo::class create Bclass {
+	method boo {} {return "[self object] in boo"}
+    }
+    oo::define Aclass mixin Bclass
+    Aclass create fooTest
+    set result [list [catch {fooTest ?} msg] $msg]
+    lappend result [catch {fooTest bar} msg] $msg
+    lappend result [catch {fooTest boo} msg] $msg
+    lappend result [Bclass destroy] [info commands Aclass]
+} {1 {unknown method "?": must be bar, boo or destroy} 0 {::fooTest in bar} 0 {::fooTest in boo} {} {}}
+test oo-14.3 {OO and mixins and filters - advanced case} -setup {
+    oo::class create mix
+    oo::class create c {
+	mixin mix
+    }
+    c create i
+} -body {
+    oo::define mix {
+	method foo {} {return >>[next]<<}
+	filter foo
+    }
+    oo::objdefine i method bar {} {return foobar}
+    i bar
+} -cleanup {
+    mix destroy
+    if {[info object isa object i]} {
+	error "mixin deletion failed to destroy dependent instance"
+    }
+} -result >>foobar<<
+test oo-14.4 {OO: mixin error case} -setup {
+    oo::class create c
+} -body {
+    oo::define c mixin c
+} -returnCodes error -cleanup {
+    c destroy
+} -result {may not mix a class into itself}
+test oo-14.5 {OO and mixins and filters - advanced case} -setup {
+    oo::class create mix
+    oo::class create c {
+	mixin mix
+    }
+    c create i
+} -body {
+    oo::define mix {
+	method foo {} {return >>[next]<<}
+	filter foo
+    }
+    oo::objdefine i method bar {} {return foobar}
+    i bar
+} -cleanup {
+    c destroy
+    mix destroy
+} -result >>foobar<<
+test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create A {
+	superclass master
+	method egg {} {
+	    return chicken
+	}
+    }
+    oo::class create B {
+	superclass master
+	mixin A
+	method bar {} {
+	    # mixin from A
+	    my egg
+	}
+    }
+    oo::class create C {
+	superclass master
+	mixin B
+	method foo {} {
+	    # mixin from B
+	    my bar
+	}
+    }
+    [C new] foo
+} -result chicken
+test oo-14.7 {OO and filters from mixins of mixins} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create A {
+	superclass master
+	method egg {} {
+	    return chicken
+	}
+	filter f
+	method f args {
+	    set m [lindex [self target] 1]
+	    return "($m) [next {*}$args] ($m)"
+	}
+    }
+    oo::class create B {
+	superclass master
+	mixin A
+	filter f
+	method bar {} {
+	    # mixin from A
+	    my egg
+	}
+    }
+    oo::class create C {
+	superclass master
+	mixin B
+	filter f
+	method foo {} {
+	    # mixin from B
+	    my bar
+	}
+    }
+    [C new] foo
+} -result {(foo) (bar) (egg) chicken (egg) (bar) (foo)}
+
+test oo-15.1 {OO: object cloning} {
+    oo::class create Aclass
+    oo::define Aclass method test {} {lappend ::result [self object]->test}
+    Aclass create Ainstance
+    set result {}
+    Ainstance test
+    oo::copy Ainstance Binstance
+    Binstance test
+    Ainstance test
+    Ainstance destroy
+    namespace eval foo {
+	oo::copy Binstance Cinstance
+	Cinstance test
+    }
+    Aclass destroy
+    namespace delete foo
+    lappend result [info commands Binstance]
+} {::Ainstance->test ::Binstance->test ::Ainstance->test ::foo::Cinstance->test {}}
+test oo-15.2 {OO: object cloning} {
+    oo::object create foo
+    oo::objdefine foo {
+	method m x {lappend ::result [self object] >$x<}
+	forward f ::lappend ::result fwd
+    }
+    set result {}
+    foo m 1
+    foo f 2
+    lappend result [oo::copy foo bar]
+    foo m 3
+    foo f 4
+    bar m 5
+    bar f 6
+    lappend result [foo destroy]
+    bar m 7
+    bar f 8
+    lappend result [bar destroy]
+} {::foo >1< fwd 2 ::bar ::foo >3< fwd 4 ::bar >5< fwd 6 {} ::bar >7< fwd 8 {}}
+catch {foo destroy}
+catch {bar destroy}
+test oo-15.3 {OO: class cloning} {
+    oo::class create foo {
+	method testme {} {lappend ::result [self class]->[self object]}
+    }
+    set result {}
+    foo create baseline
+    baseline testme
+    oo::copy foo bar
+    baseline testme
+    bar create tester
+    tester testme
+    foo destroy
+    tester testme
+    bar destroy
+    return $result
+} {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester}
+
+test oo-16.1 {OO: object introspection} -body {
+    info object
+} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?argument ...?\""
+test oo-16.2 {OO: object introspection} -body {
+    info object class NOTANOBJECT
+} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
+test oo-16.3 {OO: object introspection} -body {
+    info object gorp oo::object
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be class, definition, filters, forward, isa, methods, mixins, or vars}
+test oo-16.4 {OO: object introspection} -setup {
+    oo::class create meta { superclass oo::class }
+    [meta create instance1] create instance2
+} -body {
+    list [list [info object class oo::object] \
+	      [info object class oo::class] \
+	      [info object class meta] \
+	      [info object class instance1] \
+	      [info object class instance2]] \
+	[list [info object isa class oo::object] \
+	     [info object isa class meta] \
+	     [info object isa class instance1] \
+	     [info object isa class instance2]] \
+	[list [info object isa metaclass oo::object] \
+	     [info object isa metaclass oo::class] \
+	     [info object isa metaclass meta] \
+	     [info object isa metaclass instance1] \
+	     [info object isa metaclass instance2]] \
+	[list [info object isa object oo::object] \
+	     [info object isa object oo::class] \
+	     [info object isa object meta] \
+	     [info object isa object instance1] \
+	     [info object isa object instance2] \
+	     [info object isa object oo::define] \
+	     [info object isa object NOTANOBJECT]]
+} -cleanup {
+    meta destroy
+} -result {{::oo::class ::oo::class ::oo::class ::meta ::instance1} {1 1 1 0} {0 1 1 0 0} {1 1 1 1 1 0 0}}
+test oo-16.5 {OO: object introspection} {info object methods oo::object} {}
+test oo-16.6 {OO: object introspection} {
+    oo::object create foo
+    set result [list [info object methods foo]]
+    oo::objdefine foo method bar {} {...}
+    lappend result [info object methods foo] [foo destroy]
+} {{} bar {}}
+test oo-16.7 {OO: object introspection} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo method bar {a {b c} args} {the body}
+    set result [info object methods foo]
+    lappend result [info object definition foo bar]
+} -cleanup {
+    foo destroy
+} -result {bar {{a {b c} args} {the body}}}
+test oo-16.8 {OO: object introspection} {
+    oo::object create foo
+    oo::class create bar
+    oo::objdefine foo mixin bar
+    set result [list [info object mixins foo] \
+		    [info object isa mixin foo bar] \
+		    [info object isa mixin foo oo::class]]
+    foo destroy
+    bar destroy
+    return $result
+} {::bar 1 0}
+test oo-16.9 {OO: object introspection} -body {
+    oo::class create Ac
+    oo::class create Bc; oo::define Bc superclass Ac
+    oo::class create Cc; oo::define Cc superclass Bc
+    oo::class create Dc; oo::define Dc mixin Cc
+    Cc create E
+    Dc create F
+    list [info object isa    typeof E oo::class] \
+	    [info object isa typeof E Ac] \
+	    [info object isa typeof F Bc] \
+	    [info object isa typeof F Cc]
+} -cleanup {
+    catch {Ac destroy}
+} -result {0 1 1 1}
+test oo-16.10 {OO: object introspection} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo export eval
+    foo eval {variable c 3 a 1 b 2 ddd 4 e}
+    lsort [info object vars foo ?]
+} -cleanup {
+    foo destroy
+} -result {a b c}
+test oo-16.11 {OO: object introspection} -setup {
+    oo::class create foo
+    foo create bar
+} -body {
+    oo::define foo method spong {} {...}
+    oo::objdefine bar method boo {a {b c} args} {the body}
+    list [info object methods bar -all] [info object methods bar -all -private]
+} -cleanup {
+    foo destroy
+} -result {{boo destroy spong} {boo destroy eval spong unknown variable varname}}
+
+test oo-17.1 {OO: class introspection} -body {
+    info class
+} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?argument ...?\""
+test oo-17.2 {OO: class introspection} -body {
+    info class superclass NOTANOBJECT
+} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
+test oo-17.3 {OO: class introspection} -setup {
+    oo::object create foo
+} -body {
+    info class superclass foo
+} -returnCodes 1 -cleanup {
+    foo destroy
+} -result {"foo" is not a class}
+test oo-17.4 {OO: class introspection} -body {
+    info class gorp oo::object
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be constructor, definition, destructor, filters, forward, instances, methods, mixins, subclasses, or superclasses}
+test oo-17.5 {OO: class introspection} -setup {
+    oo::class create testClass
+} -body {
+    testClass create foo
+    testClass create bar
+    testClass create spong
+    lsort [info class instances testClass]
+} -cleanup {
+    testClass destroy
+} -result {::bar ::foo ::spong}
+test oo-17.6 {OO: class introspection} -setup {
+    oo::class create foo
+} -body {
+    oo::define foo method bar {a {b c} args} {the body}
+    set result [info class methods foo]
+    lappend result [info class definition foo bar]
+} -cleanup {
+    foo destroy
+} -result {bar {{a {b c} args} {the body}}}
+test oo-17.7 {OO: class introspection} {
+    info class superclasses oo::class
+} ::oo::object
+test oo-17.8 {OO: class introspection} -setup {
+    oo::class create testClass
+    oo::class create superClass1
+    oo::class create superClass2
+} -body {
+    oo::define testClass superclass superClass1 superClass2
+    list [info class superclasses testClass] \
+	[lsort [info class subclass oo::object ::superClass?]]
+} -cleanup {
+    testClass destroy
+    superClass1 destroy
+    superClass2 destroy
+} -result {{::superClass1 ::superClass2} {::superClass1 ::superClass2}}
+test oo-17.9 {OO: class introspection} -setup {
+    oo::class create foo
+    oo::class create subfoo {superclass foo}
+} -body {
+    oo::define foo {
+	method bar {a {b c} args} {the body}
+	self {
+	    method bad {} {...}
+	}
+    }
+    oo::define subfoo method boo {a {b c} args} {the body}
+    list [info class methods subfoo -all] \
+	[info class methods subfoo -all -private]
+} -cleanup {
+    foo destroy
+} -result {{bar boo destroy} {bar boo destroy eval unknown variable varname}}
+
+test oo-18.1 {OO: define command support} {
+    list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo
+} {1 foo {foo
+    while executing
+"error foo"
+    (in definition script for object "oo::object" line 1)
+    invoked from within
+"oo::define oo::object {error foo}"}}
+test oo-18.2 {OO: define command support} {
+    list [catch {oo::define oo::object error foo} msg] $msg $errorInfo
+} {1 foo {foo
+    while executing
+"oo::define oo::object error foo"}}
+test oo-18.3 {OO: define command support} {
+    list [catch {oo::class create foo {error bar}} msg] $msg $errorInfo
+} {1 bar {bar
+    while executing
+"error bar"
+    (in definition script for object "::foo" line 1)
+    invoked from within
+"oo::class create foo {error bar}"}}
+test oo-18.4 {OO: more error traces from the guts} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj method bar {} {my eval {error foo}}
+    list [catch {obj bar} msg] $msg $errorInfo
+} -cleanup {
+    obj destroy
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in "my eval" script line 1)
+    invoked from within
+"my eval {error foo}"
+    (object "::obj" method "bar" line 1)
+    invoked from within
+"obj bar"}}
+test oo-18.5 {OO: more error traces from the guts} -setup {
+    [oo::class create cls] create obj
+    set errorInfo {}
+} -body {
+    oo::define cls {
+	method eval script {next $script}
+	export eval
+    }
+    oo::objdefine obj method bar {} {my eval {error foo}}
+    set result {}
+    lappend result [catch {obj bar} msg] $msg $errorInfo
+    lappend result [catch {obj eval {error bar}} msg] $msg $errorInfo
+} -cleanup {
+    cls destroy
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in "my eval" script line 1)
+    invoked from within
+"next $script"
+    (class "::cls" method "eval" line 1)
+    invoked from within
+"my eval {error foo}"
+    (object "::obj" method "bar" line 1)
+    invoked from within
+"obj bar"} 1 bar {bar
+    while executing
+"error bar"
+    (in "::obj eval" script line 1)
+    invoked from within
+"next $script"
+    (class "::cls" method "eval" line 1)
+    invoked from within
+"obj eval {error bar}"}}
+
+test oo-19.1 {OO: varname method} -setup {
+    oo::object create inst
+    oo::objdefine inst export eval
+    set result {}
+} -body {
+    inst eval {trace add variable x write foo}
+    set ns [inst eval namespace current]
+    proc foo args {
+	global ns result
+	set context [uplevel 1 namespace current]
+	lappend result $args [expr {
+	    $ns eq $context ? "ok" : [list $ns ne $context]
+	}] [expr {
+	    "${ns}::x" eq [uplevel 1 my varname x] ? "ok" : [list ${ns}::x ne [uplevel 1 my varname x]]
+	}]
+    }
+    lappend result [inst eval set x 0]
+} -cleanup {
+    inst destroy
+    rename foo {}
+} -result {{x {} write} ok ok 0}
+
+test oo-20.1 {OO: variable method} -body {
+    oo::class create testClass {
+	constructor {} {
+	    my variable ok
+	    set ok {}
+	}
+    }
+    lsort [info object vars [testClass new]]
+} -cleanup {
+    catch {testClass destroy}
+} -result ok
+test oo-20.2 {OO: variable method} -body {
+    oo::class create testClass {
+	constructor {} {
+	    my variable a b c
+	    set a [set b [set c {}]]
+	}
+    }
+    lsort [info object vars [testClass new]]
+} -cleanup {
+    catch {testClass destroy}
+} -result {a b c}
+test oo-20.3 {OO: variable method} -body {
+    oo::class create testClass {
+	export varname
+	method bar {} {
+	    my variable a(b)
+	}
+    }
+    testClass create foo
+    array set [foo varname a] {b c}
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {can't define "a(b)": name refers to an element in an array}
+test oo-20.4 {OO: variable method} -body {
+    oo::class create testClass {
+	export varname
+	method bar {} {
+	    my variable a(b)
+	}
+    }
+    testClass create foo
+    set [foo varname a] b
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {can't define "a(b)": name refers to an element in an array}
+test oo-20.5 {OO: variable method} -body {
+    oo::class create testClass {
+	method bar {} {
+	    my variable a::b
+	}
+    }
+    testClass create foo
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {variable name "a::b" illegal: must not contain namespace separator}
+test oo-20.6 {OO: variable method} -setup {
+    oo::class create testClass {
+	export varname
+	self export eval
+    }
+} -body {
+    testClass eval variable a 0
+    oo::objdefine [testClass create foo] method bar {other} {
+	$other variable a
+	set a 3
+    }
+    oo::objdefine [testClass create boo] export variable
+    set [foo varname a] 1
+    set [boo varname a] 2
+    foo bar boo
+    list [testClass eval set a] [set [foo varname a]] [set [boo varname a]]
+} -cleanup {
+    testClass destroy
+} -result {0 1 3}
+test oo-20.7 {OO: variable method} -setup {
+    oo::class create cls
+} -body {
+    oo::define cls {
+	method a {} {
+	    my variable d b
+	    lappend b $d
+	}
+	method e {} {
+	    my variable b d
+	    return [list $b $d]
+	}
+	method f {x y} {
+	    my variable b d
+	    set b $x
+	    set d $y
+	}
+    }
+    cls create obj
+    obj f p q
+    obj a
+    obj a
+    obj e
+} -cleanup {
+    cls destroy
+} -result {{p q q} q}
+# oo-20.8 tested explicitly for functionality removed due to [Bug 1959457]
+test oo-20.9 {OO: variable method} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj {
+	method a {} {
+	    my variable ::b
+	}
+    }
+    obj a
+} -returnCodes 1 -cleanup {
+    obj destroy
+} -result {variable name "::b" illegal: must not contain namespace separator}
+test oo-20.10 {OO: variable and varname methods refer to same things} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj {
+	method a {} {
+	    my variable b
+	    set b [self]
+	    return [my varname b]
+	}
+    }
+    list [set [obj a]] [namespace tail [obj a]]
+} -cleanup {
+    obj destroy
+} -result {::obj b}
+test oo-20.11 {OO: variable mustn't crash when recursing} -body {
+    oo::class create A {
+	constructor {name} {
+	    my variable np_name 
+	    set np_name $name
+	}
+	method copy {nm} {
+	    set cpy [[info object class [self]] new $nm]
+	    foreach var [info object vars [self]] {
+		my variable $var
+		set val [set $var]
+		if {[string match o_* $var]} {
+		    set objs {}
+		    foreach ref $val {
+			# call to "copy" crashes
+			lappend objs [$ref copy {}]
+		    }
+		    $cpy prop $var $objs
+		} else { 
+		    $cpy prop $var $val
+		}
+	    }
+	    return $cpy
+	}
+	method prop {name val} {
+	    my variable $name
+	    set $name $val
+	}
+    }
+    set o1 [A new {}]
+    set o2 [A new {}]
+    $o1 prop o_object $o2
+    $o1 copy aa
+} -cleanup {
+    catch {A destroy}
+} -match glob -result *
+
+test oo-21.1 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    D create o
+    oo::objdefine o method m {} {lappend ::result o;next}
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {o D B C A}
+test oo-21.2 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Fmix Emix o D B C A}
+test oo-21.3 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+	method f {} {lappend ::result B-filt;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+	method f {} {lappend ::result Emix-filt;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+	filter f
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Emix-filt B-filt Fmix Emix o D B C A}
+test oo-21.4 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+	method f {} {lappend ::result B-filt;next}
+	method g {} {lappend ::result B-cfilt;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+	method g {} {lappend ::result D-cfilt;next}
+	filter g
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+	method f {} {lappend ::result Emix-filt;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+	filter f
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Emix-filt B-filt D-cfilt B-cfilt Fmix Emix o D B C A}
+
+test oo-22.1 {OO and info frame} -setup {
+    oo::class create c
+    c create i
+} -body {
+    oo::define c self method frame {} {
+	info frame 0
+    }
+    oo::define c {
+	method frames {} {
+	    info frame 0
+	}
+	method level {} {
+	    info frame
+	}
+    }
+    oo::objdefine i {
+	method frames {} {
+	    list [next] [info frame 0]
+	}
+	method level {} {
+	    expr {[next] - [info frame]}
+	}
+    }
+    list [i level] [i frames] [dict get [c frame] object]
+} -cleanup {
+    c destroy
+} -result {1 {{type proc line 2 cmd {info frame 0} method frames class ::c level 0} {type proc line 2 cmd {info frame 0} method frames object ::i level 0}} ::c}
+
+# Prove that the issue in [Bug 1865054] isn't an issue any more
+test oo-23.1 {Self-like derivation; complex case!} -setup {
+    oo::class create SELF {
+	superclass oo::class
+	unexport create new
+	# Next is just a convenience
+	method method args {oo::define [self] method {*}$args}
+	method derive {name} {
+	    set o [my new [list superclass [self]]]
+	    oo::objdefine $o mixin $o
+	    uplevel 1 [list rename $o $name]\;[list namespace which $name]
+	}
+	self mixin SELF
+    }
+    set result {}
+} -body {
+    [SELF derive foo1] method bar1 {} {return 1}
+    lappend result [foo1 bar1]
+    [foo1 derive foo2] method bar2 {} {return [my bar1],2}
+    lappend result [foo2 bar2]
+    [foo2 derive foo3] method bar3 {} {return [my bar2],3}
+    lappend result [foo3 bar3]
+    [foo3 derive foo4] method bar4 {} {return [my bar3],4}
+    lappend result [foo4 bar4]
+    foo2 method bar2 {} {return [my bar1],x}
+    lappend result [foo4 bar4]
+} -cleanup {
+    SELF destroy
+} -result {1 1,2 1,2,3 1,2,3,4 1,x,3,4}
+
+test oo-24.1 {unknown method method - Bug 1965063} -setup {
+    oo::class create cls
+} -cleanup {
+    cls destroy
+} -returnCodes error -body {
+    oo::define cls {
+	method dummy {} {}
+	method unknown args {next {*}$args}
+    }
+    [cls new] foo bar
+} -result {unknown method "foo": must be destroy, dummy or unknown}
+test oo-24.2 {unknown method method - Bug 1965063} -setup {
+    oo::class create cls
+} -cleanup {
+    cls destroy
+} -returnCodes error -body {
+    oo::define cls {
+	method dummy {} {}
+	method unknown args {next {*}$args}
+    }
+    cls create obj
+    oo::objdefine obj {
+	method dummy2 {} {}
+	method unknown args {next {*}$args}
+    }
+    obj foo bar
+} -result {unknown method "foo": must be destroy, dummy, dummy2 or unknown}
+
+# Probably need a better set of tests, but this is quite difficult to devise
+test oo-25.1 {call chain caching} -setup {
+    oo::class create cls {
+	method ab {} {return ok}
+    }
+    set result {}
+} -cleanup {
+    cls destroy
+} -body {
+    cls create foo
+    cls create bar
+    set m1 ab
+    set m2 a; append m2 b ;# different object!
+    lappend result [foo $m1] [foo $m1] [bar $m1] [foo $m1]
+    lappend result [foo $m2] [bar $m2]
+    oo::objdefine foo method ab {} {return good}
+    lappend result [foo $m1] [bar $m2]
+} -result {ok ok ok ok ok ok good ok}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End: