From c69c58efa6a8335b33f5681b818245ae1da86be1 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 9 Nov 2009 22:36:39 +0000 Subject: * generic/tclBasic.c (TclEvalObjEx): Plug memory leak in TCL_EVAL_DIRECT evaluation. * tests/info.test: Resolve ambiguous resolution of variable "res". --- ChangeLog | 7 +++++++ generic/tclBasic.c | 14 +++++++------- tests/info.test | 4 ++-- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/ChangeLog b/ChangeLog index 69d4c47..b60895b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2009-11-09 Don Porter + + * generic/tclBasic.c (TclEvalObjEx): Plug memory leak in + TCL_EVAL_DIRECT evaluation. + + * tests/info.test: Resolve ambiguous resolution of variable "res". + 2009-11-03 Don Porter *** 8.5.8 TAGGED FOR RELEASE *** diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 90b6c21..63548ea 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.295.2.14 2009/10/31 20:25:32 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.295.2.15 2009/11/09 22:36:39 dgp Exp $ */ #include "tclInt.h" @@ -5226,14 +5226,14 @@ TclEvalObjEx( result = TclEvalEx(interp, script, numSrcBytes, flags, ctxPtr->line[word], NULL, script); + } - if (pc) { - /* - * Death of SrcInfo reference. - */ + if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { + /* + * Death of SrcInfo reference. + */ - Tcl_DecrRefCount(ctxPtr->data.eval.path); - } + Tcl_DecrRefCount(ctxPtr->data.eval.path); } TclStackFree(interp, ctxPtr); diff --git a/tests/info.test b/tests/info.test index 90cbb24..5c0478c 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.47.2.9 2009/08/25 21:01:05 andreas_kupries Exp $ +# RCS: @(#) $Id: info.test,v 1.47.2.10 2009/11/09 22:36:39 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -1034,7 +1034,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} { +test info-31.0 {ns eval, script in variable} {set res {} namespace eval foo $body set res } {type eval line 3 cmd {info frame 0} level 0} -- cgit v0.12