* generic/tclBasic.c: Use new interface in Tcl_EvalObjEx so that

        the recounting logic of the List internal rep need not be repeated
        there.  Better encapsulation of internal details.

        * generic/tclInt.h:     New internal routine TclListObjCopy() used
        * generic/tclListObj.c: to efficiently do the equivalent of
        [lrange $list 0 end].  After some experience with this, might be
        a good candidate for exposure as a public interface.  It's useful
        for callers of Tcl_ListObjGetElements() who want to control the
        ongoing validity of the returned objv pointer.

4 files changed, 66 insertions, 31 deletions

diff --git a/ChangeLog b/ChangeLog
index 4224546..6fda366 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2007-02-24  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclBasic.c:	Use new interface in Tcl_EvalObjEx so that
+	the recounting logic of the List internal rep need not be repeated
+	there.  Better encapsulation of internal details.
+
+	* generic/tclInt.h:	New internal routine TclListObjCopy() used
+	* generic/tclListObj.c:	to efficiently do the equivalent of
+	[lrange $list 0 end].  After some experience with this, might be
+	a good candidate for exposure as a public interface.  It's useful
+	for callers of Tcl_ListObjGetElements() who want to control the
+	ongoing validity of the returned objv pointer.
+
 2007-02-22  Andreas Kupries  <andreask@activestate.com>
 
 	* tests/pkg.test: Added tests for the case of an alpha package
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cf57f69..5e9b082 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -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: tclBasic.c,v 1.235 2007/02/20 23:24:02 nijtmans Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.236 2007/02/24 18:55:42 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -4557,9 +4557,8 @@ TclEvalObjEx(
 	 */
 
 	if (objPtr->typePtr == &tclListType) {	/* is a list... */
-	    List *listRepPtr;
-
-	    listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1;
+	    List *listRepPtr =
+		    (List *) objPtr->internalRep.twoPtrValue.ptr1;
 
 	    if (objPtr->bytes == NULL ||	/* ...without a string rep */
 		    listRepPtr->canonicalFlag) {/* ...or that is canonical */
@@ -4572,14 +4571,17 @@ TclEvalObjEx(
 		int line, i;
 		char *w;
 		CmdFrame eoFrame;
-		Tcl_Obj **elements = &listRepPtr->elements;
+		Tcl_Obj *copyPtr = TclListObjCopy(NULL, objPtr);
+		Tcl_Obj **elements;
 
 		eoFrame.type = TCL_LOCATION_EVAL_LIST;
 		eoFrame.level = (iPtr->cmdFramePtr == NULL?
 			1 : iPtr->cmdFramePtr->level + 1);
 		eoFrame.framePtr = iPtr->framePtr;
 		eoFrame.nextPtr = iPtr->cmdFramePtr;
-		eoFrame.nline = listRepPtr->elemCount;
+
+		Tcl_ListObjGetElements(NULL, copyPtr,
+			&eoFrame.nline, &elements);
 		eoFrame.line = (int *) ckalloc(eoFrame.nline * sizeof(int));
 
 		eoFrame.cmd.listPtr  = objPtr;
@@ -4587,16 +4589,10 @@ TclEvalObjEx(
 		eoFrame.data.eval.path = NULL;
 
 		/*
-		 * Increase the reference count of the List structure, to
-		 * avoid a segfault if objPtr loses its List internal rep [Bug
-		 * 1119369]
-		 *
 		 * TIP #280 Computes all the line numbers for the words in the
 		 * command.
 		 */
 
-		listRepPtr->refCount++;
-
 		line = 1;
 		for (i=0; i < eoFrame.nline; i++) {
 		    eoFrame.line[i] = line;
@@ -4605,26 +4601,11 @@ TclEvalObjEx(
 		}
 
 		iPtr->cmdFramePtr = &eoFrame;
-		result = Tcl_EvalObjv(interp, listRepPtr->elemCount,
-			&listRepPtr->elements, flags);
+		result = Tcl_EvalObjv(interp, eoFrame.nline, elements, flags);
 
+		Tcl_DecrRefCount(copyPtr);
 		iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
 		Tcl_DecrRefCount(eoFrame.cmd.listPtr);
-
-		/*
-		 * If we are the last users of listRepPtr, free it.
-		 */
-
-		if (--listRepPtr->refCount <= 0) {
-		    int i, elemCount = listRepPtr->elemCount;
-		    Tcl_Obj **elements = &listRepPtr->elements;
-
-		    for (i=0; i<elemCount; i++) {
-			Tcl_DecrRefCount(elements[i]);
-		    }
-		    ckfree((char *) listRepPtr);
-		}
-
 		ckfree((char *) eoFrame.line);
 		eoFrame.line = NULL;
 		eoFrame.nline = 0;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e28e849..967cec8 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.300 2006/12/01 15:55:45 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.301 2007/02/24 18:55:43 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -2299,6 +2299,7 @@ MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
 /* TIP #280 */
 MODULE_SCOPE void       TclListLines (CONST char* listStr, int line,
 				      int n, int* lines);
+MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
 MODULE_SCOPE int	TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    int symc, CONST char *symbols[],
 			    Tcl_PackageInitProc **procPtrs[],
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 9f15cd2..35db836 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclListObj.c,v 1.34 2006/11/08 13:47:07 dkf Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.35 2007/02/24 18:55:43 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -345,6 +345,46 @@ Tcl_SetListObj(
 /*
  *----------------------------------------------------------------------
  *
+ * TclListObjCopy --
+ *
+ *	Makes a "pure list" copy of a list value.  This provides for the
+ *	C level a counterpart of the [lrange $list 0 end] command, while
+ *	using internals details to be as efficient as possible.
+ *
+ * Results:
+ *	Normally returns a pointer to a new Tcl_Obj, that contains the
+ *	same list value as *listPtr does.  The returned Tcl_Obj has
+ *	a refCount of zero.  If *listPtr does not hold a list, NULL
+ *	is returned, and if interp is non-NULL, an error message is
+ *	recorded there.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclListObjCopy(
+    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
+    Tcl_Obj *listPtr)		/* List object for which an element array is
+				 * to be returned. */
+{
+    Tcl_Obj *copyPtr;
+    if (listPtr->typePtr != &tclListType) {
+	if (SetListFromAny(interp, listPtr) != TCL_OK) {
+	    return NULL;
+	}
+    }
+    TclNewObj(copyPtr);
+    TclInvalidateStringRep(copyPtr);
+    DupListInternalRep(listPtr, copyPtr);
+    return copyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ListObjGetElements --
  *
  *	This function returns an (objc,objv) array of the elements in a list