Index: generic/tclArithSeries.c ================================================================== --- generic/tclArithSeries.c +++ generic/tclArithSeries.c @@ -1149,11 +1149,11 @@ incr = 0; // Check index+incr where incr is 0 and 1 status = Tcl_GetDoubleFromObj(interp, valueObj, &y); if (status != TCL_OK) { test = 0; } else { - char *vstr = Tcl_GetStringFromObj(valueObj, &vlen); + const char *vstr = Tcl_GetStringFromObj(valueObj, &vlen); index = (y - dblRepPtr->start) / dblRepPtr->step; while (incr<2) { Tcl_Obj *elemObj; elen = 0; TclArithSeriesObjIndex(interp, arithSeriesObjPtr, (index+incr), &elemObj); Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -6151,15 +6151,11 @@ * TODO: Create a test to demo this need, or eliminate it. * FIXME OPT: preserve just the internal rep? */ Tcl_IncrRefCount(objPtr); - listPtr = TclDuplicatePureObj(interp, objPtr, &tclListType); - if (!listPtr) { - Tcl_DecrRefCount(objPtr); - return TCL_ERROR; - } + listPtr = TclListObjCopy(interp, objPtr); Tcl_IncrRefCount(listPtr); if (word != INT_MIN) { /* * TIP #280 Structures for tracking lines. As we know that this is Index: generic/tclCmdAH.c ================================================================== --- generic/tclCmdAH.c +++ generic/tclCmdAH.c @@ -2785,12 +2785,12 @@ */ for (i=0 ; ivCopyList[i] = Tcl_DuplicateObj(objv[1+i*2]); - if (!statePtr->vCopyList[i]) { + statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]); + if (statePtr->vCopyList[i] == NULL) { result = TCL_ERROR; goto done; } result = TclListObjLengthM(interp, statePtr->vCopyList[i], &statePtr->varcList[i]); @@ -2820,13 +2820,13 @@ goto done; } /* Don't compute values here, wait until the last moment */ statePtr->argcList[i] = TclObjTypeLength(statePtr->aCopyList[i]); } else { - statePtr->aCopyList[i] = TclDuplicatePureObj( - interp, objv[2+i*2], &tclListType); - if (!statePtr->aCopyList[i]) { + /* List values */ + statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]); + if (statePtr->aCopyList[i] == NULL) { result = TCL_ERROR; goto done; } result = TclListObjGetElementsM(interp, statePtr->aCopyList[i], &statePtr->argcList[i], &statePtr->argvList[i]); Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -2313,12 +2313,12 @@ if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?"); return TCL_ERROR; } - listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType); - if (!listCopyPtr) { + listCopyPtr = TclListObjCopy(interp, objv[1]); + if (listCopyPtr == NULL) { return TCL_ERROR; } Tcl_IncrRefCount(listCopyPtr); /* Important! fs */ code = TclListObjGetElementsM( @@ -2483,14 +2483,11 @@ * create a copy to modify: this is "copy on write". */ listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { - listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); - if (!listPtr) { - return TCL_ERROR; - } + listPtr = TclListObjCopy(NULL, listPtr); copied = 1; } if ((objc == 4) && (index == len)) { /* @@ -2688,14 +2685,11 @@ * TclLsetFlat adds a ref count which is handled. */ if (objc == 2) { if (Tcl_IsShared(listPtr)) { - listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); - if (!listPtr) { - return TCL_ERROR; - } + listPtr = TclListObjCopy(NULL, listPtr); copied = 1; } result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL); if (result != TCL_OK) { if (copied) { @@ -2881,15 +2875,11 @@ /* * Make our working copy, then do the actual removes piecemeal. */ if (Tcl_IsShared(listObj)) { - listObj = TclDuplicatePureObj(interp, listObj, &tclListType); - if (!listObj) { - status = TCL_ERROR; - goto done; - } + listObj = TclListObjCopy(NULL, listObj); copied = 1; } num = 0; first = listLen; for (i = 0, prevIdx = -1 ; i < idxc ; i++) { @@ -3137,14 +3127,11 @@ * create a copy to modify: this is "copy on write". */ listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { - listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); - if (!listPtr) { - return TCL_ERROR; - } + listPtr = TclListObjCopy(NULL, listPtr); } /* * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and * objc == 4. In this case, the list value of listPtr is not changed (no @@ -4773,11 +4760,11 @@ * have the representation of the list being sorted shimmered out from * underneath our feet. Take a copy (cheap) to prevent this. [Bug * 1675116] */ - listObj = TclDuplicatePureObj(interp ,listObj, &tclListType); + listObj = TclListObjCopy(interp, listObj); if (listObj == NULL) { sortInfo.resultCode = TCL_ERROR; goto done; } @@ -5129,14 +5116,11 @@ } else { numToDelete = 0; } if (Tcl_IsShared(listPtr)) { - listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); - if (!listPtr) { - return TCL_ERROR; - } + listPtr = TclListObjCopy(NULL, listPtr); createdNewObj = 1; } else { createdNewObj = 0; } Index: generic/tclDictObj.c ================================================================== --- generic/tclDictObj.c +++ generic/tclDictObj.c @@ -3882,11 +3882,10 @@ * Side Effects -- * * The intent is to have no side effects. * */ - #if 0 /* Needs rewrite */ static int DictAsListIndex( Tcl_Interp *interp, struct Tcl_Obj *objPtr, Index: generic/tclEnsemble.c ================================================================== --- generic/tclEnsemble.c +++ generic/tclEnsemble.c @@ -310,21 +310,11 @@ Tcl_AppendStringsToObj(newCmd, "::", NULL); } Tcl_AppendObjToObj(newCmd, listv[0]); Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd); if (patchedDict == NULL) { - patchedDict = TclDuplicatePureObj( - interp, objv[1], &tclDictType); - if (!patchedDict) { - if (allocatedMapFlag) { - Tcl_DecrRefCount(mapObj); - } - Tcl_DecrRefCount(newList); - Tcl_DecrRefCount(newCmd); - Tcl_DecrRefCount(patchedDict); - return TCL_ERROR; - } + patchedDict = Tcl_DuplicateObj(objv[1]); } Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj, newList); } Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj, @@ -604,32 +594,21 @@ } goto freeMapAndError; } cmd = TclGetString(listv[0]); if (!(cmd[0] == ':' && cmd[1] == ':')) { - Tcl_Obj *newList = TclDuplicatePureObj( - interp, listObj, &tclListType); - if (!newList) { - if (patchedDict) { - Tcl_DecrRefCount(patchedDict); - } - goto freeMapAndError; - } + Tcl_Obj *newList = Tcl_DuplicateObj(listObj); Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr); if (nsPtr->parentPtr) { Tcl_AppendStringsToObj(newCmd, "::", NULL); } Tcl_AppendObjToObj(newCmd, listv[0]); Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd); if (patchedDict == NULL) { - patchedDict = TclDuplicatePureObj( - interp, objv[1], &tclListType); - if (!patchedDict) { - goto freeMapAndError; - } + patchedDict = Tcl_DuplicateObj(objv[1]); } Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj, newList); } Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj, @@ -1923,15 +1902,11 @@ Tcl_Size copyObjc, prefixObjc; TclListObjLengthM(NULL, prefixObj, &prefixObjc); if (objc == 2) { - copyPtr = TclDuplicatePureObj( - interp, prefixObj, &tclListType); - if (!copyPtr) { - return TCL_ERROR; - } + copyPtr = TclListObjCopy(NULL, prefixObj); } else { copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL); Tcl_ListObjAppendList(NULL, copyPtr, prefixObj); Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0, ensemblePtr->numParameters, objv + 1); @@ -2327,15 +2302,11 @@ /* * Create the "unknown" command callback to determine what to do. */ - unknownCmd = TclDuplicatePureObj( - interp, ensemblePtr->unknownHandler, &tclListType); - if (!unknownCmd) { - return TCL_ERROR; - } + unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler); TclNewObj(ensObj); Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj); Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj); for (i = 1 ; i < objc ; i++) { Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]); Index: generic/tclEvent.c ================================================================== --- generic/tclEvent.c +++ generic/tclEvent.c @@ -230,15 +230,11 @@ /* * Note we copy the handler command prefix each pass through, so we do * support one handler setting another handler. */ - Tcl_Obj *copyObj = TclDuplicatePureObj( - interp, assocPtr->cmdPrefix, &tclListType); - if (!copyObj) { - return; - } + Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); errPtr = assocPtr->firstBgPtr; TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv); tempObjv = (Tcl_Obj**)Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *)); Index: generic/tclExecute.c ================================================================== --- generic/tclExecute.c +++ generic/tclExecute.c @@ -3375,20 +3375,11 @@ if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (Tcl_IsShared(objResultPtr)) { - Tcl_Obj *newValue; - - DECACHE_STACK_INFO(); - newValue = TclDuplicatePureObj(interp, objResultPtr, &tclListType); - CACHE_STACK_INFO(); - - if (!newValue) { - TRACE_ERROR(interp); - goto gotError; - } + Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr); TclDecrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr = newValue; Tcl_IncrRefCount(newValue); } @@ -3443,17 +3434,11 @@ } else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } else { if (Tcl_IsShared(objResultPtr)) { - DECACHE_STACK_INFO(); - valueToAssign = TclDuplicatePureObj( - interp, objResultPtr, &tclListType); - CACHE_STACK_INFO(); - if (!valueToAssign) { - goto errorInLappendListPtr; - } + valueToAssign = Tcl_DuplicateObj(objResultPtr); createdNewObj = 1; } else { valueToAssign = objResultPtr; } if (TclListObjAppendElements(interp, valueToAssign, @@ -6481,17 +6466,11 @@ TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s", i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } if (Tcl_IsShared(listPtr)) { - DECACHE_STACK_INFO(); - objPtr = TclDuplicatePureObj( - interp, listPtr, &tclListType); - CACHE_STACK_INFO(); - if (!objPtr) { - goto gotError; - } + objPtr = TclListObjCopy(NULL, listPtr); Tcl_IncrRefCount(objPtr); Tcl_DecrRefCount(listPtr); OBJ_AT_DEPTH(listTmpDepth) = objPtr; } iterTmp = (listLen + (numVars - 1))/numVars; Index: generic/tclIOGT.c ================================================================== --- generic/tclIOGT.c +++ generic/tclIOGT.c @@ -377,15 +377,11 @@ Tcl_Obj *resObj; /* See below, switch (transmit). */ Tcl_Size resLen = 0; unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; - Tcl_Obj *command = TclDuplicatePureObj( - interp, dataPtr->command, &tclListType); - if (!command) { - return TCL_ERROR; - } + Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command); Tcl_Interp *eval = dataPtr->interp; Tcl_Preserve(eval); /* Index: generic/tclIORChan.c ================================================================== --- generic/tclIORChan.c +++ generic/tclIORChan.c @@ -2259,14 +2259,11 @@ rcPtr->thread = Tcl_GetCurrentThread(); #endif rcPtr->mode = mode; rcPtr->interest = 0; /* Initially no interest registered */ - rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, &tclListType); - if (!rcPtr->cmd) { - return NULL; - } + rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); Tcl_IncrRefCount(rcPtr->cmd); rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); while (mn <= (int)METH_WRITE) { Tcl_ListObjAppendElement(NULL, rcPtr->methods, Tcl_NewStringObj(methodNames[mn++], -1)); @@ -2399,14 +2396,11 @@ /* * Insert method into the callback command, after the command prefix, * before the channel id. */ - cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, &tclListType); - if (!cmd) { - return TCL_ERROR; - } + cmd = TclListObjCopy(NULL, rcPtr->cmd); Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); Tcl_ListObjAppendElement(NULL, cmd, methObj); Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); /* Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -3258,12 +3258,10 @@ const char *name, Tcl_Namespace *nameNamespacePtr, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr); MODULE_SCOPE Tcl_Size TclDictGetSize(Tcl_Obj *dictPtr); -MODULE_SCOPE Tcl_Obj *TclDuplicatePureObj(Tcl_Interp *interp, - Tcl_Obj * objPtr, const Tcl_ObjType *typPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, Tcl_Size dictLength, const char **elementPtr, const char **nextPtr, Tcl_Size *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ @@ -3390,10 +3388,11 @@ Tcl_Size indexCount, Tcl_Obj *const indexArray[]); MODULE_SCOPE Tcl_Obj * TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index); /* TIP #280 */ MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, Tcl_Size n, Tcl_Size *lines, Tcl_Obj *const *elems); +MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp, Tcl_Obj *toObj, Tcl_Size elemCount, Tcl_Obj *const elemObjv[]); MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size fromIdx, Tcl_Size toIdx); Index: generic/tclListObj.c ================================================================== --- generic/tclListObj.c +++ generic/tclListObj.c @@ -1313,10 +1313,54 @@ TclFreeInternalRep(objPtr); TclInvalidateStringRep(objPtr); Tcl_InitStringRep(objPtr, NULL, 0); } } + +/* + *---------------------------------------------------------------------- + * + * 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 *listObj) /* List object for which an element array is + * to be returned. */ +{ + Tcl_Obj *copyObj; + + if (!TclHasInternalRep(listObj, &tclListType)) { + if (TclObjTypeHasProc(listObj, lengthProc)) { + return Tcl_DuplicateObj(listObj); + } + if (SetListFromAny(interp, listObj) != TCL_OK) { + return NULL; + } + } + + TclNewObj(copyObj); + TclInvalidateStringRep(copyObj); + DupListInternalRep(listObj, copyObj); + return copyObj; +} /* *------------------------------------------------------------------------ * * ListRepRange -- @@ -2526,11 +2570,10 @@ { Tcl_Size index; /* Index into the list. */ Tcl_Obj *indexListCopy; Tcl_Obj **indexObjs; Tcl_Size numIndexObjs; - int status; /* * Determine whether argPtr designates a list or a single index. We have * to be careful about the order of the checks to avoid repeated * shimmering; if internal rep is already a list do not shimmer it. @@ -2544,41 +2587,31 @@ */ return TclLindexFlat(interp, listObj, 1, &argObj); } /* - * Make a private copy of the index list argument to keep the internal - * representation of the indices array unchanged while it is in use. This - * is probably unnecessary. It does not appear that any damaging change to - * the internal representation is possible, and no test has been devised to - * show any error when this private copy is not made, But it's cheap, and - * it offers some future-proofing insurance in case the TclLindexFlat - * implementation changes in some unexpected way, or some new form of trace - * or callback permits things to happen that the current implementation - * does not. + * Here we make a private copy of the index list argument to avoid any + * shimmering issues that might invalidate the indices array below while + * we are still using it. This is probably unnecessary. It does not appear + * that any damaging shimmering is possible, and no test has been devised + * to show any error when this private copy is not made. But it's cheap, + * and it offers some future-proofing insurance in case the TclLindexFlat + * implementation changes in some unexpected way, or some new form of + * trace or callback permits things to happen that the current + * implementation does not. */ - indexListCopy = TclDuplicatePureObj(interp, argObj, &tclListType); - if (!indexListCopy) { + indexListCopy = TclListObjCopy(NULL, argObj); + if (indexListCopy == NULL) { /* * The argument is neither an index nor a well-formed list. * Report the error via TclLindexFlat. * TODO - This is as original code. why not directly return an error? */ return TclLindexFlat(interp, listObj, 1, &argObj); } - status = TclListObjGetElementsM( - interp, indexListCopy, &numIndexObjs, &indexObjs); - if (status != TCL_OK) { - Tcl_DecrRefCount(indexListCopy); - /* - * The argument is neither an index nor a well-formed list. - * Report the error via TclLindexFlat. - * TODO - This is as original code. why not directly return an error? - */ - return TclLindexFlat(interp, listObj, 1, &argObj); - } + TclListObjGetElementsM(interp, indexListCopy, &numIndexObjs, &indexObjs); listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs); Tcl_DecrRefCount(indexListCopy); return listObj; } @@ -2766,12 +2799,11 @@ retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj); } } else { - indexListCopy = TclDuplicatePureObj( - interp, indexArgObj, &tclListType); + indexListCopy = TclListObjCopy(NULL,indexArgObj); if (!indexListCopy) { /* * indexArgPtr designates something that is neither an index nor a * well formed list. Report the error via TclLsetFlat. */ @@ -2846,11 +2878,11 @@ Tcl_Obj *const indexArray[], /* Index args. */ Tcl_Obj *valueObj) /* Value arg to 'lset' or NULL to 'lpop'. */ { Tcl_Size index, len; - int copied = 0, result; + int result; Tcl_Obj *subListObj, *retValueObj; Tcl_Obj *pendingInvalidates[10]; Tcl_Obj **pendingInvalidatesPtr = pendingInvalidates; Tcl_Size numPendingInvalidates = 0; @@ -2866,19 +2898,21 @@ } return valueObj; } /* - * If the list is shared, make a copy to modify (copy-on-write). The string - * representation and internal representation of listObj remains unchanged. + * If the list is shared, make a copy we can modify (copy-on-write). We + * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons: + * 1) we have not yet confirmed listObj is actually a list; 2) We make a + * verbatim copy of any existing string rep, and when we combine that with + * the delayed invalidation of string reps of modified Tcl_Obj's + * implemented below, the outcome is that any error condition that causes + * this routine to return NULL, will leave the string rep of listObj and + * all elements to be unchanged. */ - subListObj = Tcl_IsShared(listObj) - ? TclDuplicatePureObj(interp, listObj, &tclListType) : listObj; - if (!subListObj) { - return NULL; - } + subListObj = Tcl_IsShared(listObj) ? Tcl_DuplicateObj(listObj) : listObj; /* * Anchor the linked list of Tcl_Obj's whose string reps must be * invalidated if the operation succeeds. */ @@ -2952,13 +2986,14 @@ result = TCL_ERROR; break; } /* - * No error conditions. If this is not the last index, determine the - * next sublist for the next pass through the loop, and take steps to - * make sure it is unshared in order to modify it. + * No error conditions. As long as we're not yet on the last index, + * determine the next sublist for the next pass through the loop, + * and take steps to make sure it is an unshared copy, as we intend + * to modify it. */ if (--indexCount) { parentList = subListObj; if (index == elemCount) { @@ -2965,16 +3000,11 @@ TclNewObj(subListObj); } else { subListObj = elemPtrs[index]; } if (Tcl_IsShared(subListObj)) { - subListObj = TclDuplicatePureObj( - interp, subListObj, &tclListType); - if (!subListObj) { - return NULL; - } - copied = 1; + subListObj = Tcl_DuplicateObj(subListObj); } /* * Replace the original elemPtr[index] in parentList with a copy * we know to be unshared. This call will also deal with the @@ -2988,21 +3018,11 @@ Tcl_ListObjAppendElement(NULL, parentList, subListObj); } else { TclListObjSetElement(NULL, parentList, index, subListObj); } if (Tcl_IsShared(subListObj)) { - Tcl_Obj * newSubListObj; - newSubListObj = TclDuplicatePureObj( - interp, subListObj, &tclListType); - if (copied) { - Tcl_DecrRefCount(subListObj); - } - if (newSubListObj) { - subListObj = newSubListObj; - } else { - return NULL; - } + subListObj = Tcl_DuplicateObj(subListObj); TclListObjSetElement(NULL, parentList, index, subListObj); } /* * The TclListObjSetElement() calls do not spoil the string rep Index: generic/tclObj.c ================================================================== --- generic/tclObj.c +++ generic/tclObj.c @@ -200,13 +200,10 @@ static void FreeBignum(Tcl_Obj *objPtr); static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void UpdateStringOfBignum(Tcl_Obj *objPtr); static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int copy, mp_int *bignumValue); -static int SetDuplicatePureObj(Tcl_Interp *interp, - Tcl_Obj *dupPtr, Tcl_Obj *objPtr, - const Tcl_ObjType *typePtr); /* * Prototypes for the array hash key methods. */ @@ -1527,18 +1524,10 @@ * Tcl_DuplicateObj -- * * Create and return a new object that is a duplicate of the argument * object. * - * TclDuplicatePureObj -- - * Like Tcl_DuplicateObj, except that it converts the duplicate to the - * specifid typ, does not duplicate the 'bytes' - * field unless it is necessary, i.e. the duplicated Tcl_Obj provides no - * updateStringProc. This can avoid an expensive memory allocation since - * the data in the 'bytes' field of each Tcl_Obj must reside in allocated - * memory. - * * Results: * The return value is a pointer to a newly created Tcl_Obj. This object * has reference count 0 and the same type, if any, as the source object * objPtr. Also: * 1) If the source object has a valid string rep, we copy it; @@ -1585,117 +1574,10 @@ TclNewObj(dupPtr); SetDuplicateObj(dupPtr, objPtr); return dupPtr; } - - -/* - *---------------------------------------------------------------------- - * - * TclDuplicatePureObj -- - * - * Duplicates a Tcl_Obj and converts the internal representation of the - * duplicate to the given type, changing neither the 'bytes' field - * nor the internal representation of the original object, and without - * duplicating the bytes field unless necessary, i.e. unless the - * duplicate provides no updateStringProc after conversion. This can - * avoid an expensive memory allocation since the data in the 'bytes' - * field of each Tcl_Obj must reside in allocated memory. - * - * Results: - * A pointer to a newly-created Tcl_Obj or NULL if there was an error. - * This object has reference count 0. Also: - * - *---------------------------------------------------------------------- - */ -int SetDuplicatePureObj( - Tcl_Interp *interp, - Tcl_Obj *dupPtr, - Tcl_Obj *objPtr, - const Tcl_ObjType *typePtr) -{ - char *bytes = objPtr->bytes; - int status = TCL_OK; - const Tcl_ObjType *useTypePtr = - objPtr->typePtr ? objPtr->typePtr : typePtr; - - TclInvalidateStringRep(dupPtr); - assert(dupPtr->typePtr == NULL); - - if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) { - objPtr->typePtr->dupIntRepProc(objPtr, dupPtr); - } else { - dupPtr->internalRep = objPtr->internalRep; - dupPtr->typePtr = objPtr->typePtr; - } - - if (typePtr != NULL && dupPtr->typePtr != useTypePtr) { - if (bytes) { - dupPtr->bytes = bytes; - dupPtr->length = objPtr->length; - } - /* borrow bytes from original object */ - status = Tcl_ConvertToType(interp, dupPtr, useTypePtr); - if (bytes) { - dupPtr->bytes = NULL; - dupPtr->length = 0; - } - if (status != TCL_OK) { - return status; - } - } - - /* tclStringType is treated as a special case because a Tcl_Obj having this - * type can not always update the string representation. This happens, for - * example, when Tcl_GetCharLength() converts the internal representation - * to tclStringType in order to store the number of characters, but does - * not store enough information to generate the string representation. - * - * Perhaps in the future this can be remedied and this special treatment - * removed. - */ - - - if (bytes && (dupPtr->typePtr == NULL - || dupPtr->typePtr->updateStringProc == NULL - || useTypePtr == &tclStringType - ) - ) { - if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to initialize string", -1)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - status = TCL_ERROR; - } - } - return status; -} - -Tcl_Obj * -TclDuplicatePureObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr, - const Tcl_ObjType *typePtr -) /* The object to duplicate. */ -{ - int status; - Tcl_Obj *dupPtr; - - TclNewObj(dupPtr); - status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr); - if (status == TCL_OK) { - return dupPtr; - } else { - Tcl_DecrRefCount(dupPtr); - return NULL; - } -} - - void TclSetDuplicateObj( Tcl_Obj *dupPtr, Tcl_Obj *objPtr) Index: generic/tclUtil.c ================================================================== --- generic/tclUtil.c +++ generic/tclUtil.c @@ -2008,15 +2008,11 @@ Tcl_BounceRefCount(elemPtr); // could be an abstract list element goto slow; } Tcl_BounceRefCount(elemPtr); // could be an an abstract list element } else { - resPtr = TclDuplicatePureObj( - NULL, objPtr, &tclListType); - if (!resPtr) { - return NULL; - } + resPtr = TclListObjCopy(NULL, objPtr); } } if (!resPtr) { TclNewObj(resPtr); } Index: generic/tclVar.c ================================================================== --- generic/tclVar.c +++ generic/tclVar.c @@ -3097,11 +3097,11 @@ /* * Make sure that these objects (which we need throughout the body of the * loop) don't vanish. */ - varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType); + varListObj = TclListObjCopy(NULL, objv[1]); if (!varListObj) { return TCL_ERROR; } scriptObj = objv[3]; Tcl_IncrRefCount(scriptObj); @@ -4073,12 +4073,11 @@ * We needn't worry about traces invalidating arrayPtr: should that be * the case, TclPtrSetVarIdx will return NULL so that we break out of * the loop and return an error. */ - copyListObj = - TclDuplicatePureObj(interp, arrayElemObj, &tclListType); + copyListObj = TclListObjCopy(NULL, arrayElemObj); if (!copyListObj) { return TCL_ERROR; } for (i=0 ; i