diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclBasic.c | 47 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 4 | ||||
| -rw-r--r-- | generic/tclCompile.c | 8 | ||||
| -rw-r--r-- | tests/info.test | 28 |
5 files changed, 69 insertions, 29 deletions
@@ -1,3 +1,14 @@ +2008-07-23 Andreas Kupries <andreask@activestate.com> + + * generic/tclBasic.c: Modified TclArgumentGet to reject pure lists + * generic/tclCmdIL.c: immediately, without search. Reworked setup + * generic/tclCompile.c: of eoFramePtr, doesn't need the line + * tests/info.test: information, more sensible to have everything + on line 1 when eval'ing a pure list. Updated the users of the line + information to special case this based on the frame type (i.e. + TCL_LOCATION_EVAL_LIST). Added a testcase demonstrating the new + behaviour. + 2008-07-23 Miguel Sofer <msofer@users.sf.net> * generic/tclBasic.c (GetCommandSource): added comment with diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 1730097..da81e9c 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.329 2008/07/23 13:38:22 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.330 2008/07/23 20:49:50 andreas_kupries Exp $ */ #include "tclInt.h" @@ -5534,6 +5534,18 @@ TclArgumentGet( CmdFrame *framePtr; /* + * An object which either has no string rep or else is a canonical list is + * guaranteed to have been generated dynamically: bail out, this cannot + * have a usable absolute location. _Do not touch_ the information the set + * up by the caller. It knows better than us. + */ + + if ((!obj->bytes) || ((obj->typePtr == &tclListType) && + ((List *)obj->internalRep.twoPtrValue.ptr1)->canonicalFlag)) { + return; + } + + /* * First look for location information recorded in the argument * stack. That is nearest. */ @@ -5745,18 +5757,11 @@ TclNREvalObjEx( * dynamic execution we ignore the invoker, even if known. */ - int line, i, nline; - char *w; - Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr); CmdFrame *eoFramePtr; - Tcl_ListObjGetElements(NULL, copyPtr, - &nline, &elements); - - eoFramePtr = (CmdFrame *) TclStackAlloc(interp, - sizeof(CmdFrame) + nline * sizeof(int)); - eoFramePtr->nline = nline; - eoFramePtr->line = (int *) (eoFramePtr + 1); + eoFramePtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); + eoFramePtr->nline = 0; + eoFramePtr->line = NULL; eoFramePtr->type = TCL_LOCATION_EVAL_LIST; eoFramePtr->level = (iPtr->cmdFramePtr == NULL? @@ -5769,21 +5774,19 @@ TclNREvalObjEx( eoFramePtr->data.eval.path = NULL; /* - * TIP #280 Computes all the line numbers for the words in the - * command. + * TIP #280. We do _not_ compute all the line numbers for the + * words in the command. For the eval of a pure list the most + * sensible choice is to put all words on line 1. Given that we + * neither need memory for them nor compute anything. 'line' is + * left NULL. The two places using this information (TclInfoFrame, + * and TclInitCompileEnv), are special-cased to use the proper + * line number directly instead of accessing the 'line' array. */ - line = 1; - for (i=0; i < eoFramePtr->nline; i++) { - eoFramePtr->line[i] = line; - w = TclGetString(elements[i]); - TclAdvanceLines(&line, w, w + strlen(w)); - } - iPtr->cmdFramePtr = eoFramePtr; TclNRAddCallback(interp, TEOEx_ListCallback, objPtr, eoFramePtr, - copyPtr, NULL); + NULL, NULL); return Tcl_NREvalObj(interp, objPtr, flags); } } @@ -5952,7 +5955,6 @@ TEOEx_ListCallback( Interp *iPtr = (Interp *) interp; Tcl_Obj *objPtr = data[0]; CmdFrame *eoFramePtr = data[1]; - Tcl_Obj *copyPtr = data[2]; /* * Remove the cmdFrame @@ -5960,7 +5962,6 @@ TEOEx_ListCallback( iPtr->cmdFramePtr = eoFramePtr->nextPtr; TclStackFree(interp, eoFramePtr); - Tcl_DecrRefCount(copyPtr); TclDecrRefCount(objPtr); return result; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 9c668c2..ab324de 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.145 2008/07/21 22:22:27 nijtmans Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.146 2008/07/23 20:49:52 andreas_kupries Exp $ */ #include "tclInt.h" @@ -1159,7 +1159,7 @@ TclInfoFrame( */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); + ADD_PAIR("line", Tcl_NewIntObj(1)); /* * We put a duplicate of the command list obj into the result to diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c754ef1..f484d7b 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.152 2008/07/22 22:24:21 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.153 2008/07/23 20:49:52 andreas_kupries Exp $ */ #include "tclInt.h" @@ -914,9 +914,11 @@ TclInitCompileEnv( envPtr->extCmdMapPtr->neiloc = 0; envPtr->extCmdMapPtr->nueiloc = 0; - if (invoker == NULL) { + if ((invoker == NULL) || + (invoker->type == TCL_LOCATION_EVAL_LIST)) { /* - * Initialize the compiler for relative counting. + * Initialize the compiler for relative counting in case of a + * dynamic context. */ envPtr->line = 1; diff --git a/tests/info.test b/tests/info.test index 43fc794..7fd9ec1 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.51 2008/07/21 22:50:36 andreas_kupries Exp $ +# RCS: @(#) $Id: info.test,v 1.52 2008/07/23 20:49:52 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -1301,6 +1301,32 @@ namespace delete foo # ------------------------------------------------------------------------- +test info-34.0 {eval pure list, single line} { + # Basically, counting the newline in the word seen through $foo + # doesn't really make sense. It makes a bit of sense if the word + # would have been a string literal in the command list. + # + # Problem: At the point where we see the list elements we cannot + # distinguish the two cases, thus we cannot switch between + # count/not-count, it is has to be one or the other for all + # cases. Of the two possibilities miguel convinced me that 'not + # counting' is the more proper. + set foo {b + c} + set cmd [list foreach $foo {x y} { + set res [join [lrange [etrace] 0 2] \n] + break + }] + eval $cmd + set res +} {10 {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0} +9 {type eval line 2 cmd etrace proc ::tcltest::RunTest} +8 {type eval line 1 cmd foreac proc ::tcltest::RunTest}} + +# ------------------------------------------------------------------------- + +# ------------------------------------------------------------------------- + # cleanup catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests |