From e3cbe63dfbcaaa99f3e56c4c6b3becafa0fa7d33 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 9 Apr 2013 19:04:04 +0000
Subject: Use the double-secret iPtr->lookupNsPtr field to get post-enter-trace
 re-resolutions of commands done in the right context for oo forwards.

---
 generic/tclOOMethod.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 98b4078..5296397 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1429,6 +1429,7 @@ InvokeForwardMethod(
 		contextPtr->oPtr->namespacePtr, 0 /* normal lookup */);
     }
     Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
+    ((Interp *)interp)->lookupNsPtr = contextPtr->oPtr->namespacePtr;
     return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, cmdPtr);
 }
 
-- 
cgit v0.12


From 6f7f64c938f98f268b7e606cf668c40ca66e98c9 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 9 Apr 2013 20:01:08 +0000
Subject: added some test cases, based on bug report

---
 tests/oo.test | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

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
-- 
cgit v0.12