summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclOOCall.c17
-rw-r--r--tests/oo.test37
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
generated by cgit v0.12 at 2024-11-06 05:30:12 (GMT)