Merge main

After the presentation on Abstract Lists at the 2023 OpenACS/Tcl
Conference, there was a strong opinion that this function should be
renamed. The results of an informal poll had a tie between
Tcl_DoneWithObj() and Tcl_BounceRefCount(). Having seen a reference to
"Bounce" in a research paper on Ref Counting, I chose to use
Tcl_BounceRefCount().

doc/Object.3

@@ -23,7 +23,7 @@ Tcl_Obj *
 .sp
 \fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
 .sp
-\fBTcl_BumpObj\fR(\fIobjPtr\fR)
+\fBTcl_BounceRefCount\fR(\fIobjPtr\fR)
 .sp
 int
 \fBTcl_IsShared\fR(\fIobjPtr\fR)
@@ -296,7 +296,7 @@ new reference to the value is created.
 The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed.
 If the value's reference count drops to zero, frees
 its storage.
-The macro \fBTcl_BumpObj\fR will check if the value has no references (i.e. in a "new" state) and free the value.
+The macro \fBTcl_BounceRefCount\fR will check if the value has no references (i.e. in a "new" state) and free the value.
 A value shared by different code or data structures has
 \fIrefCount\fR greater than 1.  Incrementing a value's reference count
 ensures that it will not be freed too early or have its value change
@@ -324,7 +324,7 @@ situation, it is the caller's responsibility to free the value before
 the procedure returns.  One way to cover this is to always call
 \fBTcl_IncrRefCount\fR before using the value, then call
 \fBTcl_DecrRefCount\fR before returning. The other way is to use
-\fBTcl_BumpObj\fR after the value is no longer needed or
+\fBTcl_BounceRefCount\fR after the value is no longer needed or
 referenced. This macro will free the value if there are no other
 references to the value. When retaining a pointer to a value in a data
 structure the procedure must be careful to increment its reference
@@ -368,7 +368,7 @@ If it is shared, it needs to duplicate the value
 in order to avoid accidentally changing values in other data structures.
 .PP
 In cases where a value is obtained, used, and not retained, the value
-can be freed using \fBTcl_BumpObj\fR. This
+can be freed using \fBTcl_BounceRefCount\fR. This
 is functionally equivalent to calling \fBTcl_IncrRefCount\fR followed
 \fBTcl_DecrRefCount\fR.
 .SH "SEE ALSO"

doc/ObjectType.3

@@ -118,6 +118,7 @@ typedef struct Tcl_ObjType {
     Tcl_ObjTypeGetElements *\fIgetElementsProc\fR;
     Tcl_ObjTypeSetElement *\fIsetElementProc\fR;
     Tcl_ObjTypeReplaceProc *\fIreplaceProc\fR;
+    Tcl_ObjTypeInOperatorProc *\fIinOperProc\fR;
 } \fBTcl_ObjType\fR;
 .CE
 .SS "THE NAME FIELD"
@@ -214,6 +215,7 @@ The \fIdupIntRepProc\fR member contains the address of a function
 called to copy an internal representation from one value to another.
 .PP
 .CS
+
 typedef void \fBTcl_DupInternalRepProc\fR(
         Tcl_Obj *\fIsrcPtr\fR,
         Tcl_Obj *\fIdupPtr\fR);
@@ -237,6 +239,7 @@ The \fIfreeIntRepProc\fR member contains the address of a function
 that is called when a value is freed.
 .PP
 .CS
+
 typedef void \fBTcl_FreeInternalRepProc\fR(
         Tcl_Obj *\fIobjPtr\fR);
 .CE
@@ -293,12 +296,12 @@ use of the List commands without causing the type of the Tcl_Obj value
 to be converted to a list.
 .SS "THE LENGTHPROC FIELD"
 .PP
-The \fBLengthProc\fR function correlates with the \fBllength\fR
-command. The function returns the number of elements in the list. It
+The \fBLengthProc\fR function correlates with the \fBTcl_ListObjLength\fR
+C API. The function returns the number of elements in the list. It
 is used in every List operation and is required for all Abstract List
 implementations.
-
 .CS
+
 typedef Tcl_Size
 (Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr);
 .CE
@@ -306,10 +309,11 @@ typedef Tcl_Size
 .PP
 .SS "THE INDEXPROC FIELD"
 .PP
-The \fBIndexProc\fR function correlates with the \fBlindex\fR
-command. The function returns a Tcl_Obj value for the element at the
-specified index.
+The \fBIndexProc\fR function correlates with with the
+\fBTcl_ListObjIndex\fR C API. The function returns a Tcl_Obj value for
+the element at the specified index.
 .CS
+
 typedef int
 (Tcl_ObjTypeIndexProc) (
     Tcl_Interp *interp,
@@ -323,6 +327,7 @@ The \fBSliceProc\fR correlates with the \fBlrange\fR command,
 returning a new List or Abstract List for the portion of the original
 list specifed.
 .CS
+
 typedef int
 (Tcl_ObjTypeSliceProc) (
     Tcl_Interp *interp,
@@ -337,6 +342,7 @@ The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
 returning a List or Abstract List that has the same elements as the
 input Abstract List, with the elements in the reverse order.
 .CS
+
 typedef int
 (Tcl_ObjTypeReverseProc) (
     Tcl_Interp *interp,
@@ -345,10 +351,11 @@ typedef int
 .CE
 .SS "THE GETELEMENTS FIELD"
 .PP
-THe \fBGetElements\fR function returns a count and a pointer to an
+The \fBGetElements\fR function returns a count and a pointer to an
 array of Tcl_Obj values for the entire Abstract List. This is a
 correlary to the \fBTcl_ListObjGetElements\fR C API call.
 .CS
+
 typedef int
 (Tcl_ObjTypeGetElements) (
     Tcl_Interp *interp,
@@ -360,8 +367,10 @@ typedef int
 .PP
 The \fBSetElement\fR function replaces the element within the
 specified list at the give index. This function correlates to the
-\fBlset\fR command.  typedef Tcl_Obj*
+\fBlset\fR command.
 .CS
+
+typedef Tcl_Obj*
 Tcl_ObjTypeSetElement) (
     Tcl_Interp *interp,
     Tcl_Obj *listPtr,
@@ -373,8 +382,9 @@ Tcl_ObjTypeSetElement) (
 .PP
 The \fBReplaceProc\fR returns a new list after modfying the list
 replacing the elements to be deleted, and adding the elements to be
-inserted. This function correlates to the \fBlreplace\fR command.
+inserted. This function correlates to the \fBTcl_ListObjReplace\fR C API.
 .CS
+
 typedef int
 (Tcl_ObjTypeReplaceProc) (
     Tcl_Interp *interp,
@@ -384,6 +394,22 @@ typedef int
     Tcl_Size numToInsert,
     Tcl_Obj *const insertObjs[]);
 .CE
+.SS "THE INOPERATORPROC FIELD"
+.PP
+The \fBInOperProc\fR function determines whether the value is present in the
+given list, according to equivalent string comparison of elements. The
+\fBboolResult\fR is set to 1 (true) if the value is present, and 0
+(false) if it is not present. This function implements the "in" and
+"ni" math operators for an abstract list.
+.CS
+
+typedef int
+(Tcl_ObjTypeInOperatorProc) (
+    Tcl_Interp *interp,
+    Tcl_Obj *valueObj,
+    Tcl_Obj *listObj,
+    int *boolResult);
+.CE
 .SH "REFERENCE COUNT MANAGEMENT"
 .PP
 The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared
@@ -402,6 +428,6 @@ modify the reference count of their arguments, but if the values contain
 subsidiary values (e.g., the elements of a list or the keys of a dictionary)
 then those subsidiary values may have their reference counts modified.
 .SH "SEE ALSO"
-Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3)
+Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_BounceRefCount(3)
 .SH KEYWORDS
 internal representation, value, value type, string representation, type conversion

doc/OpenFileChnl.3

@@ -47,10 +47,10 @@ int
 int
 \fBTcl_Close\fR(\fIinterp, channel\fR)
 .sp
-int
+Tcl_Size
 \fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
 .sp
-int
+Tcl_Size
 \fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
 .sp
 Tcl_Size

generic/tcl.h

@@ -625,6 +625,8 @@ typedef            int  (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl
                                              Tcl_Size first, Tcl_Size numToDelete,
                                              Tcl_Size numToInsert,
                                              struct Tcl_Obj *const insertObjs[]);
+typedef            int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj,
+                                             struct Tcl_Obj *listObj, int *boolResult);
 
 #ifndef TCL_NO_DEPRECATED
 #   define Tcl_PackageInitProc Tcl_LibraryInitProc
@@ -671,19 +673,20 @@ typedef struct Tcl_ObjType {
     Tcl_ObjTypeSetElement *setElementProc;   /* Replace the element at the indicie
 					     ** with the given valueObj. */
     Tcl_ObjTypeReplaceProc *replaceProc;     /* Replace subset with subset */
-    void *reservedProc;     /* Reserved for version 3, to be filled in */
+    Tcl_ObjTypeInOperatorProc *inOperProc;   /* "in" and "ni" expr list
+                                             ** operation Determine if the given
+                                             ** string value matches an element in
+                                             ** the list */
 #endif
 } Tcl_ObjType;
 
 #if TCL_MAJOR_VERSION > 8
 #   define TCL_OBJTYPE_V0 0, \
-	    0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
+	   0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
 #   define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
-	    a,INT2PTR(1),INT2PTR(1),INT2PTR(1),INT2PTR(1),INT2PTR(1),INT2PTR(1),INT2PTR(1) /* Tcl 9 Version 1 */
-#   define TCL_OBJTYPE_V2(a,b,c,d,e,f,g) offsetof(Tcl_ObjType, reservedProc), \
-	    a,b,c,d,e,f,g,INT2PTR(1) /* Tcl 9 - AbstractLists */
-#   define TCL_OBJTYPE_V3(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \
-	    a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists, version 3 */
+	   a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */
+#   define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType),  \
+	   a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */
 #else
 #   define TCL_OBJTYPE_V0 /* just empty */
 #endif
@@ -2057,8 +2060,7 @@ typedef struct Tcl_EncodingType {
 
 /*
  * The maximum number of bytes that are necessary to represent a single
- * Unicode character in UTF-8. The valid values are 3 and 4
- * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
+ * Unicode character in UTF-8. The valid values are 3 and 4. If > 3,
  * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
  * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
  * mode is the default and recommended mode.
@@ -2479,10 +2481,10 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
  *
  * This will free the obj if there are no references to the obj.
  */
-#   define Tcl_BumpObj(objPtr) \
-    TclBumpObj(objPtr, __FILE__, __LINE__)
+#   define Tcl_BounceRefCount(objPtr) \
+    TclBounceRefCount(objPtr, __FILE__, __LINE__)
 
-static inline void TclBumpObj(Tcl_Obj* objPtr, const char* fn, int line)
+static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line)
 {
     if (objPtr) {
         if ((objPtr)->refCount == 0) {
@@ -2515,10 +2517,10 @@ static inline void TclBumpObj(Tcl_Obj* objPtr, const char* fn, int line)
  * This will release the obj if there is no referece count,
  * otherwise let it be.
  */
-#   define Tcl_BumpObj(objPtr)     \
-    TclBumpObj(objPtr);
+#   define Tcl_BounceRefCount(objPtr)     \
+    TclBounceRefCount(objPtr);
 
-static inline void TclBumpObj(Tcl_Obj* objPtr)
+static inline void TclBounceRefCount(Tcl_Obj* objPtr)
 {
     if (objPtr) {
         if ((objPtr)->refCount == 0) {

generic/tclArithSeries.c

@@ -80,7 +80,8 @@ static void DupArithSeriesInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
 static void FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr);
 static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr);
 static int  SetArithSeriesFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
-
+static int  ArithSeriesInOperation(Tcl_Interp *interp, Tcl_Obj *valueObj, Tcl_Obj *arithSeriesObj,
+				   int *boolResult);
 static const Tcl_ObjType arithSeriesType = {
     "arithseries",			/* name */
     FreeArithSeriesInternalRep,		/* freeIntRepProc */
@@ -94,7 +95,8 @@ static const Tcl_ObjType arithSeriesType = {
     TclArithSeriesObjReverse,
     TclArithSeriesGetElements,
     NULL, // SetElement
-    NULL) // Replace
+    NULL, // Replace
+    ArithSeriesInOperation) // "in" operator
 };
 
 /*
@@ -608,7 +610,7 @@ TclArithSeriesObjIndex(
     ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
 
     if (index < 0 || arithSeriesRepPtr->len <= index) {
-	*elemObj = Tcl_NewObj();
+	*elemObj = NULL;
     } else {
 	/* List[i] = Start + (Step * index) */
 	if (arithSeriesRepPtr->isDouble) {
@@ -1108,7 +1110,92 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr)
     if (bytlen > 0) arithSeriesObjPtr->bytes[bytlen-1] = '\0';
     arithSeriesObjPtr->length = bytlen-1;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArithSeriesInOperator --
+ *
+ *	Evaluate the "in" operation for expr
+ *
+ *      This can be done more efficiently in the Arith Series relative to
+ *      doing a linear search as implemented in expr.
+ *
+ * Results:
+ *	Boolean true or false (1/0)
+ *
+ * Side effects:
+ *      None
+ *
+ *----------------------------------------------------------------------
+ */
 
+static int
+ArithSeriesInOperation(
+    Tcl_Interp *interp,
+    Tcl_Obj *valueObj,
+    Tcl_Obj *arithSeriesObjPtr,
+    int *boolResult)
+{
+    ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
+    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
+    int status;
+    Tcl_Size index, incr, elen, vlen;
+
+    if (arithSeriesRepPtr->isDouble) {
+        double y;
+	int test = 0;
+
+	incr = 0; // Check index+incr where incr is 0 and 1
+        status = Tcl_GetDoubleFromObj(interp, valueObj, &y);
+        if (status != TCL_OK) {
+	    test = 0;
+        } else {
+            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);
+		const char *estr = elemObj ? Tcl_GetStringFromObj(elemObj, &elen) : "";
+		/* "in" operation defined as a string compare */
+		test = (elen == vlen) ? (memcmp(estr, vstr, elen) == 0) : 0;
+		Tcl_BounceRefCount(elemObj);
+		/* Stop if we have a match */
+		if (test) {
+		    break;
+		}
+		incr++;
+	    }
+        }
+	if (boolResult) {
+	    *boolResult = test;
+	}
+    } else {
+        ArithSeries *intRepPtr = arithSeriesRepPtr;
+        Tcl_WideInt y;
+
+        status = Tcl_GetWideIntFromObj(NULL, valueObj, &y);
+        if (status != TCL_OK) {
+            if (boolResult) {
+                *boolResult = 0;
+            }
+        } else {
+            Tcl_Obj *elemObj;
+	    elen = 0;
+            index = (y - intRepPtr->start) / intRepPtr->step;
+            TclArithSeriesObjIndex(interp, arithSeriesObjPtr, index, &elemObj);
+            char const *vstr = Tcl_GetStringFromObj(valueObj, &vlen);
+            char const *estr = elemObj ? Tcl_GetStringFromObj(elemObj, &elen) : "";
+            if (boolResult) {
+                *boolResult = (elen == vlen) ? (memcmp(estr, vstr, elen) == 0) : 0;
+            }
+            Tcl_BounceRefCount(elemObj);
+        }
+    }
+    return TCL_OK;
+}
+
 /*
  * Local Variables:
  * mode: c

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) {

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;
 	    }

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);
     }
 
     /*
@@ -3754,7 +3741,7 @@ Tcl_LsearchObjCmd(
 	    i = (lower + upper)/2;
 	    i -= i % groupSize;
 
-	    Tcl_BumpObj(itemPtr);
+	    Tcl_BounceRefCount(itemPtr);
 	    itemPtr = NULL;
 
 	    if (sortInfo.indexc != 0) {
@@ -3855,7 +3842,7 @@ Tcl_LsearchObjCmd(
 	}
 	for (i = start; i < listc; i += groupSize) {
 	    match = 0;
-	    Tcl_BumpObj(itemPtr);
+	    Tcl_BounceRefCount(itemPtr);
 	    itemPtr = NULL;
 
 	    if (sortInfo.indexc != 0) {
@@ -3957,7 +3944,7 @@ Tcl_LsearchObjCmd(
 		 */
 
 		if (returnSubindices && (sortInfo.indexc != 0)) {
-		    Tcl_BumpObj(itemPtr);
+		    Tcl_BounceRefCount(itemPtr);
 		    itemPtr = SelectObjFromSublist(listv[i+groupOffset],
 			    &sortInfo);
 		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
@@ -3965,7 +3952,7 @@ Tcl_LsearchObjCmd(
 		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
 			    groupSize, &listv[i]);
 		} else {
-		    Tcl_BumpObj(itemPtr);
+		    Tcl_BounceRefCount(itemPtr);
 		    itemPtr = listv[i];
 		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
 		}
@@ -3986,7 +3973,7 @@ Tcl_LsearchObjCmd(
 	}
     }
 
-    Tcl_BumpObj(itemPtr);
+    Tcl_BounceRefCount(itemPtr);
     itemPtr = NULL;
 
     /*
@@ -4037,7 +4024,7 @@ Tcl_LsearchObjCmd(
 
   done:
     /* potential lingering abstract list element */
-    Tcl_BumpObj(itemPtr);
+    Tcl_BounceRefCount(itemPtr);
 
     if (startPtr != NULL) {
 	Tcl_DecrRefCount(startPtr);
@@ -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;
@@ -5582,7 +5566,7 @@ SelectObjFromSublist(
 	    return NULL;
 	}
 	objPtr = currentObj;
-	Tcl_BumpObj(lastObj);
+	Tcl_BounceRefCount(lastObj);
 	lastObj = currentObj;
     }
     return objPtr;

generic/tclCmdMZ.c

@@ -1192,6 +1192,11 @@ Tcl_SplitObjCmd(
 	return TCL_ERROR;
     }
 
+    if (splitCharLen == 0) {
+	Tcl_SetObjResult(interp, TclNewStringListObj(interp, objv[1]));
+	return TCL_OK;
+    }
+
     stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
     end = stringPtr + stringLen;
     TclNewObj(listPtr);
@@ -1200,40 +1205,6 @@ Tcl_SplitObjCmd(
 	/*
 	 * Do nothing.
 	 */
-    } else if (splitCharLen == 0) {
-	Tcl_HashTable charReuseTable;
-	Tcl_HashEntry *hPtr;
-	int isNew;
-
-	/*
-	 * Handle the special case of splitting on every character.
-	 *
-	 * Uses a hash table to ensure that each kind of character has only
-	 * one Tcl_Obj instance (multiply-referenced) in the final list. This
-	 * is a *major* win when splitting on a long string (especially in the
-	 * megabyte range!) - DKF
-	 */
-
-	Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
-
-	for ( ; stringPtr < end; stringPtr += len) {
-	    len = TclUtfToUCS4(stringPtr, &ch);
-	    hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew);
-	    if (isNew) {
-		TclNewStringObj(objPtr, stringPtr, len);
-
-		/*
-		 * Don't need to fiddle with refcount...
-		 */
-
-		Tcl_SetHashValue(hPtr, objPtr);
-	    } else {
-		objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
-	    }
-	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
-	}
-	Tcl_DeleteHashTable(&charReuseTable);
-
     } else if (splitCharLen == 1) {
 	const char *p;
 

generic/tclCompCmdsGR.c

@@ -49,8 +49,8 @@ static int		IndexTailVarIfKnown(Tcl_Interp *interp,
 int
 TclGetIndexFromToken(
     Tcl_Token *tokenPtr,
-    int before,
-    int after,
+    size_t before,
+    size_t after,
     int *indexPtr)
 {
     Tcl_Obj *tmpObj;

generic/tclCompile.h

@@ -1138,7 +1138,7 @@ MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
 MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
 MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
 MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
-			    int before, int after, int *indexPtr);
+			    size_t before, size_t after, int *indexPtr);
 MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
 MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
 			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);

generic/tclDictObj.c

@@ -62,7 +62,7 @@ static Tcl_ObjCmdProc		DictMapNRCmd;
 static Tcl_NRPostProc		DictForLoopCallback;
 static Tcl_NRPostProc		DictMapLoopCallback;
 static Tcl_ObjTypeLengthProc    DictAsListLength;
-static Tcl_ObjTypeIndexProc     DictAsListIndex;
+/* static Tcl_ObjTypeIndexProc     DictAsListIndex; Needs rewrite */
 
 /*
  * Table of dict subcommand names and implementations.
@@ -152,13 +152,14 @@ const Tcl_ObjType tclDictType = {
     TCL_OBJTYPE_V2(		/* Extended type for AbstractLists */
     DictAsListLength,		/* return "list" length of dict value w/o
 				 * shimmering */
-    DictAsListIndex,		/* return key or value at "list" index
+    NULL,			/* return key or value at "list" index
 				 * location.  (keysare at even indicies,
 				 * values at odd indicies) */
     NULL,
     NULL,
     NULL,
     NULL,
+    NULL,
     NULL)
 };
 
