summaryrefslogtreecommitdiffstats
path: root/tests/oo.test
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2008-08-06 21:23:13 (GMT)
committerdgp <dgp@users.sourceforge.net>2008-08-06 21:23:13 (GMT)
commit4c3c492b67b48506cdf77c1f146af9f4318f24c1 (patch)
treeeefbacdbe1583148a2d4d277d7a3e547aab3a2e8 /tests/oo.test
parent3f16aab4812d1bbe558e14c8d0ab3dfb692cece9 (diff)
downloadtcl-4c3c492b67b48506cdf77c1f146af9f4318f24c1.zip
tcl-4c3c492b67b48506cdf77c1f146af9f4318f24c1.tar.gz
tcl-4c3c492b67b48506cdf77c1f146af9f4318f24c1.tar.bz2
* generic/tclOO.c: Revised TclOO's check for an interp
being deleted during handling of object command deletion. The old code was relying on documented features of command delete traces that do not in fact work. [Bug 2039178]. * tests/oo.test (oo-26.*): Added tests that demonstrate failure of TclOO to check for various kinds of invalid bytecode during method dispatch. [Bug 2037727].
Diffstat (limited to 'tests/oo.test')
-rw-r--r--tests/oo.test30
1 files changed, 29 insertions, 1 deletions
diff --git a/tests/oo.test b/tests/oo.test
index 8ff06e8..ea97bf2 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -7,7 +7,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: oo.test,v 1.9 2008/07/25 22:11:21 andreas_kupries Exp $
+# RCS: @(#) $Id: oo.test,v 1.10 2008/08/06 21:23:15 dgp Exp $
package require TclOO 0.4 ;# Must match value in configure.in
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -1787,6 +1787,34 @@ test oo-25.1 {call chain caching} -setup {
lappend result [foo $m1] [bar $m2]
} -result {ok ok ok ok ok ok good ok}
+test oo-26.1 {Bug 2037727} -setup {
+ proc succeed args {}
+ oo::object create example
+} -body {
+ oo::objdefine example method foo {} {succeed}
+ example foo
+ proc succeed {} {return succeed}
+ example foo
+} -cleanup {
+ example destroy
+ rename succeed {}
+} -result succeed
+
+test oo-26.2 {Bug 2037727} -setup {
+ oo::class create example {
+ method namespace {} {self namespace}
+ method foo {} {succeed}
+ }
+ example create i1
+ example create i2
+ namespace eval [i1 namespace] {proc succeed args {}}
+ namespace eval [i2 namespace] {proc succeed args {return succeed}}
+} -body {
+ list [i1 foo] [i2 foo]
+} -cleanup {
+ example destroy
+} -result {{} succeed}
+
cleanupTests
return