* 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].

3 files changed, 42 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index b6b2194..f97328a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2008-08-04  Don Porter  <dgp@users.sourceforge.net>S
+
+	* 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].
+
 2008-08-06  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclVar.c (TclLookupSimpleVar): fix bug that the core
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 6f078e4..4db39c3 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclOO.c,v 1.13 2008/07/18 23:29:44 msofer Exp $
+ * RCS: @(#) $Id: tclOO.c,v 1.14 2008/08/06 21:23:14 dgp Exp $
  */
 
 #ifdef HAVE_CONFIG_H
@@ -562,7 +562,7 @@ ObjectRenamedTrace(
 
     AddRef(oPtr);
     oPtr->flags |= OBJECT_DELETED;
-    if (!(flags & TCL_INTERP_DESTROYED)) {
+    if (!Tcl_InterpDeleted(interp)) {
 	CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR);
 
 	if (contextPtr != NULL) {
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