@@ -3883,7 +3884,7 @@ DictAsListLength(
  *   The intent is to have no side effects.
  *
  */
-
+#if 0 /* Needs rewrite */
 static int
 DictAsListIndex(
     Tcl_Interp *interp,
@@ -3951,6 +3952,7 @@ DictAsListIndex(
     *elemObjPtr = elemPtr;
     return TCL_OK;
 }
+#endif
 
 /*
  * Local Variables:

generic/tclEncoding.c

@@ -3234,7 +3234,7 @@ UtfToUtf16Proc(
     }
 
     dstStart = dst;
-    dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
+    dstEnd   = dst + dstLen - 2; /* 2 -> sizeof a UTF-16 code unit */
     flags |= PTR2INT(clientData);
 
     result = TCL_OK;
@@ -3344,7 +3344,7 @@ UtfToUcs2Proc(
     }
 
     dstStart = dst;
-    dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
+    dstEnd   = dst + dstLen - 2; /* 2 - size of UCS code unit */
 
     result = TCL_OK;
     for (numChars = 0; src < srcEnd; numChars++) {

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);

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;
 

generic/tclExecute.c

@@ -3377,12 +3377,7 @@ TEBCresume(
 	    goto gotError;
 	}
 	if (Tcl_IsShared(objResultPtr)) {
-	    Tcl_Obj *newValue = TclDuplicatePureObj(
-		    interp, objResultPtr, &tclListType);
-	    if (!newValue) {
-		TRACE_ERROR(interp);
-		goto gotError;
-	    }
+	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
 
 	    TclDecrRefCount(objResultPtr);
 	    varPtr->value.objPtr = objResultPtr = newValue;
@@ -3441,11 +3436,7 @@ TEBCresume(
 		goto gotError;
 	    } else {
 		if (Tcl_IsShared(objResultPtr)) {
-		    valueToAssign = TclDuplicatePureObj(
-			interp, objResultPtr, &tclListType);
-		    if (!valueToAssign) {
-			goto errorInLappendListPtr;
-		    }
+		    valueToAssign = Tcl_DuplicateObj(objResultPtr);
 		    createdNewObj = 1;
 		} else {
 		    valueToAssign = objResultPtr;
@@ -4686,6 +4677,10 @@ TEBCresume(
 		goto gotError;
 	    }
 	    CACHE_STACK_INFO();
+	    if (objResultPtr == NULL) {
+		/* Index is out of range, return empty result. */
+		TclNewObj(objResultPtr);
+	    }
 	    Tcl_IncrRefCount(objResultPtr); // reference held here
 	    goto lindexDone;
 	}
@@ -5012,50 +5007,60 @@ TEBCresume(
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
 
-	s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
-	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
-	if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
-	    TRACE_ERROR(interp);
-	    goto gotError;
-	}
-	match = 0;
-	if (length > 0) {
-	    Tcl_Size i = 0;
-	    Tcl_Obj *o;
-	    int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL;
+        s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
+        TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
 
-	    /*
-	     * An empty list doesn't match anything.
-	     */
+        if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) {
+            int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match);
+            if (status != TCL_OK) {
+                TRACE_ERROR(interp);
+                goto gotError;
+            }
+        } else {
 
-	    do {
-		if (isAbstractList) {
-		    DECACHE_STACK_INFO();
-		    if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
-			CACHE_STACK_INFO();
-			TRACE_ERROR(interp);
-			goto gotError;
-		    }
-		    CACHE_STACK_INFO();
-		} else {
-		    Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
-		}
-		if (o != NULL) {
-		    s2 = Tcl_GetStringFromObj(o, &s2len);
-		} else {
-		    s2 = "";
-		    s2len = 0;
-		}
-		if (s1len == s2len) {
-		    match = (memcmp(s1, s2, s1len) == 0);
-		}
+            if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
+                TRACE_ERROR(interp);
+                goto gotError;
+            }
+            match = 0;
+            if (length > 0) {
+                Tcl_Size i = 0;
+                Tcl_Obj *o;
+                int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL;
 
-		/* Could be an ephemeral abstract obj */
-		Tcl_BumpObj(o);
+                /*
+                 * An empty list doesn't match anything.
+                 */
 
-		i++;
-	    } while (i < length && match == 0);
-	}
+                do {
+                    if (isAbstractList) {
+                        DECACHE_STACK_INFO();
+                        if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
+                            CACHE_STACK_INFO();
+                            TRACE_ERROR(interp);
+                            goto gotError;
+                        }
+                        CACHE_STACK_INFO();
+                    } else {
+                        Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
+                    }
+                    if (o != NULL) {
+                        s2 = Tcl_GetStringFromObj(o, &s2len);
+                    } else {
+                        s2 = "";
+                        s2len = 0;
+                    }
+                    if (s1len == s2len) {
+                        match = (memcmp(s1, s2, s1len) == 0);
+                    }
+
+                    /* Could be an ephemeral abstract obj */
+                    Tcl_BounceRefCount(o);
+
+                    i++;
+                } while (i < length && match == 0);
+            }
+        }
 
 	if (*pc == INST_LIST_NOT_IN) {
 	    match = !match;
@@ -5918,7 +5923,7 @@ TEBCresume(
 		     * Quickly force large right shifts to 0 or -1.
 		     */
 
-		    if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
+		    if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(w1))) {
 			/*
 			 * We assume that INT_MAX is much larger than the
 			 * number of bits in a long. This is a pretty safe
@@ -5986,9 +5991,9 @@ TEBCresume(
 		     * Handle shifts within the native long range.
 		     */
 
-		    if (((size_t)shift < CHAR_BIT*sizeof(long))
+		    if (((size_t)shift < CHAR_BIT*sizeof(w1))
 			    && !((w1>0 ? w1 : ~w1) &
-				-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
+				-(1UL<<(CHAR_BIT*sizeof(w1) - 1 - shift)))) {
 			wResult = (Tcl_WideUInt)w1 << shift;
 			goto wideResultOfArithmetic;
 		    }
@@ -6462,13 +6467,8 @@ TEBCresume(
 			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
 		goto gotError;
 	    }
-	    CACHE_STACK_INFO();
 	    if (Tcl_IsShared(listPtr)) {
-		objPtr = TclDuplicatePureObj(
-		    interp, listPtr, &tclListType);
-		if (!objPtr) {
-		    goto gotError;
-		}
+		objPtr = TclListObjCopy(NULL, listPtr);
 		Tcl_IncrRefCount(objPtr);
 		Tcl_DecrRefCount(listPtr);
 		OBJ_AT_DEPTH(listTmpDepth) = objPtr;

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);

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);

generic/tclInt.h

@@ -1169,6 +1169,13 @@ TclObjTypeReplace(
     Tcl_ObjTypeReplaceProc *proc = TclObjTypeHasProc(objPtr, replaceProc);
     return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs);
 }
