From ff59f687d9a7ba1a84e8254166258300183af233 Mon Sep 17 00:00:00 2001 From: andreas_kupries Date: Tue, 10 Nov 2009 17:57:39 +0000 Subject: * generic/tclObj.c: Plus memory leak in TclContinuationsEnter(). [Bug 2895323]. Forward port from Tcl 8.5 branch, change by Don Porter. --- ChangeLog | 6 ++++++ generic/tclObj.c | 13 ++++++++++++- tests/info.test | 4 ++-- 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index d696061..b85453b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2009-11-10 Andreas Kupries + + * generic/tclObj.c: Plus memory leak in TclContinuationsEnter(). + [Bug 2895323]. Forward port from Tcl 8.5 branch, change by Don + Porter. + 2009-11-09 Stuart Cassoff * win/README: [bug 2459744]: Removed outdated Msys + Mingw info. diff --git a/generic/tclObj.c b/generic/tclObj.c index 8869e9b..5913dd1 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.163 2009/10/18 10:39:41 mistachkin Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.164 2009/11/10 17:57:39 andreas_kupries Exp $ */ #include "tclInt.h" @@ -582,6 +582,17 @@ TclContinuationsEnter(Tcl_Obj* objPtr, ContLineLoc* clLocPtr = (ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int)); + if (!newEntry) { + /* + * Somehow we're entering ContLineLoc data for the same value (objPtr) + * more than one time. Not sure whether that's expected, or a sign of + * trouble, but at a minimum, we should take care not to leak the old + * entry. + */ + + ckfree((char *) Tcl_GetHashValue(hPtr)); + } + clLocPtr->num = num; memcpy (&clLocPtr->loc, loc, num*sizeof(int)); clLocPtr->loc[num] = CLL_END; /* Sentinel */ diff --git a/tests/info.test b/tests/info.test index da54562..21b7712 100644 --- a/tests/info.test +++ b/tests/info.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.70 2009/11/09 22:59:13 andreas_kupries Exp $ +# RCS: @(#) $Id: info.test,v 1.71 2009/11/10 17:57:39 andreas_kupries Exp $ if {{::tcltest} ni [namespace children]} { package require tcltest 2 @@ -1033,7 +1033,7 @@ set body {set flag 0 set a c set res [info frame 0]} ;# line 3! -test info-31.0 {ns eval, script in variable} -body {set res {} +test info-31.0 {ns eval, script in variable} -body {namespace eval foo {variable res {}} namespace eval foo $body return $foo::res } -result {type eval line 3 cmd {info frame 0} level 0} -cleanup { -- cgit v0.12