summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xgeneric/tclArithSeries.c2
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclCmdAH.c10
-rw-r--r--generic/tclCmdIL.c32
-rw-r--r--generic/tclDictObj.c1
-rw-r--r--generic/tclEnsemble.c39
-rw-r--r--generic/tclEvent.c6
-rw-r--r--generic/tclExecute.c27
-rw-r--r--generic/tclIOGT.c6
-rw-r--r--generic/tclIORChan.c10
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclListObj.c126
-rw-r--r--generic/tclObj.c118
-rw-r--r--generic/tclUtil.c6
-rw-r--r--generic/tclVar.c5
15 files changed, 104 insertions, 293 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index 2cfadb7..40a78a4 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -1151,7 +1151,7 @@ ArithSeriesInOperation(
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;
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 241dc78..1997a5d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -6153,11 +6153,7 @@ TclNREvalObjEx(
*/
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) {
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 3b9e5ba..0245eed 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -2787,8 +2787,8 @@ EachloopCmd(
for (i=0 ; i<numLists ; i++) {
/* List */
/* Variables */
- statePtr->vCopyList[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;
}
@@ -2822,9 +2822,9 @@ EachloopCmd(
/* 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;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index e90b793..aed9a85 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2315,8 +2315,8 @@ Tcl_LassignObjCmd(
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 */
@@ -2485,10 +2485,7 @@ Tcl_LinsertObjCmd(
listPtr = objv[1];
if (Tcl_IsShared(listPtr)) {
- listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
- if (!listPtr) {
- return TCL_ERROR;
- }
+ listPtr = TclListObjCopy(NULL, listPtr);
copied = 1;
}
@@ -2690,10 +2687,7 @@ Tcl_LpopObjCmd(
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);
@@ -2883,11 +2877,7 @@ Tcl_LremoveObjCmd(
*/
if (Tcl_IsShared(listObj)) {
- listObj = TclDuplicatePureObj(interp, listObj, &tclListType);
- if (!listObj) {
- status = TCL_ERROR;
- goto done;
- }
+ listObj = TclListObjCopy(NULL, listObj);
copied = 1;
}
num = 0;
@@ -3139,10 +3129,7 @@ Tcl_LreplaceObjCmd(
listPtr = objv[1];
if (Tcl_IsShared(listPtr)) {
- listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
- if (!listPtr) {
- return TCL_ERROR;
- }
+ listPtr = TclListObjCopy(NULL, listPtr);
}
/*
@@ -4775,7 +4762,7 @@ Tcl_LsortObjCmd(
* 1675116]
*/
- listObj = TclDuplicatePureObj(interp ,listObj, &tclListType);
+ listObj = TclListObjCopy(interp, listObj);
if (listObj == NULL) {
sortInfo.resultCode = TCL_ERROR;
goto done;
@@ -5131,10 +5118,7 @@ Tcl_LeditObjCmd(
}
if (Tcl_IsShared(listPtr)) {
- listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
- if (!listPtr) {
- return TCL_ERROR;
- }
+ listPtr = TclListObjCopy(NULL, listPtr);
createdNewObj = 1;
} else {
createdNewObj = 0;
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 121661d..64d666f 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -3884,7 +3884,6 @@ DictAsListLength(
* The intent is to have no side effects.
*
*/
-
#if 0 /* Needs rewrite */
static int
DictAsListIndex(
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index deabfe2..671656e 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -312,17 +312,7 @@ TclNamespaceEnsembleCmd(
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);
@@ -606,14 +596,7 @@ TclNamespaceEnsembleCmd(
}
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) {
@@ -623,11 +606,7 @@ TclNamespaceEnsembleCmd(
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);
@@ -1925,11 +1904,7 @@ NsEnsembleImplementationCmdNR(
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);
@@ -2329,11 +2304,7 @@ EnsembleUnknownCallback(
* 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);
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 88a568a..8fb309d 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -232,11 +232,7 @@ HandleBgErrors(
* 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;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index aa8930d..ecc9a5b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3377,16 +3377,7 @@ TEBCresume(
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;
@@ -3445,13 +3436,7 @@ TEBCresume(
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;
@@ -6483,13 +6468,7 @@ TEBCresume(
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;
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 215c6c7..f577599 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -379,11 +379,7 @@ ExecuteCallback(
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);
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index a657021..f313ab7 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -2261,10 +2261,7 @@ NewReflectedChannel(
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) {
@@ -2401,10 +2398,7 @@ InvokeTclMethod(
* 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);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 00dafc6..a2e8a51 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3260,8 +3260,6 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
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,
@@ -3392,6 +3390,7 @@ 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[]);
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index fd69c96..546f444 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1317,6 +1317,50 @@ 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 *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 --
@@ -2528,7 +2572,6 @@ TclLindexList(
Tcl_Obj *indexListCopy;
Tcl_Obj **indexObjs;
Tcl_Size numIndexObjs;
- int status;
/*
* Determine whether argPtr designates a list or a single index. We have
@@ -2546,30 +2589,19 @@ TclLindexList(
}
/*
- * 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) {
- /*
- * 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);
+ indexListCopy = TclListObjCopy(NULL, argObj);
+ if (indexListCopy == NULL) {
/*
* The argument is neither an index nor a well-formed list.
* Report the error via TclLindexFlat.
@@ -2577,6 +2609,7 @@ TclLindexList(
*/
return TclLindexFlat(interp, listObj, 1, &argObj);
}
+ TclListObjGetElementsM(interp, indexListCopy, &numIndexObjs, &indexObjs);
listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);
Tcl_DecrRefCount(indexListCopy);
return listObj;
@@ -2768,8 +2801,7 @@ TclLsetList(
} else {
- indexListCopy = TclDuplicatePureObj(
- interp, indexArgObj, &tclListType);
+ indexListCopy = TclListObjCopy(NULL,indexArgObj);
if (!indexListCopy) {
/*
* indexArgPtr designates something that is neither an index nor a
@@ -2848,7 +2880,7 @@ TclLsetFlat(
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;
@@ -2868,15 +2900,17 @@ TclLsetFlat(
}
/*
- * 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
@@ -2954,9 +2988,10 @@ TclLsetFlat(
}
/*
- * 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) {
@@ -2967,12 +3002,7 @@ TclLsetFlat(
subListObj = elemPtrs[index];
}
if (Tcl_IsShared(subListObj)) {
- subListObj = TclDuplicatePureObj(
- interp, subListObj, &tclListType);
- if (!subListObj) {
- return NULL;
- }
- copied = 1;
+ subListObj = Tcl_DuplicateObj(subListObj);
}
/*
@@ -2990,17 +3020,7 @@ TclLsetFlat(
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);
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 8b0aa47..9ddb397 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -202,9 +202,6 @@ 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.
@@ -1529,14 +1526,6 @@ TclObjBeingDeleted(
* 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
@@ -1588,113 +1577,6 @@ Tcl_DuplicateObj(
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,
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 858a490..7bafdf7 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2010,11 +2010,7 @@ Tcl_ConcatObj(
}
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) {
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 326009b..31312e1 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -3099,7 +3099,7 @@ ArrayForNRCmd(
* loop) don't vanish.
*/
- varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType);
+ varListObj = TclListObjCopy(NULL, objv[1]);
if (!varListObj) {
return TCL_ERROR;
}
@@ -4075,8 +4075,7 @@ ArraySetCmd(
* the loop and return an error.
*/
- copyListObj =
- TclDuplicatePureObj(interp, arrayElemObj, &tclListType);
+ copyListObj = TclListObjCopy(NULL, arrayElemObj);
if (!copyListObj) {
return TCL_ERROR;
}
generated by cgit v0.12 at 2025-12-13 09:20:08 (GMT)