+static inline int
+TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj,
+		     struct Tcl_Obj *listObj, int *boolResult)
+{
+    Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc);
+    return proc(interp, valueObj, listObj, boolResult);
+}
 #endif /* TCL_MAJOR_VERSION > 8 */
 
 
@@ -3253,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,
@@ -3385,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[]);
@@ -3435,6 +3441,8 @@ MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp,
 MODULE_SCOPE int	TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
                             int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
                             Tcl_Obj *stepObj, Tcl_Obj *lenObj);
+MODULE_SCOPE Tcl_Obj *  TclNewStringListObj(Tcl_Interp *interp,
+			    Tcl_Obj *srcStringObj);
 MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
 			    Tcl_Size len);
 MODULE_SCOPE void	TclpAlertNotifier(void *clientData);

generic/tclListObj.c

@@ -1316,6 +1316,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;
+}
+
 /*
  *------------------------------------------------------------------------
  *
@@ -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
@@ -2927,6 +2961,11 @@ TclLsetFlat(
 	}
 	indexArray++;
 
+        /*
+         * Special case 0-length lists. The Tcl indexing function treat
+         * will return any value beyond length as TCL_SIZE_MAX for this
+         * case.
+         */
 	if ((index == TCL_SIZE_MAX) && (elemCount == 0)) {
 	    index = 0;
 	}
