diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2013-04-09 20:01:08 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2013-04-09 20:01:08 (GMT) |
| commit | 6f7f64c938f98f268b7e606cf668c40ca66e98c9 (patch) | |
| tree | 4ff0c7c3fe82531cfac77f4711960cdd4507463b | |
| parent | e3cbe63dfbcaaa99f3e56c4c6b3becafa0fa7d33 (diff) | |
| download | tcl-6f7f64c938f98f268b7e606cf668c40ca66e98c9.zip tcl-6f7f64c938f98f268b7e606cf668c40ca66e98c9.tar.gz tcl-6f7f64c938f98f268b7e606cf668c40ca66e98c9.tar.bz2 | |
added some test cases, based on bug report
| -rw-r--r-- | tests/oo.test | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/tests/oo.test b/tests/oo.test index 49fe150..84e6236 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -936,6 +936,69 @@ test oo-6.18 {Bug 3408830: more forwarding cases} -setup { } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "::foo len string"} +test oo-6.19 {Bug 3610404: forwarding resolution + traces} -setup { + oo::object create foo + unset -nocomplain ::result + set ::result {} +} -body { + proc ::my {method} {lappend ::result global} + oo::objdefine foo { + method target {} {lappend ::result instance} + forward bar my target + method bump {} { + set ns [info object namespace ::foo] + rename ${ns}::my ${ns}:: + rename ${ns}:: ${ns}::my + } + } + proc harness {} { + foo target + foo bar + foo target + } + trace add execution harness enterstep {apply {{cmd args} {foo bump}}} + foo target + foo bar + foo bump + foo bar + harness +} -cleanup { + catch {rename harness {}} + catch {rename ::my {}} + foo destroy +} -result {instance instance instance instance instance instance} +test oo-6.20 {Bug 3610404: forwarding resolution + traces} -setup { + oo::class create fooClass + fooClass create foo + unset -nocomplain ::result + set ::result {} +} -body { + proc ::my {method} {lappend ::result global} + oo::define fooClass { + method target {} {lappend ::result class} + forward bar my target + method bump {} { + set ns [info object namespace [self]] + rename ${ns}::my ${ns}:: + rename ${ns}:: ${ns}::my + } + } + proc harness {} { + foo target + foo bar + foo target + } + trace add execution harness enterstep {apply {{cmd args} {foo bump}}} + foo target + foo bar + foo bump + foo bar + harness +} -cleanup { + catch {rename harness {}} + catch {rename ::my {}} + fooClass destroy +} -result {class class class class class class} test oo-7.1 {OO: inheritance 101} -setup { oo::class create superClass |