diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2011-08-07 15:46:09 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2011-08-07 15:46:09 (GMT) |
| commit | 097bee7c6ba61b29717c1780aed2370468649e4f (patch) | |
| tree | bbf523102341bcdd9dbbcf0f2d711f8b1e363a97 | |
| parent | d90ed9c0f07bbb5cf66140e89fcebc0da3f08285 (diff) | |
| download | tcl-097bee7c6ba61b29717c1780aed2370468649e4f.zip tcl-097bee7c6ba61b29717c1780aed2370468649e4f.tar.gz tcl-097bee7c6ba61b29717c1780aed2370468649e4f.tar.bz2 | |
[Bug 3387082]: Plug memory leak in call chain introspection.
| -rw-r--r-- | ChangeLog | 13 | ||||
| -rw-r--r-- | generic/tclOOCall.c | 6 | ||||
| -rw-r--r-- | generic/tclOOInfo.c | 1 | ||||
| -rw-r--r-- | tests/ooNext2.test | 25 |
4 files changed, 37 insertions, 8 deletions
@@ -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 |