@@ -2949,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) {
@@ -2962,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);
 	    }
 
 	    /*
@@ -2985,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);
 	    }
 

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,

generic/tclStringList.c

@@ -0,0 +1,602 @@
+/*
+ * tclStringList.c --
+ *
+ *     This file contains the StringList concrete abstract list
+ *     implementation. It implements a view of a string as a list of
+ *     of characters.
+ *
+ * Copyright © 2023 Ashok P. Nadkarni
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+#include <assert.h>
+#include <math.h>
+
+/*
+ * The structure below defines the StringList Tcl_ObjType. Implementation
+ * stores the target Tcl_Obj being split in the internal representation of the
+ * abstract list Tcl_Obj. List operations are then mapped to the corresponding
+ * string operations. This makes per character processing of the form
+ *    foreach ch [split $str ""] {...}
+ * less expensive for large strings.
+ *
+ * The source string is stored in the internalRep.twpPtrValue.ptr1 field.
+ * The ptr2 field holds a StringListInfo struct with ancillary information
+ * as below. If ptr2 is NULL, list covers all elements of source string.
+ */
+typedef struct StringListInfo {
+    Tcl_Size startIndex; /* Starting index in source string where this list
+                            begins. Used for fast range operations */
+    Tcl_Size count;      /* Number of elements in list. If negative, count
+                            is entire source string */
+    int flags;
+#define STRINGLIST_REVERSE 0x01 /* If set, reverse element order */
+} StringListInfo;
+
+/* -------------------------- StringList object ---------------------------- */
+
+static int StringListObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
+				  Tcl_Size index, Tcl_Obj **elemObj);
+
+static Tcl_Size StringListObjLength(Tcl_Obj *strListObj);
+static int StringListObjRange(Tcl_Interp *interp, Tcl_Obj *strListObj,
+			    Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
+static int StringListObjReverse(Tcl_Interp *interp, Tcl_Obj *strListObj, Tcl_Obj **newObjPtr);
+static void DupStringListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void FreeStringListInternalRep(Tcl_Obj *strListObj);
+static void UpdateStringOfStringList(Tcl_Obj *strListObj);
+
+static const Tcl_ObjType stringListType = {
+    "stringlist",               /* name */
+    FreeStringListInternalRep, /* freeIntRepProc */
+    DupStringListInternalRep,  /* dupIntRepProc */
+    UpdateStringOfStringList,  /* updateStringProc */
+    NULL,                      /* setFromAnyProc */
+    TCL_OBJTYPE_V2(
+    StringListObjLength,
+    StringListObjIndex,
+    StringListObjRange,
+    StringListObjReverse,
+    NULL, /* GetElements */
+    NULL, /* SetElement */
+    NULL, /* Replace */
+    NULL) /* "in" operator */
+};
+
+/* Returns the source for a StringList, NULL if objPtr is not a StringList */
+static inline Tcl_Obj *
+StringListGetSourceObj(Tcl_Obj *objPtr)
+{
+    const Tcl_ObjInternalRep *irPtr;
+    irPtr = TclFetchInternalRep((objPtr), &stringListType);
+    return irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;
+}
+
+/*
+ * Returns the ancillary information about a StringList. May return an
+ * NULL either because objPtr is not a StringList or because it has no
+ * ancillary information. Use StringListGetSourceObj to distinguish.
+ */
+static inline StringListInfo *
+StringListGetInfo(Tcl_Obj *objPtr)
+{
+    const Tcl_ObjInternalRep *irPtr;
+    irPtr = TclFetchInternalRep((objPtr), &stringListType);
+    return irPtr ? (StringListInfo *)irPtr->twoPtrValue.ptr2 : NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupStringListInternalRep --
+ *
+ *	Initialize the internal representation of a StringList Tcl_Obj to a
+ *	copy of the internal representation of an existing one.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	We set "copyPtr"s internal rep to a newly allocated structure.
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupStringListInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
+{
+    /* Copy the source string and hold a reference */
+    Tcl_Obj *srcStringObj = StringListGetSourceObj(srcPtr);
+    copyPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
+    Tcl_IncrRefCount(srcStringObj);
+
+    /* Copy the ancillary information if there is any. */
+    StringListInfo *srcInfoPtr = StringListGetInfo(srcPtr);
+    if (srcInfoPtr) {
+	StringListInfo *copyInfoPtr;
+	copyInfoPtr = (StringListInfo *)Tcl_Alloc(sizeof(*copyInfoPtr));
+	*copyInfoPtr = *srcInfoPtr;
+	copyPtr->internalRep.twoPtrValue.ptr2 = copyInfoPtr;
+    } else {
+	    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    }
+    copyPtr->typePtr = &stringListType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeStringListInternalRep --
+ *
+ *	Free any allocated memory in the StringList Rep
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+FreeStringListInternalRep(Tcl_Obj *strListObj)
+{
+    Tcl_Obj *srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+    if (srcStringObj) {
+	    Tcl_DecrRefCount(srcStringObj);
+    }
+    StringListInfo *infoPtr = StringListGetInfo(strListObj);
+    if (infoPtr) {
+	    Tcl_Free(infoPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewStringListObj --
+ *
+ *	Creates a new StringList object formed by splitting the source string
+ *  object.
+ *
+ * Results:
+ *
+ * 	A Tcl_Obj pointer to the created StringList object with ref count 0.
+ *
+ * Side Effects:
+ *
+ * 	None.
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewStringListObj(
+    TCL_UNUSED(Tcl_Interp *),
+    Tcl_Obj *srcStringObj) /* String to split */
+{
+    Tcl_Obj *objPtr = Tcl_NewObj();
+    Tcl_InvalidateStringRep(objPtr);
+    objPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
+    Tcl_IncrRefCount(srcStringObj);
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->typePtr = &stringListType;
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListGetExtent
+ *
+ *  Gets the starting index and length subrange within the source string
+ *  that comprises this list.
+ *
+ * Results:
+ *
+ * 	Returns the length of the list.
+ *
+ * Side Effects:
+ *
+ *  The starting index in the source string is stored in startIndexPtr
+ *  if it is not NULL.
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Size
+StringListGetExtent(Tcl_Obj *strListObj, Tcl_Size *startIndexPtr, Tcl_Size *numCharsPtr, int *reversedPtr)
+{
+    Tcl_Obj *srcStringObj;
+    StringListInfo *infoPtr;
+    Tcl_Size numChars;
+    Tcl_Size listLen;
+    Tcl_Size startIndex;
+    int reversed;
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    infoPtr = StringListGetInfo(strListObj);
+
+    assert(srcStringObj);
+    numChars = Tcl_GetCharLength(srcStringObj);
+
+    if (infoPtr) {
+	/* The list is a subrange of the string */
+	startIndex = infoPtr->startIndex;
+	if (infoPtr->count >= 0) {
+	    listLen = infoPtr->count;
+	    assert(listLen <= numChars);
+	}
+	else {
+	    listLen = numChars - startIndex;
+	}
+	reversed = (infoPtr->flags & STRINGLIST_REVERSE) != 0;
+    } else {
+	startIndex = 0;
+	listLen = numChars;
+	reversed = 0;
+    }
+
+    assert(listLen <= numChars);
+    assert(startIndex == 0 || startIndex < numChars);
+    assert(startIndex <= (numChars - listLen));
+
+    if (startIndexPtr) {
+	*startIndexPtr = startIndex;
+    }
+    if (numCharsPtr) {
+	*numCharsPtr = numChars;
+    }
+    if (reversedPtr) {
+	*reversedPtr = reversed;
+    }
+    return listLen;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListObjIndex --
+ *
+ *	Returns the element with the specified index in the list. If index
+ *  is out of range, an empty Tcl_Obj is returned.
+ *
+ * Results:
+ *
+ * 	TCL_OK on success.
+ *
+ * Side Effects:
+ *
+ * 	On success, the 
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+StringListObjIndex(
+    TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
+    Tcl_Obj *strListObj,     /* List obj */
+    Tcl_Size index,          /* index to element of interest */
+    Tcl_Obj **elemObj)       /* Return value */
+{
+    Tcl_Size listLen;
+    Tcl_Size startIndex;
+    Tcl_Obj *srcStringObj;
+    int reversed;
+    Tcl_Size strIndex;
+
+    if (index < 0) {
+	goto outOfBounds;
+    }
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+
+    listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
+    if (index >= listLen) {
+	goto outOfBounds;
+    }
+
+    /*
+     * The index into the string depends on whether the list is only a
+     * substring of the string and whether it is reversed.
+     */
+    if (reversed) {
+	strIndex = startIndex + listLen - index - 1;
+    } else {
+	strIndex = startIndex + index;
+    }
+
+    char buf[TCL_UTF_MAX];
+    int utfLen;
+
+    assert(strIndex <
+	   Tcl_GetCharLength(srcStringObj));
+    Tcl_UniChar ch = Tcl_GetUniChar(srcStringObj, strIndex);
+    utfLen = Tcl_UniCharToUtf(ch, buf);
+    *elemObj = Tcl_NewStringObj(buf, utfLen);
+
+    return TCL_OK;
+
+outOfBounds:
+    /* TODO - NULL or empty obj? */
+    *elemObj = Tcl_NewObj();
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListObjLength
+ *
+ *	Returns the length of the StringList
+ *
+ * Results:
+ *
+ * 	The length of the list.
+ *
+ * Side Effects:
+ *
+ * 	None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Size StringListObjLength(Tcl_Obj *strListObj)
+{
+    return StringListGetExtent(strListObj, NULL, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListObjRange --
+ *
+ *	Makes a slice of an StringList.
+ *
+ * Results:
+ *	Returns a pointer to the sliced series.
+ *      This may be a new object or the same object if not shared.
+ *
+ * Side effects:
+ *	?The possible conversion of the object referenced by listPtr?
+ *	?to a list object.?
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+StringListObjRange(
+    TCL_UNUSED(Tcl_Interp *),   /* For error message(s) */
+    Tcl_Obj *strListObj,	/* List object to take a range from. */
+    Tcl_Size fromIdx,		/* Index of first element to include. */
+    Tcl_Size toIdx,		/* Index of last element to include. */
+    Tcl_Obj **newObjPtr)        /* return value */
+{
+    Tcl_Size listLen;
+    Tcl_Size startIndex;
+    Tcl_Obj *srcStringObj;
+    int reversed;
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+
+    listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
+
+    if (fromIdx < 0) {
+	fromIdx = 0;
+    }
+
+    if (toIdx >= listLen) {
+	toIdx = listLen - 1;
+    } 
+    
+    if (fromIdx > toIdx ||
+	fromIdx >= listLen) {
+	TclNewObj(*newObjPtr);
+	return TCL_OK;
+    }
+
+    assert(fromIdx >= 0);
+    assert(toIdx >= fromIdx);
+    assert(listLen > toIdx);
+
+    /*
+     * We could do a Tcl_Range to allocate a new string but instead
+     * keep the old one and just add ancillary information specifying
+     * range and reverse setting.
+     */
+    StringListInfo *infoPtr;
+    infoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*infoPtr));
+
+    infoPtr->count = toIdx - fromIdx + 1;
+    if (reversed) {
+	infoPtr->startIndex = startIndex + listLen - toIdx - 1;
+	infoPtr->flags = STRINGLIST_REVERSE;
+    } else {
+	infoPtr->startIndex = startIndex + fromIdx;
+	infoPtr->flags = 0;
+	assert(fromIdx < Tcl_GetCharLength(strListObj));
+	assert(toIdx < Tcl_GetCharLength(strListObj));
+    }
+
+    Tcl_Obj *newObj = Tcl_NewObj();
+    Tcl_InvalidateStringRep(newObj);
+    newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
+    Tcl_IncrRefCount(srcStringObj);
+    newObj->internalRep.twoPtrValue.ptr2 = infoPtr;
+    newObj->typePtr = &stringListType;
+
+    *newObjPtr = newObj;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListObjReverse --
+ *
+ *	Reverse the order of the StringList value.
+ *
+ * Results:
+ *      The result will be StringList in the reverse order.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+int
+StringListObjReverse(
+    TCL_UNUSED(Tcl_Interp *),   /* For error message(s) */
+    Tcl_Obj *strListObj,	/* List object to reverse. */
+    Tcl_Obj **newObjPtr)
+{
+    Tcl_Obj *srcStringObj, *newObj;
+    StringListInfo *infoPtr, *newInfoPtr;
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+
+    newObj = Tcl_NewObj();
+    Tcl_InvalidateStringRep(newObj);
+    newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
+    Tcl_IncrRefCount(srcStringObj);
+    newObj->typePtr = &stringListType;
+    
+    infoPtr = StringListGetInfo(strListObj);
+    if (infoPtr) {
+	if (infoPtr->startIndex == 0 && infoPtr->count < 0 &&
+	    (infoPtr->flags & STRINGLIST_REVERSE)) {
+	    /* No need for ancillary information */
+	    newInfoPtr = NULL;
+	} else {
+	    newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
+	    newInfoPtr->startIndex = infoPtr->startIndex;
+	    newInfoPtr->count = infoPtr->count;
+	    newInfoPtr->flags = infoPtr->flags ^ STRINGLIST_REVERSE;
+	}
+    } else {
+	newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
+	newInfoPtr->startIndex = 0;
+	newInfoPtr->count = -1; /* Entire string */
+	newInfoPtr->flags = STRINGLIST_REVERSE;
+    }
+
+    newObj->internalRep.twoPtrValue.ptr2 = newInfoPtr;
+    *newObjPtr = newObj;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfStringList --
+ *
+ *	Update the string representation for an StringList object.
+ *	Note: This procedure does not invalidate an existing old string rep
+ *	so storage will be lost if this has not already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the list-to-string conversion. This string will be empty if the
+ *	list has no elements. The list internal representation
+ *	should be a StringList when this function is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfStringList(Tcl_Obj *strListObj)
+{
+    Tcl_Size listLen;
+    Tcl_Size startIndex;
+    Tcl_Size numChars;
+    Tcl_Obj *srcStringObj;
+    int reversed;
+
+    assert(strListObj->bytes == NULL);
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+
+    listLen =
+	StringListGetExtent(strListObj, &startIndex, &numChars, &reversed);
+    if (listLen == 0) {
+	Tcl_InitStringRep(strListObj, NULL, 0);
+	return;
+    }
+
+    if (reversed) {
+	Tcl_Obj *tempObj = TclStringReverse(srcStringObj, TCL_STRING_IN_PLACE);
+	/* NOTE: TclStringReverse may return same or different Tcl_Obj! */
+	srcStringObj = tempObj;
+	startIndex = numChars - (startIndex + listLen) - 1;
+    }
+
+    /* srcStringObj may be original or newly allocated so we have to decrref later */
+    Tcl_IncrRefCount(srcStringObj);
+
+    const char *utf;
+    const char *utfStart = Tcl_GetString(srcStringObj);
+#   define LOCAL_SIZE 64
+    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
+    Tcl_Size i, bytesNeeded;
+    int utfLen, uniChar;
+
+    utfStart = Tcl_UtfAtIndex(utfStart, startIndex);
+
+    /* Pass 1: estimate space, gather flags. */
+    if (listLen <= LOCAL_SIZE) {
+	flagPtr = localFlags;
+    } else {
+	/* We know numElems <= LIST_MAX, so this is safe. */
+	flagPtr = (char *)Tcl_Alloc(listLen);
+    }
+    for (i = 0, bytesNeeded = 0, utf = utfStart; i < listLen; ++i) {
+	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
+	utfLen = Tcl_UtfToUniChar(utf, &uniChar);
+	bytesNeeded += TclScanElement(utf, utfLen, flagPtr+i);
+	if (bytesNeeded > TCL_SIZE_MAX - listLen) {
+	    Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX);
+	}
+	utf += utfLen;
+    }
+    bytesNeeded += listLen - 1; /* Room for space separators */
+
+    /*
+     * Pass 2: copy into string rep buffer.
+     */
+
+    char * const dstStart = Tcl_InitStringRep(strListObj, NULL, bytesNeeded);
+    char *dst;
+    TclOOM(dstStart, bytesNeeded);
+    for (i = 0, dst = dstStart, utf = utfStart; i < listLen; ++i) {
+	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
+	utfLen = Tcl_UtfToUniChar(utf, &uniChar);
+	dst += TclConvertElement(utf, utfLen, dst, flagPtr[i]);
+	*dst++ = ' ';
+	utf += utfLen;
+    }
+
+    /* Set the string length to what was actually written, the safe choice */
+    (void) Tcl_InitStringRep(strListObj, NULL, dst - 1 - dstStart);
+
+    Tcl_DecrRefCount(srcStringObj);
+    if (flagPtr != localFlags) {
+	Tcl_Free(flagPtr);
+    }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */

generic/tclTestABSList.c

@@ -72,8 +72,9 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
-    },
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
+        },
     {/*1*/
 	"lstring",
 	freeRep,
@@ -87,7 +88,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*2*/
 	"lstring",
@@ -102,7 +104,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*3*/
 	"lstring",
@@ -117,7 +120,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*4*/
 	"lstring",
@@ -132,7 +136,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    NULL,                  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*5*/
 	"lstring",
@@ -147,7 +152,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    NULL,                  /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*6*/
 	"lstring",
@@ -162,7 +168,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    NULL,                  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*7*/
 	"lstring",
@@ -177,7 +184,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    NULL)                  /* Replace */
+	    NULL,                  /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*8*/
 	"lstring",
@@ -192,7 +200,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*9*/
 	"lstring",
@@ -207,7 +216,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     },
     {/*10*/
 	"lstring",
@@ -222,7 +232,8 @@ static const Tcl_ObjType lstringTypes[11] = {
 	    my_LStringObjReverse,  /* Reverse */
 	    my_LStringGetElements, /* GetElements */
 	    my_LStringObjSetElem,  /* SetElement */
-	    my_LStringReplace)     /* Replace */
+	    my_LStringReplace,     /* Replace */
+            NULL)                  /* "in" operator */
     }
 };
 
@@ -263,7 +274,7 @@ my_LStringObjIndex(
       cchar[1] = 0;
       *charObjPtr = Tcl_NewStringObj(cchar,1);
   } else {
-      *charObjPtr = Tcl_NewObj();
+      *charObjPtr = NULL;
   }
 
   return TCL_OK;
@@ -1004,9 +1015,10 @@ lgenSeriesObjIndex(
 
     lgenSeriesRepPtr = (LgenSeries*)lgenSeriesObjPtr->internalRep.twoPtrValue.ptr1;
 
-    if (index < 0 || index >= lgenSeriesRepPtr->len)
-	return TCL_ERROR;
-
+    if (index < 0 || index >= lgenSeriesRepPtr->len) {
+	*elemPtr = NULL;
+	return TCL_OK;
+    }
     if (lgenSeriesRepPtr->interp == NULL && interp == NULL) {
 	return TCL_ERROR;
     }
@@ -1089,7 +1101,8 @@ static Tcl_ObjType lgenType = {
 	NULL, /* reverse */
 	NULL, /* get elements */
         NULL, /* set element */
-        NULL) /* replace */
+        NULL, /* replace */
+        NULL) /* "in" operator */
 };
 
 /*

generic/tclTestObj.c

@@ -982,7 +982,7 @@ TestlistobjCmd(
 			TCL_INDEX_NONE));
 		/* Keep looping since we are also looping for leaks */
 	    }
-	    Tcl_BumpObj(objP);
+	    Tcl_BounceRefCount(objP);
 	}
 	break;
 
@@ -1050,6 +1050,33 @@ TestlistobjCmd(
  *----------------------------------------------------------------------
  */
 
+static Tcl_Size V1TestListObjLength(TCL_UNUSED(Tcl_Obj *)) {
+    return 100;
+}
+
+static int V1TestListObjIndex(
+    TCL_UNUSED(Tcl_Interp *),
+    TCL_UNUSED(Tcl_Obj *),
+    TCL_UNUSED(Tcl_Size),
+    Tcl_Obj **objPtr)
+{
+    *objPtr = Tcl_NewStringObj("This indexProc should never be accessed (bug: e58d7e19e9)", -1);
+    return TCL_OK;
+}
+
+static const Tcl_ObjType v1TestListType = {
+    "testlist",			/* name */
+    NULL,		/* freeIntRepProc */
+    NULL,		/* dupIntRepProc */
+    NULL,		/* updateStringProc */
+    NULL,		/* setFromAnyProc */
+    offsetof(Tcl_ObjType, indexProc),			/* This is a V1 objType, which doesn't have an indexProc */
+    V1TestListObjLength, /* always return 100, doesn't really matter */
+    V1TestListObjIndex, /* should never be accessed, because this objType = V1*/
+    NULL, NULL, NULL, NULL, NULL, NULL
+};
+
+
 static int
 TestobjCmd(
     TCL_UNUSED(void *),
@@ -1062,15 +1089,15 @@ TestobjCmd(
     const Tcl_ObjType *targetType;
     Tcl_Obj **varPtr;
     const char *subcommands[] = {
-	"freeallvars", "bug3598580", "types",
-	"objtype", "newobj", "set",
+	"freeallvars", "bug3598580", "buge58d7e19e9",
+	"types", "objtype", "newobj", "set",
 	"assign", "convert", "duplicate",
 	"invalidateStringRep", "refcount", "type",
 	NULL
     };
     enum testobjCmdIndex {
-	TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_TYPES,
-	TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
+	TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_BUGE58D7E19E9,
+	TESTOBJ_TYPES, TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
 	TESTOBJ_ASSIGN, TESTOBJ_CONVERT, TESTOBJ_DUPLICATE,
 	TESTOBJ_INVALIDATESTRINGREP, TESTOBJ_REFCOUNT, TESTOBJ_TYPE,
     } cmdIndex;
@@ -1112,6 +1139,15 @@ TestobjCmd(
 	    Tcl_SetObjResult(interp, listObjPtr);
 	}
 	return TCL_OK;
+    case TESTOBJ_BUGE58D7E19E9:
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	} else {
+	    Tcl_Obj *listObjPtr = Tcl_NewStringObj(Tcl_GetString(objv[2]), -1);
+	    listObjPtr->typePtr = &v1TestListType;
+	    Tcl_SetObjResult(interp, listObjPtr);
+	}
+	return TCL_OK;
     case TESTOBJ_TYPES:
 	if (objc != 2) {
 	    goto wrongNumArgs;

generic/tclUtil.c

@@ -138,7 +138,7 @@ TclLengthOne(
 {
     return 1;
 }
-
+
 /*
  *	*	STRING REPRESENTATION OF LISTS	*	*	*
  *
@@ -2005,16 +2005,12 @@ Tcl_ConcatObj(
 			!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
 		    /* Abandon ship! */
 		    Tcl_DecrRefCount(resPtr);
-		    Tcl_BumpObj(elemPtr); // could be an abstract list element
+		    Tcl_BounceRefCount(elemPtr); // could be an abstract list element
 		    goto slow;
 		}
-		Tcl_BumpObj(elemPtr); // could be an an abstract list element
+		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) {
@@ -3382,7 +3378,7 @@ GetWideForIndex(
 	if (numType == TCL_NUMBER_INT) {
 	    /* objPtr holds an integer in the signed wide range */
 	    *widePtr = *(Tcl_WideInt *)cd;
-	    if ((*widePtr < 0)) {
+            if ((*widePtr < 0)) {
 		*widePtr = (endValue == -1) ? WIDE_MIN : -1;
 	    }
 	    return TCL_OK;
@@ -3390,7 +3386,7 @@ GetWideForIndex(
 	if (numType == TCL_NUMBER_BIG) {
 	    /* objPtr holds an integer outside the signed wide range */
 	    /* Truncate to the signed wide range. */
-	    *widePtr = ((mp_isneg((mp_int *)cd)) ? ((endValue == -1) ? WIDE_MIN : -1) : WIDE_MAX);
+	    *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
 	    return TCL_OK;
 	}
     }
@@ -3412,12 +3408,14 @@ GetWideForIndex(
  *	(0..TCL_SIZE_MAX) it is returned. Higher values are returned as
  *	TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1).
  *
+ *	Callers should pass reasonable values for endValue - one in the
+ *      valid index range or TCL_INDEX_NONE (-1), for example for an empty
+ *	list.
  *
  * Results:
  * 	TCL_OK
  *
- * 	    The index is stored at the address given by by 'indexPtr'. If
- * 	    'objPtr' has the value "end", the value stored is 'endValue'.
+ * 	    The index is stored at the address given by by 'indexPtr'.
  *
  * 	TCL_ERROR
  *
@@ -3425,10 +3423,9 @@ GetWideForIndex(
  * 	    'interp' is non-NULL, an error message is left in the interpreter's
  * 	    result object.
  *
- * Effect
+ * Side effects:
  *
- * 	The object referenced by 'objPtr' is converted, as needed, to an
- * 	integer, wide integer, or end-based-index object.
+ * 	The internal representation contained within objPtr may shimmer.
  *
  *----------------------------------------------------------------------
  */
@@ -3450,13 +3447,16 @@ Tcl_GetIntForIndex(
 	return TCL_ERROR;
     }
     if (indexPtr != NULL) {
-	if ((wide < 0) && (endValue >= 0)) {
-	    *indexPtr = TCL_INDEX_NONE;
+	/* Note: check against TCL_SIZE_MAX needed for 32-bit builds */
+	if (wide >= 0 && wide <= TCL_SIZE_MAX) {
+	    *indexPtr = (Tcl_Size)wide; /* A valid index */
 	} else if (wide > TCL_SIZE_MAX) {
-	    *indexPtr = TCL_SIZE_MAX;
+	    *indexPtr = TCL_SIZE_MAX;   /* Beyond max possible index */
 	} else if (wide < -1-TCL_SIZE_MAX) {
-	    *indexPtr = -1-TCL_SIZE_MAX;
-	} else {
+            *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */
+        } else if ((wide < 0) && (endValue >= 0)) {
+            *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */
+        } else {
 	    *indexPtr = (Tcl_Size) wide;
 	}
     }
@@ -3697,17 +3697,27 @@ GetEndOffsetFromObj(
     offset = irPtr->wideValue;
 
     if (offset == WIDE_MAX) {
+	/*
+	 * Encodes end+1. This is distinguished from end+n as noted
+         * in function header.
+	 * NOTE: this may wrap around if the caller passes (as lset does)
+	 * listLen-1 as endValue and and listLen is 0. The -1 will be
+	 * interpreted as FF...FF and adding 1 will result in 0 which
+	 * is what we want. Callers like lset which pass in listLen-1 == -1
+         * as endValue will have to adjust accordingly.
+	 */
 	*widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1;
     } else if (offset == WIDE_MIN) {
+	/* -1 - position before first */
 	*widePtr = -1;
-    } else if (endValue == -1) {
-	*widePtr = offset;
     } else if (offset < 0) {
-	/* Different signs, sum cannot overflow */
-	*widePtr = (size_t)endValue + offset + 1;
+	/* end-(n-1) - Different signs, sum cannot overflow */
+	*widePtr = endValue + offset + 1;
     } else if (offset < WIDE_MAX) {
+	/* 0:WIDE_MAX-1 - plain old index. */
 	*widePtr = offset;
     } else {
+	/* Huh, what case remains here? */
 	*widePtr = WIDE_MAX;
     }
     return TCL_OK;
@@ -3732,19 +3742,26 @@ GetEndOffsetFromObj(
  *----------------------------------------------------------------------
  *
  * TclIndexEncode --
+ *      IMPORTANT: function only encodes indices in the range that fits within
+ *      an "int" type. Do NOT change this as the byte code compiler and engine
+ *      which call this function cannot handle wider index types. Indices
+ *      outside the range will result in the function returning an error.
  *
  *      Parse objPtr to determine if it is an index value. Two cases
  *	are possible.  The value objPtr might be parsed as an absolute
- *	index value in the C signed int range.  Note that this includes
+ *	index value in the Tcl_Size range.  Note that this includes
  *	index values that are integers as presented and it includes index
- *      arithmetic expressions. The absolute index values that can be
+ *      arithmetic expressions.
+ *
+ *      The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX.
+ *      This means the largest supported character length is also TCL_SIZE_MAX,
+ *      and the index of the last character in a string of length TCL_SIZE_MAX
+ *      is TCL_SIZE_MAX-1. Thus the absolute index values that can be
  *	directly meaningful as an index into either a list or a string are
- *	those integer values >= TCL_INDEX_START (0)
- *	and < INT_MAX.
- *      The largest string supported in Tcl 8 has bytelength INT_MAX.
- *      This means the largest supported character length is also INT_MAX,
- *      and the index of the last character in a string of length INT_MAX
- *      is INT_MAX-1.
+ *	integer values in the range 0 to TCL_SIZE_MAX - 1.
+ *
+ *      This function however can only handle integer indices in the range
+ *      0 : INT_MAX-1.
  *
  *      Any absolute index value parsed outside that range is encoded
  *      using the before and after values passed in by the
@@ -3769,12 +3786,9 @@ GetEndOffsetFromObj(
  *      if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed,
  *      they can be encoded with the before value.
  *
- *      These details will require re-examination whenever string and
- *      list length limits are increased, but that will likely also
- *      mean a revised routine capable of returning Tcl_WideInt values.
- *
  * Returns:
- *      TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *      TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the
+ *      index does not fit in an int type.
  *
  * Side effects:
  *      When TCL_OK is returned, the encoded index value is written
@@ -3787,51 +3801,138 @@ int
 TclIndexEncode(
     Tcl_Interp *interp,	/* For error reporting, may be NULL */
     Tcl_Obj *objPtr,	/* Index value to parse */
-    int before,	/* Value to return for index before beginning */
+    int before,		/* Value to return for index before beginning */
     int after,		/* Value to return for index after end */
     int *indexPtr)	/* Where to write the encoded answer, not NULL */
 {
     Tcl_WideInt wide;
     int idx;
+    const Tcl_WideInt ENDVALUE = 2 * (Tcl_WideInt) INT_MAX;
 
-    if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType);
-	if (irPtr && irPtr->wideValue >= 0) {
-	    /* "int[+-]int" syntax, works the same here as "int" */
-	    irPtr = NULL;
-	}
+    assert(ENDVALUE < WIDE_MAX);
+    if (TCL_OK != GetWideForIndex(interp, objPtr, ENDVALUE, &wide)) {
+	return TCL_ERROR;
+    }
+    /*
+     * We passed 2*INT_MAX as the "end value" to GetWideForIndex. The computed
+     * index will be in one of the following ranges that need to be
+     * distinguished for encoding purposes in the following code.
+     * (1) 0:INT_MAX when
+     *     (a) objPtr was a pure non-negative numeric value in that range
+     *     (b) objPtr was a numeric computation M+/-N with a result in that range
+     *     (c) objPtr was of the form end-N where N was in range INT_MAX:2*INT_MAX
+     * (2) INT_MAX+1:2*INT_MAX when
+     *     (a,b) as above
+     *     (c) objPtr was of the form end-N where N was in range 0:INT_MAX-1
+     * (3) 2*INT_MAX:WIDE_MAX when
+     *     (a,b) as above
+     *     (c) objPtr was of the form end+N
+     * (4) (2*INT_MAX)-TCL_SIZE_MAX : -1 when
+     *     (a,b) as above
+     *     (c) objPtr was of the form end-N where N was in the range 0:TCL_SIZE_MAX
+     * (5) WIDE_MIN:(2*INT_MAX)-TCL_SIZE_MAX
+     *     (a,b) as above
+     *     (c) objPtr was of the form end-N where N was > TCL_SIZE_MAX
+     *
+     * For all cases (b) and (c), the internal representation of objPtr
+     * will be shimmered to endOffsetType. That allows us to distinguish between
+     * (for example) 1a (encodable) and 1c (not encodable) though the computed
+     * index value is the same.
+     *
+     * Further note, the values TCL_SIZE_MAX < N < WIDE_MAX come into play
+     * only in the 32-bit builds as TCL_SIZE_MAX == WIDE_MAX for 64-bits.
+     */
+
+    const Tcl_ObjInternalRep *irPtr =
+	TclFetchInternalRep(objPtr, &endOffsetType);
+
+    if (irPtr && irPtr->wideValue >= 0) {
 	/*
-	 * We parsed an end+offset index value.
-	 * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
+	 * "int[+-]int" syntax, works the same here as "int".
+	 * Note same does not hold for negative integers.
+	 * Distinguishes 1b and 1c where wide will be in 0:INT_MAX for
+	 * both but irPtr->wideValue will be negative for 1c.
 	 */
-	if ((irPtr ? ((wide < INT_MIN) && ((Tcl_Size)-wide <= LIST_MAX))
-		: ((wide > INT_MAX) && ((Tcl_Size)wide <= LIST_MAX))) && (sizeof(int) != sizeof(Tcl_Size))) {
-	    if (interp) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"index \"%s\" out of range",
-			TclGetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
-			"OUTOFRANGE", NULL);
-	    }
-	    return TCL_ERROR;
-	} else if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) {
+	irPtr = NULL;
+    }
+
+    if (irPtr == NULL) {
+	/* objPtr can be treated as a purely numeric value. */
+
+	/*
+	 * On 64-bit systems, indices in the range INT_MAX:TCL_SIZE_MAX are
+	 * valid indices but are not in the encodable range. Thus an
+	 * error is raised. On 32-bit systems, indices in that range indicate
+	 * the position after the end and so do not raise an error.
+	 */
+	if ((sizeof(int) != sizeof(Tcl_Size)) &&
+	    (wide > INT_MAX) && (wide < WIDE_MAX-1)) {
+	    /* 2(a,b) on 64-bit systems*/
+	    goto rangeerror;
+	}
+	if (wide > INT_MAX) {
 	    /*
-	     * All end+postive or end-negative expressions
-	     * always indicate "after the end".
+	     * 3(a,b) on 64-bit systems and 2(a,b), 3(a,b) on 32-bit systems
+	     * Because of the check above, this case holds for indices
+	     * greater than INT_MAX on 32-bit systems and > TCL_SIZE_MAX
+	     * on 64-bit systems. Always maps to the element after the end.
 	     */
 	    idx = after;
-	} else if (wide <= (irPtr ? INT_MAX : -1)) {
-	    /* These indices always indicate "before the beginning" */
+	} else if (wide < 0) {
+	    /* 4(a,b) (32-bit systems), 5(a,b) - before the beginning */
 	    idx = before;
 	} else {
-	    /* Encoded end-positive (or end+negative) are offset */
+	    /* 1(a,b) Encodable range */
 	    idx = (int)wide;
 	}
     } else {
-	return TCL_ERROR;
+	/* objPtr is not purely numeric (end etc.)  */
+
+	/*
+	 * On 64-bit systems, indices in the range end-LIST_MAX:end-INT_MAX
+	 * are valid indices (with max size strings/lists) but are not in
+	 * the encodable range. Thus an error is raised. On 32-bit systems,
+	 * indices in that range indicate the position before the beginning
+	 * and so do not raise an error.
+	 */
+	if ((sizeof(int) != sizeof(Tcl_Size)) &&
+	    (wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) {
+	    /* 1(c), 4(a,b) on 64-bit systems */
+	    goto rangeerror;
+	}
+	if (wide > ENDVALUE) {
+	    /*
+	     * 2(c) (32-bit systems), 3(c)
+	     * All end+positive or end-negative expressions
+	     * always indicate "after the end".
+	     * Note we will not reach here for a pure numeric value in this
+	     * range because irPtr will be NULL in that case.
+	     */
+	    idx = after;
+	} else if (wide <= INT_MAX) {
+	    /* 1(c) (32-bit systems), 4(c) (32-bit systems), 5(c) */
+	    idx = before;
+	} else {
+	    /* 2(c) Encodable end-positive (or end+negative) */
+	    idx = (int)wide;
+	}
     }
     *indexPtr = idx;
     return TCL_OK;
+
+rangeerror:
+    if (interp) {
+	Tcl_SetObjResult(
+	    interp,
+	    Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr)));
+	Tcl_SetErrorCode(interp,
+			 "TCL",
+			 "VALUE",
+			 "INDEX"
+			 "OUTOFRANGE",
+			 NULL);
+    }
+    return TCL_ERROR;
 }
 
 /*
@@ -3857,8 +3958,9 @@ TclIndexDecode(
     if (encoded > TCL_INDEX_END) {
 	return encoded;
     }
-    if ((size_t)endValue >= (size_t)TCL_INDEX_END - encoded) {
-	return endValue + encoded - TCL_INDEX_END;
+    endValue += encoded - TCL_INDEX_END;
+    if (endValue >= 0) {
+	return endValue;
     }
     return TCL_INDEX_NONE;
 }

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;
 	}

tests/abstractlist.test

@@ -27,8 +27,8 @@ proc value-cmp {vara varb} {
     return [string compare $ta $tb]
 }
 
-set str "My name is Inigo Montoya. You killed my father. Prepare to die!"
-set str2 "Vizzini: HE DIDN'T FALL? INCONCEIVABLE. Inigo Montoya: You keep using that word. I do not think it means what you think it means."
+set str "If you can keep your head when all about you Are losing theirs and blaming it on you,"
+set str2 "If you can trust yourself when all men doubt you, But make allowance for their doubting, too."
 
 test abstractlist-1.0 {error cases} -body {
     lstring
@@ -49,7 +49,7 @@ test abstractlist-2.0 {no shimmer llength} -body {
     list $l ${l-isa} ${len} ${l-isa2}
 } -cleanup {
 unset l
-} -result {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring}
+} -result {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring}
 
 test abstractlist-2.1 {no shimmer lindex} {
     set l [lstring $str]
@@ -57,7 +57,7 @@ test abstractlist-2.1 {no shimmer lindex} {
     set ele [lindex $l 22]
     set l-isa2 [testobj objtype $l]
     list $l ${l-isa} ${ele} ${l-isa2}
-} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring}
+} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring}
 
 test abstractlist-2.2 {no shimmer lreverse} {
     set l [lstring $str]
@@ -66,7 +66,7 @@ test abstractlist-2.2 {no shimmer lreverse} {
     set r-isa [testobj objtype $r]
     set l-isa2 [testobj objtype $l]
     list $r ${l-isa} ${r-isa} ${l-isa2}
-} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring}
+} {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring}
 
 test abstractlist-2.3 {no shimmer lrange} {
     set l [lstring $str]
@@ -82,7 +82,7 @@ test abstractlist-2.3 {no shimmer lrange} {
     }]
     set l-isa3 [testobj objtype $l]
     list ${l-isa} $il ${l-isa2} ${l-isa3} $words
-} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+} {lstring {2 6 10 15 20 25 30 34 40 44 48 55 62 66 74 77 80 85} lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
 
 test abstractlist-2.4 {no shimmer foreach} {
     set l [lstring $str]
@@ -102,7 +102,7 @@ test abstractlist-2.4 {no shimmer foreach} {
     }
     set l-isa2 [testobj objtype $l]
     list ${l-isa} ${l-isa2} $words
-} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+} {lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
 
 #
 # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
@@ -110,26 +110,26 @@ test abstractlist-2.4 {no shimmer foreach} {
 test abstractlist-2.5 {!no shimmer lreplace} {
     set l [lstring $str2]
     set l-isa [testobj objtype $l]
-    set m [lreplace $l 18 23 { } f a i l ?]
+    set m [lreplace $l 78 86 { } f a i l i n g]
     set m-isa [testobj objtype $m]
     set l-isa1 [testobj objtype $l]
     list ${l-isa} $m ${m-isa} ${l-isa1}
-} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring lstring}
+} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } f a i l i n g , { } t o o .} lstring lstring}
 
 test abstractlist-2.6 {no shimmer ledit} {
     # "ledit m 9 8 S"
     set l [lstring $str2]
     set l-isa [testobj objtype $l]
-    set e [ledit l 9 8 S]
+    set e [ledit l 68 67 s]
     set e-isa [testobj objtype $e]
     list ${l-isa} $e ${e-isa}
-} {lstring {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}
+} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
 
 test abstractlist-2.7 {no shimmer linsert} -body {
     # "ledit m 9 8 S"
     set l [lstring $str2]
     set l-isa [testobj objtype $l]
-    set i [linsert $l 12 {*}[split "almost " {}]]
+    set i [linsert $l 11 {*}[split "truly " {}]]
     set i-isa [testobj objtype $i]
     set res [list ${l-isa} $i ${i-isa}]
     set p [lpop i 23]
@@ -138,7 +138,7 @@ test abstractlist-2.7 {no shimmer linsert} -body {
     lappend res $p ${p-isa} $i ${i-isa2}
 } -cleanup {
 unset l i l-isa i-isa res p p-isa
-} -result {lstring {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring ' none {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}
+} -result {lstring {I f { } y o u { } c a n { } t r u l y { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring y none {I f { } y o u { } c a n { } t r u l y { } t r u s t { } o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
 
 test abstractlist-2.8 {shimmer lassign} {
     set l [lstring Inconceivable]
@@ -210,7 +210,7 @@ test abstractlist-3.0 {no shimmer llength} {
     set len [llength $l]
     set l-isa2 [testobj objtype $l]
     list $l ${l-isa} ${len} ${l-isa2}
-} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring}
+} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring}
 
 test abstractlist-3.1 {no shimmer lindex} {
     set l [lstring -not SLICE $str]
@@ -219,7 +219,7 @@ test abstractlist-3.1 {no shimmer lindex} {
     set ele [lindex $l $n] ;# exercise INST_LIST_INDEX
     set l-isa2 [testobj objtype $l]
     list $l ${l-isa} ${ele} ${l-isa2}
-} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring}
+} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring}
 
 test abstractlist-3.2 {no shimmer lreverse} {
     set l [lstring -not SLICE $str]
@@ -228,7 +228,7 @@ test abstractlist-3.2 {no shimmer lreverse} {
     set r-isa [testobj objtype $r]
     set l-isa2 [testobj objtype $l]
     list $r ${l-isa} ${r-isa} ${l-isa2}
-} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring}
+} {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring}
 
 test abstractlist-3.3 {shimmer lrange} {
     set l [lstring -not SLICE $str]
@@ -244,7 +244,7 @@ test abstractlist-3.3 {shimmer lrange} {
     }]
     set l-isa3 [testobj objtype $l]; # lrange defaults to list behavior
     list ${l-isa} $il ${l-isa2} ${l-isa3} $words
-} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring list {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+} {lstring {2 6 10 15 20 25 30 34 40 44 48 55 62 66 74 77 80 85} lstring list {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
 
 test abstractlist-3.4 {no shimmer foreach} {
     set l [lstring -not SLICE $str]
@@ -264,7 +264,7 @@ test abstractlist-3.4 {no shimmer foreach} {
     }
     set l-isa2 [testobj objtype $l]
     list ${l-isa} ${l-isa2} $words
-} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+} {lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
 
 #
 # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
@@ -272,34 +272,34 @@ test abstractlist-3.4 {no shimmer foreach} {
 test abstractlist-3.5 {!no shimmer lreplace} {
     set l [lstring -not SLICE $str2]
     set l-isa [testobj objtype $l]
-    set m [lreplace $l 18 23 { } f a i l ?]
+    set m [lreplace $l 79 86 f a i l i n g]
     set m-isa [testobj objtype $m]
     set l-isa1 [testobj objtype $l]
     list ${l-isa} $m ${m-isa} ${l-isa1}
-} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring lstring}
+} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } f a i l i n g , { } t o o .} lstring lstring}
 
 test abstractlist-3.6 {no shimmer ledit} {
     # "ledit m 9 8 S"
     set l [lstring -not SLICE $str2]
     set l-isa [testobj objtype $l]
-    set e [ledit l 9 8 S]
+    set e [ledit l 68 67 s]
     set e-isa [testobj objtype $e]
     list ${l-isa} $e ${e-isa}
-} {lstring {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}
+} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
 
 test abstractlist-3.7 {no shimmer linsert} {
     # "ledit m 9 8 S"
     set res {}
     set l [lstring -not SLICE $str2]
     set l-isa [testobj objtype $l]
-    set i [linsert $l 12 {*}[split "almost " {}]]
+    set i [linsert $l 35 {*}[split "wo" {}]]
     set i-isa [testobj objtype $i]
     set res [list ${l-isa} $i ${i-isa}]
     set p [lpop i 23]
     set p-isa [testobj objtype $p]
     set i-isa2 [testobj objtype $i]
     lappend res $p ${p-isa} $i ${i-isa2}
-} {lstring {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring ' none {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}
+} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } w o m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring l none {I f { } y o u { } c a n { } t r u s t { } y o u r s e f { } w h e n { } a l l { } w o m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
 
 test abstractlist-3.8 {shimmer lassign} {
     set l [lstring -not SLICE Inconceivable]
@@ -359,7 +359,7 @@ test abstractlist-$not-4.0 {no shimmer llength} {
     set len [llength $l]
     set l-isa2 [testobj objtype $l]
     list $l ${l-isa} ${len} ${l-isa2}
-} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring}
+} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring}
 
 test abstractlist-$not-4.1 {no shimmer lindex} {
     set l [lstring {*}$options $str]
@@ -367,7 +367,7 @@ test abstractlist-$not-4.1 {no shimmer lindex} {
     set ele [lindex $l 22]
     set l-isa2 [testobj objtype $l]
     list $l ${l-isa} ${ele} ${l-isa2}
-} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring}
+} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring}
 
 test abstractlist-$not-4.2 {lreverse} ReverseShimmer {
     set l [lstring {*}$options $str]
@@ -376,7 +376,7 @@ test abstractlist-$not-4.2 {lreverse} ReverseShimmer {
     set r-isa [testobj objtype $r]
     set l-isa2 [testobj objtype $l]
     list $r ${l-isa} ${r-isa} ${l-isa2}
-} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring}
+} {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring}
 
 test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer {
     set l [lstring {*}$options $str]
@@ -392,7 +392,7 @@ test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer {
     }]
     set l-isa3 [testobj objtype $l]
     list ${l-isa} $il ${l-isa2} ${l-isa3} $words
-} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
 
 test abstractlist-$not-4.4 {no shimmer foreach} {
     set l [lstring {*}$options $str]
@@ -412,7 +412,7 @@ test abstractlist-$not-4.4 {no shimmer foreach} {
     }
     set l-isa2 [testobj objtype $l]
     list ${l-isa} ${l-isa2} $words
-} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}
+} {lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
 
 #
 # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
@@ -424,19 +424,17 @@ test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer {
     set m-isa [testobj objtype $m]
     set l-isa1 [testobj objtype $l]
     list ${l-isa} $m ${m-isa} ${l-isa1}
-} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} list lstring}
+} {lstring {} list lstring}
 
 test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} {
-    # "ledit m 9 8 S"
     set l [lstring {*}$options $str2]
     set l-isa [testobj objtype $l]
-    set e [ledit l 9 8 S]
+    set e [ledit l 68 67 s]
     set e-isa [testobj objtype $e]
     list ${l-isa} $e ${e-isa}
-} {lstring {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}
+} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
 
 test abstractlist-$not-4.7 {no shimmer linsert} {ReplaceShimmer GetelementsShimmer}  {
-    # "ledit m 9 8 S"
     set l [lstring {*}$options $str2]
     set l-isa [testobj objtype $l]
     set i [linsert $l 12 {*}[split "almost " {}]]
@@ -446,7 +444,7 @@ test abstractlist-$not-4.7 {no shimmer linsert} {ReplaceShimmer GetelementsShimm
     set p-isa [testobj objtype $p]
     set i-isa2 [testobj objtype $i]
     lappend res $p ${p-isa} $i ${i-isa2}
-} {lstring {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring ' none {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}
+} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
 
 # lassign probably uses lrange internally
 test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer {

tests/bigdata.test

@@ -277,14 +277,14 @@ bigtestRO string-last-bigdata-1 "string last > INT_MAX" {2 -1 2147483640 11} -bo
 } -cleanup {
     bigClean
 }
-bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967300 -1 4294967290 1} -body {
+bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967320 -1 4294967290 1} -body {
     list \
         [string last 0 $s] \
         [string last Y $s] \
         [string last 0 $s 0x100000000] \
         [string last 1 $s end-0x100000010]
 } -setup {
-    set s [bigString 0x10000000a 2]
+    set s [bigString 0x10000001a 2]
 } -cleanup {
     bigClean
 }

tests/chanio.test

@@ -6881,6 +6881,7 @@ test chan-io-52.10 {TclCopyChannel & encodings} -constraints {fcopy} -body {
 } -cleanup {
     chan close $in
     chan close $out
+    unset in out
 } -returnCodes 1 -match glob -result {error writing "*":\
 	invalid or incomplete multibyte or wide character}
 test chan-io-52.11 {TclCopyChannel & encodings} -setup {

tests/encoding.test

@@ -1102,12 +1102,8 @@ test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExtern
 } -result [list 0 [list nospace {} \x00\x00\xFF]]
 
 test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
-    testencoding ucs2 knownBug
+    testencoding 
 } -body {
-    # The knownBug constraint is because test depends on TCL_UTF_MAX and
-    # also UtfToUtf16 assumes space required in destination buffer is
-    # sizeof(Tcl_UniChar) which is incorrect when TCL_UTF_MAX==4
-    # Note - buffers are initialized to \xFF
     list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 4} result] $result
 } -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]]
 

tests/expr.test

@@ -1426,6 +1426,7 @@ test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
 test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0
 
 test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000
+test expr-24.11 {INST_LSHIFT: Bug 84a5355235} {expr -549755813888>>32} -128
 
 # List membership tests
 test expr-25.1 {'in' operator} {expr {"a" in "a b c"}} 1

tests/indexObj.test

@@ -20,6 +20,7 @@ testConstraint testindexobj [llength [info commands testindexobj]]
 testConstraint testgetintforindex [llength [info commands testgetintforindex]]
 testConstraint testparseargs [llength [info commands testparseargs]]
 testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}]
+testConstraint has32BitLengths [expr {$tcl_platform(pointerSize) == 4}]
 
 test indexObj-1.1 {exact match} testindexobj {
     testindexobj 1 1 xyz abc def xyz alm
@@ -203,25 +204,26 @@ test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
 } -2
 test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
     testgetintforindex end-1 -2
-} [expr {[testConstraint has64BitLengths] ? -3 : 2147483647}]
+} -3
 test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
     testgetintforindex end -1
 } -1
 test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
     testgetintforindex end -2
-} [expr {[testConstraint has64BitLengths] ? -2 : 2147483647}]
-test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
+} -2
+test indexObj-8.14 {Tcl_GetIntForIndex end+1} -constraints {
+    testgetintforindex has64BitLengths
+} -body {
     testgetintforindex end+1 -1
-} [expr {[testConstraint has64BitLengths] ? 9223372036854775807 : 2147483647}]
+} -result 9223372036854775807
+test indexObj-8.14.32bits {Tcl_GetIntForIndex end+1} -constraints {
+    testgetintforindex has32BitLengths
+} -body {
+    testgetintforindex end+1 -1
+} -result 2147483647
 test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
     testgetintforindex end+1 -2
 } -1
-test indexObj-8.16 {Tcl_GetIntForIndex integer} testgetintforindex {
-    testgetintforindex -1 -1
-} [expr {[testConstraint has64BitLengths] ? -9223372036854775808 : -2147483648}]
-test indexObj-8.17 {Tcl_GetIntForIndex integer} testgetintforindex {
-    testgetintforindex -2 -1
-} [expr {[testConstraint has64BitLengths] ? -9223372036854775808 : -2147483648}]
 
 # cleanup
 ::tcltest::cleanupTests

tests/io.test

@@ -1614,7 +1614,7 @@ test io-12.8 {ReadChars: multibyte chars split} {
     close $f
     scan [string index $in end] %c
 } 160
-test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body {
+test io-12.9 {ReadChars: multibyte chars split} -body {
     set f [open $path(test1) w]
     fconfigure $f -translation binary
     puts -nonewline $f [string repeat a 9]\xC2
@@ -1627,7 +1627,7 @@ test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body {
 } -cleanup {
     catch {close $f}
 } -result 194
-test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
+test io-12.11 {ReadChars: multibyte chars split} -body {
     set f [open $path(test1) w]
     fconfigure $f -translation binary
     puts -nonewline $f [string repeat a 9]\xC2
@@ -1641,9 +1641,7 @@ test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
     catch {close $f}
 } -returnCodes 1 -match glob -result {error reading "file*":\
 	invalid or incomplete multibyte or wide character}
-
-
-test {io-12.10 tcl8} {ReadChars: multibyte chars split} -body {
+test io-12.12 {ReadChars: multibyte chars split} -body {
     set f [open $path(test1) w]
     fconfigure $f -translation binary
     puts -nonewline $f [string repeat a 9]\xC2
@@ -5871,7 +5869,7 @@ test io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -body
     set l
 } -result {O D {1 {bad value for -eofchar: must be non-NUL ASCII character}}}
 test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
-        writable, it should still have valid -eofchar and -translation options } {
+	writable, it should still have valid -eofchar and -translation options } {
     set l [list]
     set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
@@ -5879,7 +5877,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
     set l
 } {{} auto}
 test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
-    writable so we can't change -eofchar or -translation } {
+	writable so we can't change -eofchar or -translation } {
     set l [list]
     set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     fconfigure $sock -eofchar D -translation lf
@@ -9317,6 +9315,7 @@ test io-75.7 {
 } -cleanup {
     close $f
     removeFile io-75.7
+    unset msg f fn
 } -match glob -result {1 {error reading "file*":\
     invalid or incomplete multibyte or wide character}}
 
@@ -9354,17 +9353,16 @@ test io-75.8.eoflater {invalid utf-8 encoding eof handling (-profile strict)} -s
     fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
 	-translation lf -profile strict
 } -body {
-    set res [list [catch {read $f} cres] [eof $f]]
+    set res [list [catch {read $f} msg] [eof $f]]
     chan configure $f -encoding iso8859-1
     lappend res [read $f 1]
     chan configure $f -encoding utf-8
-    catch {read $f 1} cres
-    lappend res $cres
-    close $f
-    set res
+    lappend res [catch {read $f 1} msg] $msg
 } -cleanup {
+    close $f
     removeFile io-75.8
-} -match glob -result "1 0 \x81 {error reading \"*\":\
+    unset res msg fn f
+} -match glob -result "1 0 \x81 1 {error reading \"*\":\
     invalid or incomplete multibyte or wide character}"
 
 
@@ -9373,7 +9371,6 @@ test io-strict-multibyte-eof {
 
     See issue 25cdcb7e8fb381fb
 } -setup {
-    set res {}
     set chan [file tempfile];
     fconfigure $chan -encoding binary
     puts -nonewline $chan \x81\x1A
@@ -9381,10 +9378,10 @@ test io-strict-multibyte-eof {
     seek $chan 0
     chan configure $chan -encoding utf-8 -profile strict
 } -body {
-    list [catch {read $chan 1} cres] $cres
+    list [catch {read $chan 1} msg] $msg
 } -cleanup {
     close $chan
-    unset res
+    unset msg chan
 } -match glob -result {1 {error reading "*":\
     invalid or incomplete multibyte or wide character}}
 
@@ -9400,6 +9397,7 @@ test io-75.9 {unrepresentable character write passes and is replaced by ?} -setu
 } -cleanup {
     close $f
     removeFile io-75.9
+    unset f
 } -match glob -result [list {A} {error writing "*":\
     invalid or incomplete multibyte or wide character}]
 
@@ -9454,6 +9452,7 @@ test io-75.11 {shiftjis encoding error read results in raw bytes} -setup {
 } -cleanup {
     close $f
     removeFile io-75.11
+    unset d hd msg f
 } -match glob -result {41 1 {error reading "file*":\
     invalid or incomplete multibyte or wide character}}
 
@@ -9505,6 +9504,7 @@ test io-75.13 {
 } -cleanup {
     close $f
     removeFile io-75.13
+    unset d hd msg f fn
 } -match glob -result {41 1 {error reading "file*":\
     invalid or incomplete multibyte or wide character}}
 
@@ -9522,14 +9522,16 @@ test io-75.14 {
     fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \
 	-translation auto -profile strict
 } -body {
+    set res [gets $chan]
     lappend res [gets $chan]
-    lappend res [gets $chan]
-    lappend res [catch {gets $chan} cres] $cres
+    lappend res [catch {gets $chan} msg] $msg
     chan configure $chan -profile tcl8
     lappend res [gets $chan]
     lappend res [gets $chan]
-    close $chan
     return $res
+} -cleanup {
+    close $chan
+    unset chan res msg
 } -match glob -result {a b 1 {error reading "*":\
     invalid or incomplete multibyte or wide character} cÀ d}
 
@@ -9549,8 +9551,8 @@ test io-75.15 {
     fconfigure $chan -encoding utf-8 -profile strict
     lappend res [gets $chan]
     lappend res [gets $chan]
-    lappend res [catch {gets $chan} cres] $cres
-    lappend res [catch {gets $chan} cres] $cres
+    lappend res [catch {gets $chan} msg] $msg
+    lappend res [catch {gets $chan} msg] $msg
 	chan configure $chan -translation binary
 	set data [read $chan 4]
 	foreach char [split $data {}] {
@@ -9563,6 +9565,7 @@ test io-75.15 {
     return $res
 } -cleanup {
     close $chan
+    unset chan res msg data
 } -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
     1 {error reading "*": invalid or incomplete multibyte or wide character} 43 44 c0 40 EF GHI}
 

tests/listObj.test

@@ -223,6 +223,11 @@ test listobj-10.5 {Tcl_ListObjReplace with SIZE_MAX-1 count value} testobj {
 test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
     testobj bug3598580
 } 123
+test listobj-11.2 {Bug e58d7e19e9: Upwards compatibility of TclObjTypeHasProc()} testobj {
+    set l [testobj buge58d7e19e9 "a x c"]
+    # Since $l is a V1 objType, it's lengthProc will be accessed, but not its indexProc.
+    list [llength $l] [lindex $l 2]
+} {100 c}
 
 # Stolen from dict.test
 proc listobjmemcheck script {
@@ -314,14 +319,10 @@ test listobj-14.2 {Tcl_ListObjIndex out-of-bounds index for native lists with sp
     list [testlistobj index 1 -1] [testlistobj index 1 1000]
 } -result {null null}
 
-test listobj-14.3 {Tcl_ListObjIndex out-of-bounds index for lseq} -constraints {
-    testobj
-} -setup {
+test listobj-14.3 {Tcl_ListObjIndex out-of-bounds index for lseq} -constraints {bug-30e4e9102f testobj} -setup {
     testobj set 1 [lseq 3]
 } -cleanup {
     testobj freeallvars
-} -constraints {
-    bug-30e4e9102f
 } -body {
     list [testlistobj index 1 -1] [testlistobj index 1 3]
 } -result {null null}

tests/lseq.test

@@ -485,6 +485,49 @@ test lseq-3.33 {lsearch nested lists of lseq} -constraints arithSeriesShimmer -b
     unset srchlist i a b
 } -result {list {{20 23 26 29 32 35 38}} arithseries arithseries}
 
+test lseq-3.34 {"in" operator} -body {
+    set seq [lseq 0.3 15e4 0.1]
+    set inlist {}
+    set nilist {}
+    foreach y [lseq 3012.0 3013.0 0.03] {
+	if {$y in $seq} {
+	    lappend inlist $y
+	} else {
+	    lappend nilist $y
+	}
+    }
+    list $inlist $nilist
+} -cleanup {
+    unset seq inlist nilist y
+} -result {{3012.0 3012.3 3012.6 3012.9} {3012.03 3012.06 3012.09 3012.12 3012.15 3012.18 3012.21 3012.24 3012.27 3012.33 3012.36 3012.39 3012.42 3012.45 3012.48 3012.51 3012.54 3012.57 3012.63 3012.66 3012.69 3012.72 3012.75 3012.78 3012.81 3012.84 3012.87 3012.93 3012.96 3012.99}}
+
+test lseq-3.35 {"in" operator integer} -body {
+    set seq [lseq 3 int(15e4) 5]
+    set inlist {}
+    set nilist {}
+    foreach y [lseq 3012 3213 3] {
+	if {$y in $seq} {
+	    lappend inlist $y
+	} else {
+	    lappend nilist $y
+	}
+    }
+    list $inlist $nilist
+} -cleanup {
+    unset seq inlist nilist y
+} -result {{3018 3033 3048 3063 3078 3093 3108 3123 3138 3153 3168 3183 3198 3213} {3012 3015 3021 3024 3027 3030 3036 3039 3042 3045 3051 3054 3057 3060 3066 3069 3072 3075 3081 3084 3087 3090 3096 3099 3102 3105 3111 3114 3117 3120 3126 3129 3132 3135 3141 3144 3147 3150 3156 3159 3162 3165 3171 3174 3177 3180 3186 3189 3192 3195 3201 3204 3207 3210}}
+
+test lseq-3.36 {"in" non-numeric case} -body {
+    if {"barney" in [lseq 15]} {
+	set res found
+    } else {
+	set res not-found
+    }
+    set res
+} -cleanup {
+    unset res
+} -result {not-found}
+
 test lseq-4.1 {end expressions} -body {
     set start 7
     lseq $start $start+11
@@ -647,7 +690,7 @@ test lseq-4.12.32 {bug lseq} -constraints has32BitLengths -body {
     llength [lseq 0x100000000]
 } -returnCodes 1 -result {max length of a Tcl list exceeded}
 
-test lseq-4.13 {bug lseq} -constraints knownBug -body {
+test lseq-4.13 {bug lseq} -constraints has64BitLengths -body {
     set l [lseq 0x7fffffffffffffff]
     list \
     [llength $l] \

unix/Makefile.in

@@ -313,7 +313,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
 	tclPkg.o tclPkgConfig.o tclPosixStr.o \
 	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
-	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
+	tclResolve.o tclResult.o tclScan.o tclStringObj.o tclStringList.o \
 	tclStrToD.o tclThread.o \
 	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
 	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
@@ -466,6 +466,7 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclScan.c \
 	$(GENERIC_DIR)/tclStubInit.c \
 	$(GENERIC_DIR)/tclStringObj.c \
+	$(GENERIC_DIR)/tclStringList.c \
 	$(GENERIC_DIR)/tclStrToD.c \
 	$(GENERIC_DIR)/tclTest.c \
 	$(GENERIC_DIR)/tclTestABSList.c \
@@ -1529,6 +1530,9 @@ tclScan.o: $(GENERIC_DIR)/tclScan.c
 tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c $(MATHHDRS)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c
 
+tclStringList.o: $(GENERIC_DIR)/tclStringList.c $(MATHHDRS)
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringList.c
+
 tclStrToD.o: $(GENERIC_DIR)/tclStrToD.c $(MATHHDRS)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrToD.c
 

unix/installManPage

@@ -5,13 +5,14 @@
 ###
 
 Gzip=:
-SymOrLoc=""
+Sym=""
+Loc=""
 Gz=""
 Suffix=""
 
 while true; do
     case $1 in
-        -s | --symlinks  ) SymOrLoc="-s "      ;;
+        -s | --symlinks  )      Sym="-s "      ;;
         -z | --compress  )     Gzip=$2;  shift ;;
 	-e | --extension )       Gz=$2;  shift ;;
 	-x | --suffix    )   Suffix=$2;  shift ;;
@@ -47,7 +48,7 @@ if test -d "$Dir" ; then : ; else
     echo "target directory must exist"
     exit 1
 fi
-test -z "$SymOrLoc" && SymOrLoc="$Dir/"
+test -z "$Sym" && Loc="$Dir/"
 
 ########################################################################
 ### Extract Target Names from Manual Page
@@ -132,7 +133,7 @@ for Target in $Names; do
 	chmod 644 "$Dir/$First"
 	$Gzip "$Dir/$First"
     else
-	ln $SymOrLoc"$First$Gz" "$Dir/$Target$Gz"
+	ln $Sym"$Loc$First$Gz" "$Dir/$Target$Gz"
     fi
 done
 

unix/tcl.m4

@@ -1087,9 +1087,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	    DL_LIBS="-ldl"
 	    CC_SEARCH_FLAGS=""
 	    LD_SEARCH_FLAGS=""
-	    TCL_NEEDS_EXP_FILE=1
-	    TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a'
-	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a"
 	    AC_CACHE_CHECK(for Cygwin version of gcc,
 		ac_cv_cygwin,
 		AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
@@ -1805,7 +1802,7 @@ dnl # preprocessing tests use only CPPFLAGS.
         LIB_SUFFIX=${SHARED_LIB_SUFFIX}
         MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
         AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [
-            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
+            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"'
             DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
         ], [
             INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'

win/Makefile.in

@@ -351,6 +351,7 @@ GENERIC_OBJS = \
 	tclResult.$(OBJEXT) \
 	tclScan.$(OBJEXT) \
 	tclStringObj.$(OBJEXT) \
+	tclStringList.$(OBJEXT) \
 	tclStrToD.$(OBJEXT) \
 	tclStubInit.$(OBJEXT) \
 	tclThread.$(OBJEXT) \
@@ -852,7 +853,7 @@ install-binaries: binaries
 		$(COPY) $$i "$(BIN_INSTALL_DIR)"; \
 	    fi; \
 	    done
-	@for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
+	@for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) @ZLIB_LIBS@ @TOMMATH_LIBS@; \
 	    do \
 	    if [ -f $$i ]; then \
 		echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \

win/configure.ac

@@ -121,6 +121,8 @@ AS_IF([test "${enable_shared+set}" = "set"], [
 ], [
   tcl_ok=yes
 ])
+zlib_lib_name=zdll.lib
+tommath_lib_name=tommath.lib
 AS_IF([test "$tcl_ok" = "yes"], [
   AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
   AC_SUBST(TOMMATH_DLL_FILE,[\${TOMMATH_DLL_FILE}])
@@ -131,6 +133,8 @@ AS_IF([test "$tcl_ok" = "yes"], [
       AS_IF([test "$GCC" == "yes"],[
         AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.a])
         AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/libtommath.dll.a])
+        zlib_lib_name=libz.dll.a
+        tommath_lib_name=libtommath.dll.a
       ], [
         AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib])
         AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib])
@@ -139,6 +143,8 @@ AS_IF([test "$tcl_ok" = "yes"], [
       AS_IF([test "$GCC" == "yes"],[
         AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a])
         AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a])
+        zlib_lib_name=libz.dll.a
+        tommath_lib_name=libtommath.dll.a
       ], [
         AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib])
         AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/tommath.lib])
@@ -153,7 +159,8 @@ AS_IF([test "$tcl_ok" = "yes"], [
   AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}])
 ])
 AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])
-
+AC_SUBST(TCL_ZLIB_LIB_NAME, $zlib_lib_name)
+AC_SUBST(TCL_TOMMATH_LIB_NAME, $tommath_lib_name)
 AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[
 #include <stdint.h>
 ]])
@@ -321,23 +328,23 @@ eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
 eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
 
 if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then
+ eval "TCL_LIB_FLAG=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
  eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
 else
+ eval "TCL_LIB_FLAG=\"-ltcl${VER}${FLAGSUFFIX}\""
  eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\""
 fi
-eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\""
-eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""
+eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\""
+eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\""
 
 # Install time header dir can be set via --includedir
 eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
 
 TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
 TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
 
 CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
 CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
-CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
 
 #--------------------------------------------------------------------
 # Adjust the defines for how the resources are built depending
@@ -404,7 +411,6 @@ AC_SUBST(TCL_SRC_DIR)
 AC_SUBST(TCL_BIN_DIR)
 AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
 AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
-AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
 
 # win/tcl.m4 doesn't set (CFLAGS)
 AC_SUBST(CFLAGS_DEFAULT)
@@ -443,15 +449,7 @@ AC_SUBST(POST_MAKE_LIB)
 AC_SUBST(MAKE_DLL)
 AC_SUBST(MAKE_EXE)
 
-# empty on win, but needs sub'ing
 AC_SUBST(TCL_BUILD_LIB_SPEC)
-AC_SUBST(TCL_CC_SEARCH_FLAGS)
-AC_SUBST(TCL_LD_SEARCH_FLAGS)
-AC_SUBST(TCL_NEEDS_EXP_FILE)
-AC_SUBST(TCL_BUILD_EXP_FILE)
-AC_SUBST(TCL_EXP_FILE)
-AC_SUBST(DL_LIBS)
-AC_SUBST(TCL_LIB_VERSIONS_OK)
 AC_SUBST(TCL_PACKAGE_PATH)
 
 # win only

win/makefile.vc

@@ -307,6 +307,7 @@ COREOBJS = \
 	$(TMP_DIR)\tclResult.obj \
 	$(TMP_DIR)\tclScan.obj \
 	$(TMP_DIR)\tclStringObj.obj \
+	$(TMP_DIR)\tclStringList.obj \
 	$(TMP_DIR)\tclStrToD.obj \
 	$(TMP_DIR)\tclStubInit.obj \
 	$(TMP_DIR)\tclThread.obj \
@@ -745,7 +746,6 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in
 @LDFLAGS_DEBUG@      -nologo -machine:$(MACHINE) -debug -debugtype:cv
 @LDFLAGS_OPTIMIZE@   -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
 @TCL_LIB_FILE@       $(PROJECT)$(VERSION)$(SUFX).lib
-@TCL_NEEDS_EXP_FILE@
 @LIBS@               $(baselibs) $(PRJ_LIBS)
 @prefix@             $(_INSTALLDIR)
 @exec_prefix@        $(BIN_INSTALL_DIR)
@@ -757,17 +757,13 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in
 @STLIB_LD@           $(lib32) -nologo
 @SHLIB_LD_LIBS@      $(baselibs) $(PRJ_LIBS)
 @SHLIB_SUFFIX@       .dll
-@DL_LIBS@
 @LDFLAGS@
-@TCL_CC_SEARCH_FLAGS@
-@TCL_LD_SEARCH_FLAGS@
 @LIBOBJS@
 @RANLIB@
-@TCL_LIB_FLAG@
-@TCL_BUILD_LIB_SPEC@
+@TCL_LIB_FLAG@       $(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_BUILD_LIB_SPEC@ $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
 @TCL_LIB_SPEC@       $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
 @TCL_INCLUDE_SPEC@   -I$(INCLUDE_INSTALL_DIR)
-@TCL_LIB_VERSIONS_OK@
 @TCL_SRC_DIR@        $(ROOT)
 @TCL_PACKAGE_PATH@
 @TCL_STUB_LIB_FILE@  $(TCLSTUBLIBNAME)
@@ -776,7 +772,6 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in
 @TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
 @TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
 @TCL_STUB_LIB_PATH@  $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
-@CFG_TCL_EXPORT_FILE_SUFFIX@  $(VERSION)$(SUFX).lib
 @CFG_TCL_SHARED_LIB_SUFFIX@   $(VERSION)$(SUFX).dll
 @CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
 !if $(STATIC_BUILD)
@@ -784,6 +779,8 @@ $(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in
 !else
 @TCL_SHARED_BUILD@   1
 !endif
+@TCL_ZLIB_LIB_NAME@ zdll.lib
+@TCL_TOMMATH_LIB_NAME@ tommath.lib
 <<
 
 
@@ -983,6 +980,7 @@ install-binaries:
 !endif
 	@$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
 	@$(CPY) "$(OUT_DIR)\zlib1.dll" "$(BIN_INSTALL_DIR)\"
+	@$(CPY) "$(OUT_DIR)\zdll.lib" "$(LIB_INSTALL_DIR)\"
 	@$(CPY) "$(OUT_DIR)\libtommath.dll" "$(BIN_INSTALL_DIR)\"
 	@$(CPY) "$(OUT_DIR)\tommath.lib" "$(LIB_INSTALL_DIR)\"
 !if exist($(TCLSH))

win/tcl.m4

@@ -959,8 +959,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	fi
     fi
 
-    # DL_LIBS is empty, but then we match the Unix version
-    AC_SUBST(DL_LIBS)
     AC_SUBST(CFLAGS_DEBUG)
     AC_SUBST(CFLAGS_OPTIMIZE)
     AC_SUBST(CFLAGS_WARNING)

win/tclConfig.sh.in

@@ -41,13 +41,7 @@ TCL_LIB_FILE='@TCL_LIB_FILE@'
 TCL_ZIP_FILE='@TCL_ZIP_FILE@'
 
 # Flag to indicate whether shared libraries need export files.
-TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@
-
-# String that can be evaluated to generate the part of the export file
-# name that comes after the "libxxx" (includes version number, if any,
-# extension, and anything else needed).  May depend on the variables
-# VERSION.  On most UNIX systems this is ${VERSION}.exp.
-TCL_EXPORT_FILE_SUFFIX='@CFG_TCL_EXPORT_FILE_SUFFIX@'
+TCL_NEEDS_EXP_FILE=''
 
 # Additional libraries to use when linking Tcl.
 TCL_LIBS='@LIBS@'
@@ -85,7 +79,7 @@ TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'
 
 # Library file(s) to include in tclsh and other base applications
 # in order to provide facilities needed by DLOBJ above.
-TCL_DL_LIBS='@DL_LIBS@'
+TCL_DL_LIBS=''
 
 # Flags to pass to the compiler when linking object files into
 # an executable tclsh or tcltest binary.
@@ -95,8 +89,8 @@ TCL_LD_FLAGS='@LDFLAGS@'
 # run-time dynamic linker where to look for shared libraries such as
 # libtcl.so.  Used when linking applications.  Only works if there
 # is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
-TCL_CC_SEARCH_FLAGS='@TCL_CC_SEARCH_FLAGS@'
-TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
+TCL_CC_SEARCH_FLAGS=''
+TCL_LD_SEARCH_FLAGS=''
 
 # Additional object files linked with Tcl to provide compatibility
 # with standard facilities from ANSI C or POSIX.
@@ -124,7 +118,7 @@ TCL_INCLUDE_SPEC='@TCL_INCLUDE_SPEC@'
 # ("ok" means it's safe to use switches like -ltcl7.5;  "nodots" means
 # use switches like -ltcl75).  SunOS and FreeBSD require "nodots", for
 # example.
-TCL_LIB_VERSIONS_OK='@TCL_LIB_VERSIONS_OK@'
+TCL_LIB_VERSIONS_OK='nodots'
 
 # String that can be evaluated to generate the part of a shared library
 # name that comes after the "libxxx" (includes version number, if any,
@@ -174,3 +168,9 @@ TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'
 
 # Path to the Tcl stub library in the install directory.
 TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'
+
+# Name of the zlib library that extensions should use
+TCL_ZLIB_LIB_NAME='@TCL_ZLIB_LIB_NAME@'
+
+# Name of the tommath library that extensions should use
+TCL_TOMMATH_LIB_NAME='@TCL_TOMMATH_LIB_NAME@'