diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclBasic.c | 29 | ||||
| -rw-r--r-- | tests/info.test | 9 |
3 files changed, 34 insertions, 13 deletions
@@ -1,3 +1,12 @@ +2008-08-01 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: Revised timing of the CmdFrame stack management + * tests/info.test: in TclEvalEx so that the CmdFrame will still + be on the stack at the time Tcl_LogCommandInfo is called to append + another level of -errorinfo information. Sets the stage to add + file and line data to the stack trace. Added test to check that + [info frame] functioning remains unchanged by the revision. + 2008-07-31 Miguel Sofer <msofer@users.sf.net> * tests/NRE.test: replaced all deep-recursing tests by shallower diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 019de9c..9509848 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,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.346 2008/07/31 20:01:38 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.347 2008/08/01 17:07:47 dgp Exp $ */ #include "tclInt.h" @@ -4838,6 +4838,14 @@ TclEvalEx( * Tcl initialization. */ + eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1; + eeFramePtr->numLevels = iPtr->numLevels; + eeFramePtr->framePtr = iPtr->framePtr; + eeFramePtr->nextPtr = iPtr->cmdFramePtr; + eeFramePtr->nline = 0; + eeFramePtr->line = NULL; + + iPtr->cmdFramePtr = eeFramePtr; if (iPtr->evalFlags & TCL_EVAL_CTX) { /* * Path information comes out of the context. @@ -4885,13 +4893,6 @@ TclEvalEx( eeFramePtr->data.eval.path = NULL; } - eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1; - eeFramePtr->numLevels = iPtr->numLevels; - eeFramePtr->framePtr = iPtr->framePtr; - eeFramePtr->nextPtr = iPtr->cmdFramePtr; - eeFramePtr->nline = 0; - eeFramePtr->line = NULL; - iPtr->evalFlags = 0; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { @@ -4933,6 +4934,7 @@ TclEvalEx( objv = objvSpace; lines = lineSpace; + iPtr->cmdFramePtr = eeFramePtr->nextPtr; for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { @@ -4960,7 +4962,7 @@ TclEvalEx( iPtr->evalFlags = 0; if (code != TCL_OK) { - goto error; + break; } objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); @@ -4977,7 +4979,7 @@ TclEvalEx( Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (expanding word %d)", objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); - goto error; + break; } expandRequested = 1; expand[objectsUsed] = 1; @@ -4988,6 +4990,10 @@ TclEvalEx( objectsNeeded++; } } /* for loop */ + iPtr->cmdFramePtr = eeFramePtr; + if (code != TCL_OK) { + goto error; + } if (expandRequested) { /* * Some word expansion was requested. Check for objv resize. @@ -5058,9 +5064,7 @@ TclEvalEx( eeFramePtr->line = lines; TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr); - iPtr->cmdFramePtr = eeFramePtr; code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR); - iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; TclArgumentRelease(interp, objv, objectsUsed); eeFramePtr->line = NULL; @@ -5164,6 +5168,7 @@ TclEvalEx( * TIP #280. Release the local CmdFrame, and its contents. */ + iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; if (eeFramePtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eeFramePtr->data.eval.path); } diff --git a/tests/info.test b/tests/info.test index d68da9f..d51390f 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.57 2008/07/25 23:06:21 andreas_kupries Exp $ +# RCS: @(#) $Id: info.test,v 1.58 2008/08/01 17:07:48 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -1409,6 +1409,13 @@ test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match * {type source line 1342 file info.test cmd control proc ::datal level 1} * {type source line 1405 file info.test cmd datal proc ::tcltest::RunTest}} +test info-38.7 {location information for arg substitution} -match glob -body { + join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n +} -result {* {type source line 728 file info.test cmd {info frame \$level} proc ::etrace level 0} +* {type eval line 1 cmd etrace proc ::tcltest::RunTest} +* {type source line 1413 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest} +* {type source line 2298 file tcltest.tcl cmd {uplevel 1 $script} proc ::tcltest::RunTest}} + # ------------------------------------------------------------------------- # cleanup |