diff options
author | andreas_kupries <akupries@shaw.ca> | 2008-07-28 20:00:57 (GMT) |
---|---|---|
committer | andreas_kupries <akupries@shaw.ca> | 2008-07-28 20:00:57 (GMT) |
commit | 24cd37cd688085d4c016ab87e112add167d69173 (patch) | |
tree | c9ae4bdded6df431ec80cf526bc7ebae73c19e7a /generic/tclCompile.c | |
parent | c5be2d186c8738b465587c5433f3f4c422c95313 (diff) | |
download | tcl-24cd37cd688085d4c016ab87e112add167d69173.zip tcl-24cd37cd688085d4c016ab87e112add167d69173.tar.gz tcl-24cd37cd688085d4c016ab87e112add167d69173.tar.bz2 |
* generic/tclBasic.c: Added missing release of extended command
word index when deleting an interpreter (DeleteInterpProc). Added
missing ref count when creating an empty string as path (EvalEx).
* generic/tclCompile.c (TclInitCompileEnv): Made same change to
control flow as in TclEvalObjEx. Not needed while uplevel and
siblings go through the eval-direct code path, however if that
changes (like it did in 8.5+) better to have this in place instead
of re-searching why certain places are without absolute locations.
* tests/info.test: Added tests 38.*, exactly testing the tracking
of location for uplevel scripts, and made the testsuite fully
usable with and without -singleproc 1.
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r-- | generic/tclCompile.c | 36 |
1 files changed, 22 insertions, 14 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 59be33a..44ee69b 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.43.2.12 2008/07/23 20:45:18 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.43.2.13 2008/07/28 20:01:09 andreas_kupries Exp $ */ #include "tclInt.h" @@ -836,40 +836,48 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word) * (line, path, ...). Which may make change the type as well. */ - if ((invoker->nline <= word) || (invoker->line[word] < 0)) { + CmdFrame ctx = *invoker; + int pc = 0; + + if (invoker->type == TCL_LOCATION_BC) { + /* Note: Type BC => ctx.data.eval.path is not used. + * ctx.data.tebc.codePtr is used instead. + */ + TclGetSrcInfoForPc (&ctx); + pc = 1; + } + + if ((ctx.nline <= word) || (ctx.line[word] < 0)) { /* Word is not a literal, relative counting */ envPtr->line = 1; envPtr->extCmdMapPtr->type = (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC); - } else { - CmdFrame ctx = *invoker; - int pc = 0; - if (invoker->type == TCL_LOCATION_BC) { - /* Note: Type BC => ctx.data.eval.path is not used. - * ctx.data.tebc.codePtr is used instead. + if (pc && (ctx.type == TCL_LOCATION_SOURCE)) { + /* + * The reference made by 'TclGetSrcInfoForPc' is dead. */ - TclGetSrcInfoForPc (&ctx); - pc = 1; + Tcl_DecrRefCount(ctx.data.eval.path); } - + } else { envPtr->line = ctx.line [word]; envPtr->extCmdMapPtr->type = ctx.type; + envPtr->extCmdMapPtr->path = ctx.data.eval.path; if (ctx.type == TCL_LOCATION_SOURCE) { if (pc) { /* The reference 'TclGetSrcInfoForPc' made is transfered */ - envPtr->extCmdMapPtr->path = ctx.data.eval.path; ctx.data.eval.path = NULL; } else { /* We have a new reference here */ - envPtr->extCmdMapPtr->path = ctx.data.eval.path; - Tcl_IncrRefCount (envPtr->extCmdMapPtr->path); + Tcl_IncrRefCount (ctx.data.eval.path); } } } + + /* ctx going out of scope */ } #endif |