summaryrefslogtreecommitdiffstats
path: root/tests/oo.test
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 /tests/oo.test
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.
Diffstat (limited to 'tests/oo.test')
-rw-r--r--tests/oo.test63
1 files changed, 63 insertions, 0 deletions
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