Fix [Bug 2120903]

3 files changed, 39 insertions, 21 deletions

diff --git a/ChangeLog b/ChangeLog
index 2f539a2..19d45a8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2008-09-25  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclOOCall.c (InitCallChain, IsStillValid):
+	* tests/oo.test (oo-25.2): Revise call chain cache management so that
+	it takes into account class-wide caching correctly. [Bug 212090]
+
 2008-09-24  Don Porter  <dgp@users.sourceforge.net>
 
 	TIP #323 IMPLEMENTATION (partial)
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index e517d28..d4b1297 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclOOCall.c,v 1.10 2008/07/18 23:29:44 msofer Exp $
+ * RCS: @(#) $Id: tclOOCall.c,v 1.11 2008/09/25 10:13:30 dkf Exp $
  */
 
 #ifdef HAVE_CONFIG_H
@@ -832,14 +832,17 @@ InitCallChain(
     Object *oPtr,
     int flags)
 {
+    callPtr->flags = flags &
+	    (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
     if (oPtr->flags & USE_CLASS_CACHE) {
 	oPtr = oPtr->selfCls->thisPtr;
+	callPtr->flags |= USE_CLASS_CACHE;
+    } else {
+	callPtr->flags &= ~USE_CLASS_CACHE;
     }
     callPtr->epoch = oPtr->fPtr->epoch;
     callPtr->objectCreationEpoch = oPtr->creationEpoch;
     callPtr->objectEpoch = oPtr->epoch;
-    callPtr->flags = flags &
-	    (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
     callPtr->refCount = 1;
     callPtr->numChain = 0;
     callPtr->chain = callPtr->staticChain;
@@ -869,12 +872,8 @@ IsStillValid(
     int mask)
 {
     if ((oPtr->flags & USE_CLASS_CACHE)) {
-	register Object *coPtr = oPtr->selfCls->thisPtr;
-
-	return ((callPtr->objectCreationEpoch == coPtr->creationEpoch)
-		&& (callPtr->epoch == coPtr->fPtr->epoch)
-		&& (callPtr->objectEpoch == coPtr->epoch)
-		&& ((callPtr->flags & mask) == (flags & mask)));
+	oPtr = oPtr->selfCls->thisPtr;
+	flags |= USE_CLASS_CACHE;
     }
     return ((callPtr->objectCreationEpoch == oPtr->creationEpoch)
 	    && (callPtr->epoch == oPtr->fPtr->epoch)
diff --git a/tests/oo.test b/tests/oo.test
index 5b261f7..f221e1f 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.12 2008/09/23 05:05:54 dkf Exp $
+# RCS: @(#) $Id: oo.test,v 1.13 2008/09/25 10:13:33 dkf Exp $
 
 package require TclOO 0.4 ;# Must match value in configure.in
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -1786,6 +1786,19 @@ test oo-25.1 {call chain caching} -setup {
     oo::objdefine foo method ab {} {return good}
     lappend result [foo $m1] [bar $m2]
 } -result {ok ok ok ok ok ok good ok}
+test oo-25.2 {call chain caching - Bug #2120903} -setup {
+    set c [oo::class create MyClass]
+    set o [$c new]
+} -body {
+    oo::define MyClass {
+	method name {} {return ok}
+	method isa o {MyClass name $o}
+	self method name o {$o name}
+    }
+    list [$o name] [$c name $o] [$o isa $o]
+} -cleanup {
+    $c destroy
+} -result {ok ok ok}
 
 test oo-26.1 {Bug 2037727} -setup {
     proc succeed args {}
@@ -1830,7 +1843,7 @@ test oo-26.3 {Bug 2037727} -setup {
     example destroy
 } -result {{} nonempty}
 
-test oo-26.1 {variables declaration - class introspection} -setup {
+test oo-27.1 {variables declaration - class introspection} -setup {
     oo::class create foo
 } -cleanup {
     foo destroy
@@ -1838,7 +1851,7 @@ test oo-26.1 {variables declaration - class introspection} -setup {
     oo::define foo variable a b c
     info class variables foo
 } -result {a b c}
-test oo-26.2 {variables declaration - object introspection} -setup {
+test oo-27.2 {variables declaration - object introspection} -setup {
     oo::object create foo
 } -cleanup {
     foo destroy
@@ -1846,7 +1859,7 @@ test oo-26.2 {variables declaration - object introspection} -setup {
     oo::objdefine foo variable a b c
     info object variables foo
 } -result {a b c}
-test oo-26.3 {variables declaration - basic behaviour} -setup {
+test oo-27.3 {variables declaration - basic behaviour} -setup {
     oo::class create master
 } -cleanup {
     master destroy
@@ -1861,7 +1874,7 @@ test oo-26.3 {variables declaration - basic behaviour} -setup {
     bar y
     bar y
 } -result 3
-test oo-26.4 {variables declaration - destructors too} -setup {
+test oo-27.4 {variables declaration - destructors too} -setup {
     oo::class create master
     set result bad!
 } -cleanup {
@@ -1880,7 +1893,7 @@ test oo-26.4 {variables declaration - destructors too} -setup {
     bar destroy
     return $result
 } -result 3
-test oo-26.5 {variables declaration - object-bound variables} -setup {
+test oo-27.5 {variables declaration - object-bound variables} -setup {
     oo::object create foo
 } -cleanup {
     foo destroy
@@ -1892,7 +1905,7 @@ test oo-26.5 {variables declaration - object-bound variables} -setup {
     foo y
     foo y
 } -result 2
-test oo-26.6 {variables declaration - non-interference of levels} -setup {
+test oo-27.6 {variables declaration - non-interference of levels} -setup {
     oo::class create master
 } -cleanup {
     master destroy
@@ -1912,7 +1925,7 @@ test oo-26.6 {variables declaration - non-interference of levels} -setup {
     bar y
     list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}]
 } -result {{3 2 y! {}} {x! y!} {x! y!}}
-test oo-26.7 {variables declaration - one underlying variable space} -setup {
+test oo-27.7 {variables declaration - one underlying variable space} -setup {
     oo::class create master
 } -cleanup {
     master destroy
@@ -1938,13 +1951,13 @@ test oo-26.7 {variables declaration - one underlying variable space} -setup {
     bar x
     list [bar y] [bar x] [bar z]
 } -result {3 40 {3 40}}
-test oo-26.8 {variables declaration - error cases - ns separators} -body {
+test oo-27.8 {variables declaration - error cases - ns separators} -body {
     oo::define oo::object variable bad::var
 } -returnCodes error -result {invalid declared variable name "bad::var": must not contain namespace separators}
-test oo-26.9 {variables declaration - error cases - arrays} -body {
+test oo-27.9 {variables declaration - error cases - arrays} -body {
     oo::define oo::object variable bad(var)
 } -returnCodes error -result {invalid declared variable name "bad(var)": must not refer to an array element}
-test oo-26.10 {variables declaration - no instance var leaks with class resolvers} -setup {
+test oo-27.10 {variables declaration - no instance var leaks with class resolvers} -setup {
     oo::class create master
 } -cleanup {
     master destroy
@@ -1972,7 +1985,7 @@ test oo-26.10 {variables declaration - no instance var leaks with class resolver
     inst1 step
     list [inst1 value] [inst2 value]
 } -result {3 2}
-test oo-26.11 {variables declaration - no instance var leaks with class resolvers} -setup {
+test oo-27.11 {variables declaration - no instance var leaks with class resolvers} -setup {
     oo::class create master
 } -cleanup {
     master destroy