Merge trunk

12 files changed, 91 insertions, 48 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index dbc74bd..7beb60a 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2326,6 +2326,7 @@ Tcl_LassignObjCmd(
     Tcl_Obj *listCopyPtr;
     Tcl_Obj **listObjv;		/* The contents of the list. */
     Tcl_Size listObjc;		/* The length of the list. */
+    Tcl_Size origListObjc;	/* Original length */
     int code = TCL_OK;
 
     if (objc < 2) {
@@ -2337,8 +2338,10 @@ Tcl_LassignObjCmd(
     if (listCopyPtr == NULL) {
 	return TCL_ERROR;
     }
+    Tcl_IncrRefCount(listCopyPtr); /* Important! fs */
 
     TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv);
+    origListObjc = listObjc;
 
     objc -= 2;
     objv += 2;
@@ -2366,7 +2369,13 @@ Tcl_LassignObjCmd(
     }
 
     if (code == TCL_OK && listObjc > 0) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));
+	Tcl_Obj *resultObjPtr = TclListObjRange(
+	    interp, listCopyPtr, origListObjc - listObjc, origListObjc - 1);
+	if (resultObjPtr == NULL) {
+	    code = TCL_ERROR;
+	} else {
+	    Tcl_SetObjResult(interp, resultObjPtr);
+	}
     }
 
     Tcl_DecrRefCount(listCopyPtr);
@@ -2759,7 +2768,11 @@ Tcl_LrangeObjCmd(
 	    return TCL_ERROR;
 	}
     } else {
-	Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
+	Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last);
+	if (resultObj == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resultObj);
     }
     return TCL_OK;
 }
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 89ff26c..9ad7b15 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4293,4 +4293,10 @@ extern const TclStubs *tclStubsPtr;
 #   define Tcl_GetMaster Tcl_GetParent
 #endif
 
+/* TIP #660 for 8.7 */
+#if TCL_MAJOR_VERSION < 9
+#   undef Tcl_GetSizeIntFromObj
+#   define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj
+#endif
+
 #endif /* _TCLDECLS */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index fca4ea5..2b8e8c0 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2786,9 +2786,9 @@ Utf32ToUtfProc(
 	int prev = ch;
 #endif
 	if (flags & TCL_ENCODING_LE) {
-	    ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
+	    ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
 	} else {
-	    ch = (src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
+	    ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
 	}
 #if TCL_UTF_MAX < 4
 	if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a69d29c..31a8695 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4945,12 +4945,12 @@ TEBCresume(
 
 	if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
 	    objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
-	    if (objResultPtr == NULL) {
-		TRACE_ERROR(interp);
-		goto gotError;
-	    }
 	} else {
-	    objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
+	    objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
+	}
+	if (objResultPtr == NULL) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
 	}
 
 	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index cec6ad3..4ab746c 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1734,6 +1734,11 @@ Tcl_FSEvalFileEx(
 	Tcl_CloseEx(interp,chan,0);
 	return result;
     }
+    if (Tcl_SetChannelOption(interp, chan, "-profile", "strict")
+	    != TCL_OK) {
+	Tcl_CloseEx(interp,chan,0);
+	return result;
+    }
 
     TclNewObj(objPtr);
     Tcl_IncrRefCount(objPtr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index aa7313a..cf8b3ce 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3241,8 +3241,8 @@ MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
 MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
 			    Tcl_Obj *toObj, Tcl_Size elemCount,
 			    Tcl_Obj *const elemObjv[]);
-MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, Tcl_Size fromIdx,
-			    Tcl_Size toIdx);
+MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    Tcl_Size fromIdx, Tcl_Size 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 747eea0..39d2c11 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1601,6 +1601,7 @@ ListRepRange(
 
 Tcl_Obj *
 TclListObjRange(
+    Tcl_Interp *interp,		/* May be NULL. Used for error messages */
     Tcl_Obj *listObj,		/* List object to take a range from. */
     Tcl_Size rangeStart,	/* Index of first element to include. */
     Tcl_Size rangeEnd)		/* Index of last element to include. */
@@ -1609,7 +1610,7 @@ TclListObjRange(
     ListRep resultRep;
 
     int isShared;
-    if (TclListObjGetRep(NULL, listObj, &listRep) != TCL_OK)
+    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
 	return NULL;
 
     isShared = Tcl_IsShared(listObj);
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 2bbc4bc..1507a99 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -551,9 +551,8 @@ TclCheckEmptyString(
 
 int
 Tcl_GetUniChar(
-    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
-				 * from. */
-    Tcl_Size index)		/* Get the index'th Unicode character. */
+    Tcl_Obj *objPtr,	/* The object to get the Unicode character from. */
+    Tcl_Size index)	/* The index of the Unicode character to retrieve. */
 {
     String *stringPtr;
     int ch;
@@ -563,8 +562,8 @@ Tcl_GetUniChar(
     }
 
     /*
-     * Optimize the case where we're really dealing with a ByteArray object
-     * we don't need to convert to a string to perform the indexing operation.
+     * For a ByteArray object there is no need to convert to a string to
+     * perform the indexing operation.
      */
 
     if (TclIsPureByteArray(objPtr)) {
@@ -578,7 +577,7 @@ Tcl_GetUniChar(
     }
 
     /*
-     * OK, need to work with the object as a string.
+     * Must work with the object as a string.
      */
 
     SetStringFromAny(NULL, objPtr);
@@ -624,9 +623,8 @@ Tcl_GetUniChar(
 
 int
 TclGetUniChar(
-    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
-				 * from. */
-    Tcl_Size index)		/* Get the index'th Unicode character. */
+    Tcl_Obj *objPtr,	/* The object to get the Unicode character from. */
+    Tcl_Size index)	/* The index of the Unicode character to retrieve. */
 {
     int ch = 0;
 
@@ -1405,52 +1403,58 @@ Tcl_AppendUnicodeToObj(
  *----------------------------------------------------------------------
  *
  * Tcl_AppendObjToObj --
- *
- *	This function appends the string rep of one object to another.
- *	"objPtr" cannot be a shared object.
+ *	Appends the value of appendObjPtr to objPtr, which must not be shared.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The string rep of appendObjPtr is appended to the string
- *	representation of objPtr.
- *	IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr.
- *	Callers are counting on that.
+ *	IMPORTANT: Does not and MUST NOT shimmer appendObjPtr.
  *
  *----------------------------------------------------------------------
  */
 
 void
 Tcl_AppendObjToObj(
-    Tcl_Obj *objPtr,		/* Points to the object to append to. */
-    Tcl_Obj *appendObjPtr)	/* Object to append. */
+    Tcl_Obj *objPtr,		/* Points to the value to append to. */
+    Tcl_Obj *appendObjPtr)	/* The value to append. */
 {
     String *stringPtr;
     Tcl_Size length = 0, numChars;
     Tcl_Size appendNumChars = TCL_INDEX_NONE;
     const char *bytes;
 
-    /*
-     * Special case: second object is standard-empty is fast case. We know
-     * that appending nothing to anything leaves that starting anything...
-     */
+    if (appendObjPtr->bytes == &tclEmptyString
+	|| ((
+	    TclIsPureByteArray(appendObjPtr)
+	    && Tcl_GetCharLength(appendObjPtr) == 0)
+	)
+    ) {
+	return;
+    }
 
-    if (appendObjPtr->bytes == &tclEmptyString) {
+    if (objPtr->bytes == &tclEmptyString
+	|| (
+	    TclIsPureByteArray(objPtr)
+	    && Tcl_GetCharLength(objPtr) == 0
+	)
+    ) {
+	TclSetDuplicateObj(objPtr, appendObjPtr);
 	return;
     }
 
-    /*
-     * Handle append of one ByteArray object to another as a special case.
-     * Note that we only do this when the objects are pure so that the
-     * bytearray faithfully represent the true value; Otherwise appending the
-     * byte arrays together could lose information;
-     */
+    if (
+	TclIsPureByteArray(appendObjPtr)
+	&& (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
+    ) {
+	/*
+	 * Both bytearray objects are pure.  Therefore they faithfully
+	 * represent the true values, making it safe to append the second
+	 * bytearray to the first.
+	 */
 
-    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
-	    && TclIsPureByteArray(appendObjPtr)) {
 	/*
-	 * You might expect the code here to be
+	 * One might expect the code here to be
 	 *
 	 *  bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
 	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index 40a4e9d..26db082 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -24,6 +24,14 @@
 #   define MP_VAL        -3  /* invalid input */
 #   define MP_ITER       -4  /* maximum iterations reached */
 #   define MP_BUF        -5  /* buffer overflow, supplied buffer too small */
+    typedef int mp_order;
+#   define MP_LSB_FIRST -1
+#   define MP_MSB_FIRST  1
+    typedef int mp_endian;
+#   define MP_LITTLE_ENDIAN  -1
+#   define MP_NATIVE_ENDIAN  0
+#   define MP_BIG_ENDIAN     1
+#   define MP_DEPRECATED_PRAGMA(s) /* nothing */
 #   define MP_WUR            /* nothing */
 #   define mp_iszero(a) ((a)->used == 0)
 #   define mp_isneg(a)  ((a)->sign != 0)
diff --git a/tests/bigdata.test b/tests/bigdata.test
index ced2510..c580fbd 100644
--- a/tests/bigdata.test
+++ b/tests/bigdata.test
@@ -752,17 +752,17 @@ bigtest lappend-bigdata-1 "lappend" {4294967300 4294967300 {1 2 3 4 5 a b c d}}
 
 #
 # lassign
-bigtestRO lassign-bigdata-1 "lassign" {0 1 2 3 4 5 6 7 8 9 1} -body {
+bigtestRO lassign-bigdata-1 "lassign" {0 1 2 3 4 5 6 7 8 {9 0 1 2 3 4 5 6 7 8} {6 7 8 9 0 1 2 3 4 5}} -body {
     # Unset explicitly before setting to save memory as bigtestRO runs the
     # script below twice.
     unset -nocomplain l2
-    set l2 [lassign $l a b c d e f g h i j]
-    list $a $b $c $d $e $f $g $h $i $j [testlutil equal $l2 [bigList 0x100000000]]
+    set l2 [lassign $l a b c d e f g h i]
+    list $a $b $c $d $e $f $g $h $i [lrange $l2 0 9] [lrange $l2 end-9 end]
 } -setup {
     set l [bigList 0x10000000a]
 } -cleanup {
     bigClean
-} -constraints bug-d90fee06d0
+}
 
 #
 # ledit
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 5a68925..b24b10c 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -168,6 +168,9 @@ test cmdIL-1.41 {lsort -stride and -index} -body {
 test cmdIL-1.42 {lsort -stride and-index} -body {
     lsort -stride 2 -index -1-1 {a 2 b 1}
 } -returnCodes error -result {index "-1-1" out of range}
+test cmdIL-1.43 {lsort -stride errors} -returnCodes error -body {
+    lsort -stride 4294967296 bar
+} -result {list size must be a multiple of the stride length}
 
 # Can't think of any good tests for the MergeSort and MergeLists procedures,
 # except a bunch of random lists to sort.
diff --git a/tests/lsearch.test b/tests/lsearch.test
index 7c1402d..b8a8aa7 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -688,6 +688,9 @@ test lsearch-28.8 {lsearch -sorted with -stride} -body {
 test lsearch-28.9 {lsearch -sorted with -stride} -body {
     lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9
 } -result 9
+test lsearch-28.10 {lsearch -sorted with -stride} -body {
+    lsearch -sorted -stride 4294967296 -index 1 -subindices -inline {3 5 8 7 2 9} 9
+} -returnCodes 1 -result {list size must be a multiple of the stride length}
 
 
 # cleanup