summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-04-09 20:01:08 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-04-09 20:01:08 (GMT)
commitb6b0d1b8dd33bb6eb9c97217ec0c813452cafaed (patch)
tree4ff0c7c3fe82531cfac77f4711960cdd4507463b /tests
parent1ddb66bfdaba5d875111c7b0f6ebecc8d5e69f35 (diff)
downloadtcl-b6b0d1b8dd33bb6eb9c97217ec0c813452cafaed.zip
tcl-b6b0d1b8dd33bb6eb9c97217ec0c813452cafaed.tar.gz
tcl-b6b0d1b8dd33bb6eb9c97217ec0c813452cafaed.tar.bz2
added some test cases, based on bug report
Diffstat (limited to 'tests')
-rw-r--r--tests/oo.test63
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