summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-08-14 19:01:38 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-08-14 19:01:38 (GMT)
commit45814c0d69b2f08f1940cd3ca3cd8ce389815779 (patch)
tree702d2b4121fbb791bfdb84ba5af1ce3966c776a7
parent2b3657769b1d0b9ae6e10113b1d3c038b4967899 (diff)
parent1f563ae9a011345574fb277fe6e8eb7f58916981 (diff)
downloadtcl-45814c0d69b2f08f1940cd3ca3cd8ce389815779.zip
tcl-45814c0d69b2f08f1940cd3ca3cd8ce389815779.tar.gz
tcl-45814c0d69b2f08f1940cd3ca3cd8ce389815779.tar.bz2
[3610404] Re-resolution of command after enter traces invalidate epoch.
Make sure context is such that correct resolution happens.
-rw-r--r--generic/tclOOMethod.c2
-rw-r--r--tests/oo.test63
2 files changed, 65 insertions, 0 deletions
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index b91fdfd..0799082 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_INVOKE, 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