From 097bee7c6ba61b29717c1780aed2370468649e4f Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 7 Aug 2011 15:46:09 +0000 Subject: [Bug 3387082]: Plug memory leak in call chain introspection. --- ChangeLog | 13 +++++++++---- generic/tclOOCall.c | 6 ++---- generic/tclOOInfo.c | 1 + tests/ooNext2.test | 25 +++++++++++++++++++++++++ 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 + + * generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory + leak in call chain introspection. + 2011-08-06 Kevin B, Kenny - * 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 - * 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 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 -- cgit v0.12