diff options
| author | dgp <dgp@users.sourceforge.net> | 2013-08-14 19:07:01 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2013-08-14 19:07:01 (GMT) |
| commit | e53364c7b0929f62adb4c101d487f1ebb2754a94 (patch) | |
| tree | dfe7c4a814fe0185a1ca2065dc58a32252902994 | |
| parent | a733cde27c904a40aae56e93c7daa369e2a4d045 (diff) | |
| parent | 45814c0d69b2f08f1940cd3ca3cd8ce389815779 (diff) | |
| download | tcl-e53364c7b0929f62adb4c101d487f1ebb2754a94.zip tcl-e53364c7b0929f62adb4c101d487f1ebb2754a94.tar.gz tcl-e53364c7b0929f62adb4c101d487f1ebb2754a94.tar.bz2 | |
merge trunk
| -rw-r--r-- | generic/tclOOMethod.c | 2 | ||||
| -rw-r--r-- | tests/oo.test | 63 |
2 files changed, 65 insertions, 0 deletions
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 7595f82..c3e59d1 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -1429,6 +1429,8 @@ InvokeForwardMethod( contextPtr->oPtr->namespacePtr, 0 /* normal lookup */); } Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL); + ((Interp *)interp)->lookupNsPtr + = (Namespace *) contextPtr->oPtr->namespacePtr; return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, cmdPtr); } diff --git a/tests/oo.test b/tests/oo.test index 6d38f71..e0e0791 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 |