diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclBasic.c | 46 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 4 | ||||
| -rw-r--r-- | generic/tclCompile.c | 8 | ||||
| -rw-r--r-- | tests/info.test | 28 |
5 files changed, 72 insertions, 25 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-22 Andreas Kupries <andreask@activestate.com> * generic/tclBasic.c: Added missing function comments. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c8f8117..9cb5707 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.3 2008/07/22 22:46:27 andreas_kupries Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.295.2.4 2008/07/23 20:47:30 andreas_kupries Exp $ */ #include "tclInt.h" @@ -4745,6 +4745,18 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr) 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. */ @@ -4937,8 +4949,7 @@ TclEvalObjEx( * known. */ - int line, i; - char *w; + int nelements; Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr); CmdFrame *eoFramePtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); @@ -4949,37 +4960,34 @@ TclEvalObjEx( eoFramePtr->framePtr = iPtr->framePtr; eoFramePtr->nextPtr = iPtr->cmdFramePtr; - Tcl_ListObjGetElements(NULL, copyPtr, - &(eoFramePtr->nline), &elements); - eoFramePtr->line = (int *) - ckalloc(eoFramePtr->nline * sizeof(int)); + eoFramePtr->nline = 0; + eoFramePtr->line = NULL; eoFramePtr->cmd.listPtr = objPtr; Tcl_IncrRefCount(eoFramePtr->cmd.listPtr); 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)); - } + Tcl_ListObjGetElements(NULL, copyPtr, + &nelements, &elements); iPtr->cmdFramePtr = eoFramePtr; - result = Tcl_EvalObjv(interp, eoFramePtr->nline, elements, + result = Tcl_EvalObjv(interp, nelements, elements, flags); Tcl_DecrRefCount(copyPtr); iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr; Tcl_DecrRefCount(eoFramePtr->cmd.listPtr); - ckfree((char *) eoFramePtr->line); - eoFramePtr->line = NULL; - eoFramePtr->nline = 0; TclStackFree(interp, eoFramePtr); goto done; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index d895bf8..bbddc63 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.137.2.2 2008/07/07 21:39:49 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.137.2.3 2008/07/23 20:47:31 andreas_kupries Exp $ */ #include "tclInt.h" @@ -1158,7 +1158,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 e3ce0c9..e557860 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.146.2.4 2008/07/22 22:26:57 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.146.2.5 2008/07/23 20:47:32 andreas_kupries Exp $ */ #include "tclInt.h" @@ -915,9 +915,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 63b8a79..5a4dd13 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.1 2008/06/16 20:44:32 andreas_kupries Exp $ +# RCS: @(#) $Id: info.test,v 1.47.2.2 2008/07/23 20:47:33 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 |