summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog13
-rw-r--r--generic/tclOOCall.c6
-rw-r--r--generic/tclOOInfo.c1
-rw-r--r--tests/ooNext2.test25
4 files changed, 37 insertions, 8 deletions
diff --git a/ChangeLog b/ChangeLog
index 293490a..1acc1ea 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,12 +1,17 @@
+2011-08-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory
+ leak in call chain introspection.
+
2011-08-06 Kevin B, Kenny <kennykb@acm.org>
- * generic/tclAssemnbly.c: Plug another memory leak. [Bug 3384840]
- * generic/tclStrToD.c: Plug another memory leak. [Bug 3386975]
+ * generic/tclAssemnbly.c: [Bug 3384840]: Plug another memory leak.
+ * generic/tclStrToD.c: [Bug 3386975]: Plug another memory leak.
2011-08-05 Kevin B. Kenny <kennykb@acm.org>
- * generic/tclStrToD.c: Plugged a memory leak in double->string
- conversion. [Bug 3386975]
+ * generic/tclStrToD.c: [Bug 3386975]: Plugged a memory leak in
+ double->string conversion.
2011-08-05 Donal K. Fellows <dkf@users.sf.net>
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index b5d7c0c..9c9f3c0 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -1166,7 +1166,7 @@ TclOOGetStereotypeCallChain(
hPtr = NULL;
}
- callPtr = (CallChain *) ckalloc(sizeof(CallChain));
+ callPtr = ckalloc(sizeof(CallChain));
memset(callPtr, 0, sizeof(CallChain));
callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
callPtr->epoch = fPtr->epoch;
@@ -1214,9 +1214,7 @@ TclOOGetStereotypeCallChain(
} else {
if (hPtr == NULL) {
if (clsPtr->classChainCache == NULL) {
- clsPtr->classChainCache = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
-
+ clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitObjHashTable(clsPtr->classChainCache);
}
hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index ac8ae46..f298320 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -1542,6 +1542,7 @@ InfoClassCallCmd(
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
+ TclOODeleteChain(callPtr);
return TCL_OK;
}
diff --git a/tests/ooNext2.test b/tests/ooNext2.test
index 51f02c5..eeade11 100644
--- a/tests/ooNext2.test
+++ b/tests/ooNext2.test
@@ -513,6 +513,21 @@ test oo-call-1.18 {object call introspection - memory leaks} -body {
info object call oo::object destroy
}
} -constraints memory -result 0
+test oo-call-1.19 {object call introspection - memory leaks} -setup {
+ oo::class create leaktester { method foo {} {dummy} }
+} -body {
+ leaktest {
+ set lt [leaktester new]
+ oo::objdefine $lt method foobar {} {dummy}
+ list [info object call $lt destroy] \
+ [info object call $lt foo] \
+ [info object call $lt bar] \
+ [info object call $lt foobar] \
+ [$lt destroy]
+ }
+} -cleanup {
+ leaktester destroy
+} -constraints memory -result 0
test oo-call-2.1 {class call introspection} -setup {
oo::class create root
@@ -684,6 +699,16 @@ test oo-call-2.13 {class call introspection - memory leaks} -body {
info class call oo::class destroy
}
} -constraints memory -result 0
+test oo-call-2.14 {class call introspection - memory leaks} -body {
+ leaktest {
+ oo::class create leaktester { method foo {} {dummy} }
+ [leaktester new] destroy
+ list [info class call leaktester destroy] \
+ [info class call leaktester foo] \
+ [info class call leaktester bar] \
+ [leaktester destroy]
+ }
+} -constraints memory -result 0
test oo-call-3.1 {current call introspection} -setup {
oo::class create root