diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 39 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 | ||||
| -rw-r--r-- | generic/tclListObj.c | 42 |
3 files changed, 53 insertions, 31 deletions
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 |