merge 8.7

7 files changed, 92 insertions, 95 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 57a95f8..ffead99 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -269,8 +269,6 @@ extern "C" {
 #ifndef CONST
 #   define CONST const
 #endif
-#define CONST84 const
-#define CONST84_RETURN const
 
 #endif /* !TCL_NO_DEPRECATED */
 
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 10444ac..3d9327d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2526,7 +2526,6 @@ Tcl_LrangeObjCmd(
     register Tcl_Obj *const objv[])
 				/* Argument objects. */
 {
-    Tcl_Obj **elemPtrs;
     int listLen, first, last, result;
 
     if (objc != 4) {
@@ -2544,55 +2543,14 @@ Tcl_LrangeObjCmd(
     if (result != TCL_OK) {
 	return result;
     }
-    if (first < 0) {
-	first = 0;
-    }
 
     result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
 	    &last);
     if (result != TCL_OK) {
 	return result;
     }
-    if (last >= listLen) {
-	last = listLen - 1;
-    }
-
-    if (first > last) {
-	/*
-	 * Returning an empty list is easy.
-	 */
-
-	return TCL_OK;
-    }
-
-    result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    if (Tcl_IsShared(objv[1]) ||
-	    ((ListRepPtr(objv[1])->refCount > 1))) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
-		&elemPtrs[first]));
-    } else {
-	/*
-	 * In-place is possible.
-	 */
-
-	if (last < (listLen - 1)) {
-	    Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,
-		    0, NULL);
-	}
-
-	/*
-	 * This one is not conditioned on (first > 0) in order to preserve the
-	 * string-canonizing effect of [lrange 0 end].
-	 */
-
-	Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL);
-	Tcl_SetObjResult(interp, objv[1]);
-    }
 
+    Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
     return TCL_OK;
 }
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1d35932..6c52fdb 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4948,11 +4948,11 @@ TEBCresume(
 		TclGetInt4AtPtr(pc+5)));
 
 	/*
-	 * Get the contents of the list, making sure that it really is a list
+	 * Get the length of the list, making sure that it really is a list
 	 * in the process.
 	 */
 
-	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+	if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) {
 	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
@@ -4986,7 +4986,10 @@ TEBCresume(
 	}
 
 	if ((toIdx == TCL_INDEX_BEFORE) || (fromIdx == TCL_INDEX_AFTER)) {
-	    goto emptyList;
+	emptyList:
+	    objResultPtr = Tcl_NewObj();
+	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
+	    NEXT_INST_F(9, 1, 1);
 	}
 	toIdx = TclIndexDecode(toIdx, objc - 1);
 	if (toIdx < 0) {
@@ -5006,28 +5009,8 @@ TEBCresume(
 	}
 
 	fromIdx = TclIndexDecode(fromIdx, objc - 1);
-	if (fromIdx < 0) {
-	    fromIdx = 0;
-	}
 
-	if (fromIdx <= toIdx) {
-	    /* Construct the subsquence list */
-	    /* unshared optimization */
-	    if (Tcl_IsShared(valuePtr)) {
-		objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
-	    } else {
-		if (toIdx != objc - 1) {
-		    Tcl_ListObjReplace(NULL, valuePtr, toIdx + 1, LIST_MAX,
-			    0, NULL);
-		}
-		Tcl_ListObjReplace(NULL, valuePtr, 0, fromIdx, 0, NULL);
-		TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
-		NEXT_INST_F(9, 0, 0);
-	    }
-	} else {
-	emptyList:
-	    TclNewObj(objResultPtr);
-	}
+	objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
 
 	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
 	NEXT_INST_F(9, 1, 1);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a7e4f0a..468758e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3067,6 +3067,8 @@ MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
 MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, int line, int n,
 			    int *lines, Tcl_Obj *const *elems);
 MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
+MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, int fromIdx,
+			    int toIdx);
 MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
 MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index a312f4c..2078989 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -446,6 +446,87 @@ TclListObjCopy(
 /*
  *----------------------------------------------------------------------
  *
+ * TclListObjRange --
+ *
+ *	Makes a slice of a list value.
+ *      *listPtr must be known to be a valid list.
+ *
+ * Results:
+ *	Returns a pointer to the sliced list.
+ *      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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclListObjRange(
+    Tcl_Obj *listPtr,		/* List object to take a range from. */
+    int fromIdx,		/* Index of first element to include. */
+    int toIdx)			/* Index of last element to include. */
+{
+    Tcl_Obj **elemPtrs;
+    int listLen, i, newLen;
+    List *listRepPtr;
+
+    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
+
+    if (fromIdx < 0) {
+	fromIdx = 0;
+    }
+    if (toIdx >= listLen) {
+	toIdx = listLen-1;
+    }
+    if (fromIdx > toIdx) {
+	return Tcl_NewObj();
+    }
+
+    newLen = toIdx - fromIdx + 1;
+
+    if (Tcl_IsShared(listPtr) ||
+	    ((ListRepPtr(listPtr)->refCount > 1))) {
+	return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]);
+    }
+
+    /*
+     * In-place is possible.
+     */
+
+    /*
+     * Even if nothing below cause any changes, we still want the
+     * string-canonizing effect of [lrange 0 end].
+     */
+
+    TclInvalidateStringRep(listPtr);
+
+    /*
+     * Delete elements that should not be included.
+     */
+
+    for (i = 0; i < fromIdx; i++) {
+	TclDecrRefCount(elemPtrs[i]);
+    }
+    for (i = toIdx + 1; i < listLen; i++) {
+	TclDecrRefCount(elemPtrs[i]);
+    }
+
+    if (fromIdx > 0) {
+	memmove(elemPtrs, &elemPtrs[fromIdx],
+		(size_t) newLen * sizeof(Tcl_Obj*));
+    }
+
+    listRepPtr = ListRepPtr(listPtr);
+    listRepPtr->elemCount = newLen;
+
+    return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ListObjGetElements --
  *
  *	This function returns an (objc,objv) array of the elements in a list
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 78569de..816252d 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -3637,6 +3637,7 @@ TclStringReplace(
 	    }
 	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
 								/* PANIC? */
+	    Tcl_SetByteArrayLength(result, 0);
 	    TclAppendBytesToByteArray(result, bytes, first);	
 	    TclAppendBytesToByteArray(result, iBytes, newBytes);
 	    TclAppendBytesToByteArray(result, bytes + first + count,
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 0cc500d..9bf3b64 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -265,28 +265,6 @@ Tcl_WinTCharToUtf(
  * signature. Tcl 9 must find a better solution, but that cannot be done
  * without introducing a binary incompatibility.
  */
-#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
-static Tcl_Obj *dbNewLongObj(
-    int intValue,
-    const char *file,
-    int line
-) {
-#ifdef TCL_MEM_DEBUG
-    register Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    objPtr->bytes = NULL;
-
-    objPtr->internalRep.wideValue = (long) intValue;
-    objPtr->typePtr = &tclIntType;
-    return objPtr;
-#else
-    return Tcl_NewIntObj(intValue);
-#endif
-}
-#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
-#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
-#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
 static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
     long longValue;
     int result = Tcl_ExprLong(interp, expr, &longValue);
@@ -335,10 +313,6 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
    return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
 }
 #define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
-static int formatInt(char *buffer, int n){
-   return TclFormatInt(buffer, (long)n);
-}
-#define TclFormatInt (int(*)(char *, long))formatInt
 
 #endif /* TCL_WIDE_INT_IS_LONG */