From 1ec6598ede90826c668a7d40db73a95ef3a3edb8 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 21 Aug 2023 18:07:48 +0000 Subject: The experiment deployment of TclDuplicatePureObj() has been reverted from the trunk. This branch attempts to prepare a reversion for the core-8-branch also, via a cherrypick and resolution of conflicts. Starting an experiment in one new release to reject it in the next is at best odd. Also, valgrind test runs of core-8-branch show memory leaks with TclDuplicatePureObj() on the stack trace. This checkin shows a clean valgrind run. There are three test failures on this checkin, which I hope someone versed in the ArithSeries work can resolve. They are the tests: lseq-3.14 lseq-4.19 lseq-bug-54329e39c7 merge bug-bc7ddc7944 (revert use of TclDuplicatePureObj) --- generic/tclBasic.c | 6 +-- generic/tclCmdAH.c | 10 ++-- generic/tclCmdIL.c | 30 +++--------- generic/tclEnsemble.c | 6 +-- generic/tclEvent.c | 6 +-- generic/tclExecute.c | 8 +--- generic/tclIOGT.c | 6 +-- generic/tclIORChan.c | 10 +--- generic/tclInt.h | 3 +- generic/tclListObj.c | 123 ++++++++++++++++++++++++++++---------------------- generic/tclObj.c | 119 ------------------------------------------------ generic/tclUtil.c | 6 +-- generic/tclVar.c | 5 +- 13 files changed, 93 insertions(+), 245 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7754f71..b7bc311 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6658,11 +6658,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 9c9cc26..8bc43d3 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2927,9 +2927,8 @@ EachloopCmd( for (i=0 ; ivCopyList[i] = TclDuplicatePureObj( - interp, objv[1+i*2], &tclListType); - if (!statePtr->vCopyList[i]) { + statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]); + if (statePtr->vCopyList[i] == NULL) { result = TCL_ERROR; goto done; } @@ -2964,9 +2963,8 @@ EachloopCmd( statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->aCopyList[i]); } else { /* List values */ - statePtr->aCopyList[i] = TclDuplicatePureObj( - interp, objv[2+i*2], &tclListType); - if (!statePtr->aCopyList[i]) { + 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 dd8349f..65f1562 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2333,7 +2333,7 @@ Tcl_LassignObjCmd( return TCL_ERROR; } - listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType); + listCopyPtr = TclListObjCopy(interp, objv[1]); if (listCopyPtr == NULL) { return TCL_ERROR; } @@ -2498,10 +2498,7 @@ Tcl_LinsertObjCmd( listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { - listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); - if (!listPtr) { - return TCL_ERROR; - } + listPtr = TclListObjCopy(NULL, listPtr); } if ((objc == 4) && (index == len)) { @@ -2688,10 +2685,7 @@ Tcl_LpopObjCmd( if (objc == 2) { if (Tcl_IsShared(listPtr)) { - listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); - if (!listPtr) { - return TCL_ERROR; - } + listPtr = TclListObjCopy(NULL, listPtr); } result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL); if (result != TCL_OK) { @@ -2868,11 +2862,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; @@ -3124,10 +3114,7 @@ Tcl_LreplaceObjCmd( listPtr = objv[1]; if (Tcl_IsShared(listPtr)) { - listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType); - if (!listPtr) { - return TCL_ERROR; - } + listPtr = TclListObjCopy(NULL, listPtr); } /* @@ -4743,7 +4730,7 @@ Tcl_LsortObjCmd( * 1675116] */ - listObj = TclDuplicatePureObj(interp ,listObj, &tclListType); + listObj = TclListObjCopy(interp, listObj); if (listObj == NULL) { sortInfo.resultCode = TCL_ERROR; goto done; @@ -5101,10 +5088,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/tclEnsemble.c b/generic/tclEnsemble.c index 610198c..b946a84 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1900,11 +1900,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); diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 5848728..5501721 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -243,11 +243,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 674406c..d7055f2 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -6692,7 +6692,7 @@ TEBCresume( numVars = varListPtr->numVars; listVarPtr = LOCAL(listTmpIndex); - listPtr = TclDuplicatePureObj(NULL, listVarPtr->value.objPtr, &tclListType); + listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); TclListObjGetElementsM(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); @@ -6789,11 +6789,7 @@ TEBCresume( goto gotError; } if (Tcl_IsShared(listPtr)) { - /* Do NOT use TclDuplicatePureObj here - shimmers abstract list to list */ - objPtr = Tcl_DuplicateObj(listPtr); - 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 77ea6bd..93442a1 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -387,11 +387,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 3b1573b..0af76bf 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -2285,10 +2285,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) { @@ -2425,10 +2422,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 a7a9552..e873538 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3142,8 +3142,6 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr); -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, @@ -3273,6 +3271,7 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, /* 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 f1b5258..150de6d 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1342,6 +1342,47 @@ 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 (SetListFromAny(interp, listObj) != TCL_OK) { + return NULL; + } + } + + TclNewObj(copyObj); + TclInvalidateStringRep(copyObj); + DupListInternalRep(listObj, copyObj); + return copyObj; +} + +/* *------------------------------------------------------------------------ * * ListRepRange -- @@ -2513,7 +2554,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 @@ -2531,30 +2571,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. @@ -2562,6 +2591,7 @@ TclLindexList( */ return TclLindexFlat(interp, listObj, 1, &argObj); } + TclListObjGetElementsM(interp, indexListCopy, &numIndexObjs, &indexObjs); listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs); Tcl_DecrRefCount(indexListCopy); return listObj; @@ -2744,8 +2774,7 @@ TclLsetList( } else { - indexListCopy = TclDuplicatePureObj( - interp, indexArgObj, &tclListType); + indexListCopy = TclListObjCopy(NULL,indexArgObj); if (!indexListCopy) { /* * indexArgPtr designates something that is neither an index nor a @@ -2823,7 +2852,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; @@ -2843,15 +2872,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 @@ -2924,9 +2955,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) { @@ -2937,12 +2969,7 @@ TclLsetFlat( subListObj = elemPtrs[index]; } if (Tcl_IsShared(subListObj)) { - subListObj = TclDuplicatePureObj( - interp, subListObj, &tclListType); - if (!subListObj) { - return NULL; - } - copied = 1; + subListObj = Tcl_DuplicateObj(subListObj); } /* @@ -2960,17 +2987,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 96ad9e6..d440f9f 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -205,9 +205,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. @@ -1545,14 +1542,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 @@ -1604,114 +1593,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; - - 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 != typePtr) { - if (bytes) { - dupPtr->bytes = bytes; - dupPtr->length = objPtr->length; - } - /* borrow bytes from original object */ - status = Tcl_ConvertToType(interp, dupPtr, typePtr); - if (bytes) { - dupPtr->bytes = NULL; - dupPtr->length = 0; - } - if (status != TCL_OK) { - return status; - } - } - - /* tclUniCharStringType 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 tclUniCharStringType 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. - * - * Similar problem with the integer (0x0A vs 10), double (1e-1 vs 0.1) and - * index types ("coord" vs "coords", see bug [a34733451b]) - */ - - - if (bytes && (dupPtr->typePtr == NULL - || dupPtr->typePtr->updateStringProc == NULL - || objPtr->typePtr == &tclUniCharStringType - ) - ) { - 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 cfc56b0..f9f6ae0 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2051,11 +2051,7 @@ Tcl_ConcatObj( goto slow; } } 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 70ba63b..1ed3eae 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -3221,7 +3221,7 @@ ArrayForNRCmd( * loop) don't vanish. */ - varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType); + varListObj = TclListObjCopy(NULL, objv[1]); if (!varListObj) { return TCL_ERROR; } @@ -4196,8 +4196,7 @@ ArraySetCmd( * the loop and return an error. */ - copyListObj = - TclDuplicatePureObj(interp, arrayElemObj, &tclListType); + copyListObj = TclListObjCopy(NULL, arrayElemObj); if (!copyListObj) { return TCL_ERROR; } -- cgit v0.12 From 24ad01e41de685c378459e7176554c77dfcf917f Mon Sep 17 00:00:00 2001 From: griffin Date: Tue, 22 Aug 2023 19:53:59 +0000 Subject: Thanks for cherrypicking this change for 8.7. 'Someone versed in the ArithSeries work' has fixed the regressions. The ArithSeries in 8.7 is a precursor one-off of Abstact Lists. --- generic/tclCmdAH.c | 4 +++- generic/tclExecute.c | 6 ++++-- generic/tclVar.c | 3 ++- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 8bc43d3..07be21d 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2927,7 +2927,9 @@ EachloopCmd( for (i=0 ; ivCopyList[i] = TclListObjCopy(interp, objv[1+i*2]); + + /* Do not use TclListObjCopy here - shimmers arithseries to list */ + statePtr->vCopyList[i] = Tcl_DuplicateObj(objv[1+i*2]); if (statePtr->vCopyList[i] == NULL) { result = TCL_ERROR; goto done; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d7055f2..c62159a 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -6692,7 +6692,8 @@ TEBCresume( numVars = varListPtr->numVars; listVarPtr = LOCAL(listTmpIndex); - listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); + /* Do not use TclListObjCopy here - shimmers arithseries to list */ + listPtr = Tcl_DuplicateObj(listVarPtr->value.objPtr); TclListObjGetElementsM(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); @@ -6789,7 +6790,8 @@ TEBCresume( goto gotError; } if (Tcl_IsShared(listPtr)) { - objPtr = TclListObjCopy(NULL, listPtr); + /* Do not use TclListObjCopy here - shimmers arithseries to list */ + objPtr = Tcl_DuplicateObj(listPtr); Tcl_IncrRefCount(objPtr); Tcl_DecrRefCount(listPtr); OBJ_AT_DEPTH(listTmpDepth) = objPtr; diff --git a/generic/tclVar.c b/generic/tclVar.c index 1ed3eae..4110d81 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -3221,7 +3221,8 @@ ArrayForNRCmd( * loop) don't vanish. */ - varListObj = TclListObjCopy(NULL, objv[1]); + /* Do not use TclListObjCopy here - shimmers arithseries to list */ + varListObj = Tcl_DuplicateObj(objv[1]); if (!varListObj) { return TCL_ERROR; } -- cgit v0.12