* 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.

5 files changed, 69 insertions, 29 deletions

diff --git a/ChangeLog b/ChangeLog
index a5a8a89..6ab9250 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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