summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-02-24 18:55:42 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-02-24 18:55:42 (GMT)
commitf3533a9258ecec84b776d21653f7d91abdf67831 (patch)
treef723d3e8039a85dd9ef7a2b6fb219fc521969795
parent3ca3d6597115aa1983bd3504e95769eadba4a594 (diff)
downloadtcl-f3533a9258ecec84b776d21653f7d91abdf67831.zip
tcl-f3533a9258ecec84b776d21653f7d91abdf67831.tar.gz
tcl-f3533a9258ecec84b776d21653f7d91abdf67831.tar.bz2
* 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.
-rw-r--r--ChangeLog13
-rw-r--r--generic/tclBasic.c39
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclListObj.c42
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