merge 8.5

FossilOrigin-Name: 27fd15ce57c5a1f6d10c897e54094ad2dc269297

6 files changed, 116 insertions, 208 deletions

diff --git a/ChangeLog b/ChangeLog
index 9ab0bee..fd8eb18 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2011-05-03  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclUtil.c:	Tighten Tcl_SplitList().
+	* generic/tclListObj.c:	Tighten SetListFromAny().
+	* generic/tclDictObj.c:	Tighten SetDictFromAny().
+	* tests/join.test:
+	* tests/mathop.test:
+
 2011-05-02  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclCmdMZ.c:	Revised TclFindElement() interface.  The
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index b33bb31..de2a969 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -564,15 +564,11 @@ SetDictFromAny(
     Tcl_Interp *interp,
     Tcl_Obj *objPtr)
 {
-    const char *string;
-    char *s;
-    const char *elemStart, *nextElem;
-    int lenRemain, length, elemSize, result, isNew;
-    const char *limit;	/* Points just after string's last byte. */
-    register const char *p;
-    register Tcl_Obj *keyPtr, *valuePtr;
-    Dict *dict;
     Tcl_HashEntry *hPtr;
+    int isNew, result;
+    Dict *dict = ckalloc(sizeof(Dict));
+
+    InitChainTable(dict);
 
     /*
      * Since lists and dictionaries have very closely-related string
@@ -584,29 +580,15 @@ SetDictFromAny(
 	int objc, i;
 	Tcl_Obj **objv;
 
-	if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+	/* Cannot fail, we already know the Tcl_ObjType is "list". */
+	TclListObjGetElements(NULL, objPtr, &objc, &objv);
 	if (objc & 1) {
-	    if (interp != NULL) {
-		Tcl_SetResult(interp, "missing value to go with key",
-			TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto missingValue;
 	}
 
-	/*
-	 * Build the hash of key/value pairs.
-	 */
-
-	dict = ckalloc(sizeof(Dict));
-	InitChainTable(dict);
 	for (i=0 ; i<objc ; i+=2) {
-	    /*
-	     * Store key and value in the hash table we're building.
-	     */
-
+	
+	    /* Store key and value in the hash table we're building. */
 	    hPtr = CreateChainEntry(dict, objv[i], &isNew);
 	    if (!isNew) {
 		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
@@ -624,114 +606,68 @@ SetDictFromAny(
 	    Tcl_SetHashValue(hPtr, objv[i+1]);
 	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
 	}
-
-	/*
-	 * Share type-setting code with the string-conversion case.
-	 */
-
-	goto installHash;
-    }
-
-    /*
-     * Get the string representation. Make it up-to-date if necessary.
-     */
-
-    string = TclGetStringFromObj(objPtr, &length);
-    limit = (string + length);
-
-    /*
-     * Allocate a new HashTable that has objects for keys and objects for
-     * values.
-     */
-
-    dict = ckalloc(sizeof(Dict));
-    InitChainTable(dict);
-    for (p = string, lenRemain = length;
-	    lenRemain > 0;
-	    p = nextElem, lenRemain = (limit - nextElem)) {
-	int literal;
-
-	result = TclFindElement(interp, p, lenRemain,
-		&elemStart, &nextElem, &elemSize, &literal);
-	if (result != TCL_OK) {
-	    if (interp != NULL) {
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+    } else {
+	int length;
+	const char *nextElem = TclGetStringFromObj(objPtr, &length);
+	const char *limit = (nextElem + length);
+
+	while (nextElem < limit) {
+	    Tcl_Obj *keyPtr, *valuePtr;
+	    const char *elemStart;
+	    int elemSize, literal;
+
+	    result = TclFindElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal);
+	    if (result != TCL_OK) {
+		goto errorExit;
 	    }
-	    goto errorExit;
-	}
-	if (elemStart >= limit) {
-	    break;
-	}
-
-	/*
-	 * Allocate a Tcl object for the element and initialize it from the
-	 * "elemSize" bytes starting at "elemStart".
-	 */
-
-	s = ckalloc(elemSize + 1);
-	if (literal) {
-	    memcpy(s, elemStart, (size_t) elemSize);
-	    s[elemSize] = 0;
-	} else {
-	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
-	}
-
-	TclNewObj(keyPtr);
-	keyPtr->bytes = s;
-	keyPtr->length = elemSize;
-
-	p = nextElem;
-	lenRemain = (limit - nextElem);
-	if (lenRemain <= 0) {
-	    goto missingKey;
-	}
-
-	result = TclFindElement(interp, p, lenRemain,
-		&elemStart, &nextElem, &elemSize, &literal);
-	if (result != TCL_OK) {
-	    if (interp != NULL) {
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+	    if (elemStart == limit) {
+		break;
+	    }
+	    if (nextElem == limit) {
+		goto missingValue;
 	    }
-	    TclDecrRefCount(keyPtr);
-	    goto errorExit;
-	}
-	if (elemStart >= limit) {
-	    goto missingKey;
-	}
-
-	/*
-	 * Allocate a Tcl object for the element and initialize it from the
-	 * "elemSize" bytes starting at "elemStart".
-	 */
 
-	s = ckalloc(elemSize + 1);
-	if (literal) {
-	    memcpy(s, elemStart, (size_t) elemSize);
-	    s[elemSize] = 0;
-	} else {
-	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
-	}
+	    if (literal) {
+		TclNewStringObj(keyPtr, elemStart, elemSize);
+	    } else {
+		/* Avoid double copy */
+		TclNewObj(keyPtr);
+		keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
+		keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
+			keyPtr->bytes);
+	    }
 
-	TclNewObj(valuePtr);
-	valuePtr->bytes = s;
-	valuePtr->length = elemSize;
+	    result = TclFindElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal);
+	    if (result != TCL_OK) {
+		TclDecrRefCount(keyPtr);
+		goto errorExit;
+	    }
 
-	/*
-	 * Store key and value in the hash table we're building.
-	 */
+	    if (literal) {
+		TclNewStringObj(valuePtr, elemStart, elemSize);
+	    } else {
+		/* Avoid double copy */
+		TclNewObj(valuePtr);
+		valuePtr->bytes = ckalloc((unsigned) elemSize + 1);
+		valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
+			valuePtr->bytes);
+	    }
 
-	hPtr = CreateChainEntry(dict, keyPtr, &isNew);
-	if (!isNew) {
-	    Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
+	    /* Store key and value in the hash table we're building. */
+	    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
+	    if (!isNew) {
+		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
 
-	    TclDecrRefCount(keyPtr);
-	    TclDecrRefCount(discardedValue);
+		TclDecrRefCount(keyPtr);
+		TclDecrRefCount(discardedValue);
+	    }
+	    Tcl_SetHashValue(hPtr, valuePtr);
+	    Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
 	}
-	Tcl_SetHashValue(hPtr, valuePtr);
-	Tcl_IncrRefCount(valuePtr);	/* Since hash now holds ref to it. */
     }
 
-  installHash:
     /*
      * Free the old internalRep before setting the new one. We do this as late
      * as possible to allow the conversion code, in particular
@@ -746,15 +682,17 @@ SetDictFromAny(
     objPtr->typePtr = &tclDictType;
     return TCL_OK;
 
-  missingKey:
+  missingValue:
     if (interp != NULL) {
 	Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
     }
-    TclDecrRefCount(keyPtr);
     result = TCL_ERROR;
 
   errorExit:
+    if (interp != NULL) {
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+    }
     DeleteChainTable(dict);
     ckfree(dict);
     return result;
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index f330937..c5fafc3 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1714,15 +1714,8 @@ SetListFromAny(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
     Tcl_Obj *objPtr)		/* The object to convert. */
 {
-    const char *string;
-    char *s;
-    const char *elemStart, *nextElem;
-    int lenRemain, length, estCount, elemSize, i, j, result;
-    const char *limit;		/* Points just after string's last byte. */
-    register const char *p;
-    register Tcl_Obj **elemPtrs;
-    register Tcl_Obj *elemPtr;
     List *listRepPtr;
+    Tcl_Obj **elemPtrs;
 
     /*
      * Dictionaries are a special case; they have a string representation such
@@ -1759,99 +1752,69 @@ SetListFromAny(
 
 	elemPtrs = &listRepPtr->elements;
 	Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done);
-	i = 0;
 	while (!done) {
-	    elemPtrs[i++] = keyPtr;
-	    elemPtrs[i++] = valuePtr;
+	    *elemPtrs++ = keyPtr;
+	    *elemPtrs++ = valuePtr;
 	    Tcl_IncrRefCount(keyPtr);
 	    Tcl_IncrRefCount(valuePtr);
 	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
 	}
+    } else {
+	int estCount, length;
+	const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
 
 	/*
-	 * Swap the representations.
+	 * Allocate enough space to hold a (Tcl_Obj *) for each
+	 * (possible) list element.
 	 */
 
-	goto commitRepresentation;
-    }
-
-    /*
-     * Get the string representation. Make it up-to-date if necessary.
-     */
-
-    string = TclGetStringFromObj(objPtr, &length);
-
-    /*
-     * Parse the string into separate string objects, and create a List
-     * structure that points to the element string objects. 
-     *
-     * First, allocate enough space to hold a (Tcl_Obj *) for each
-     * (possible) list element.
-     */
-
-    estCount = TclMaxListLength(string, length, &limit);
-    estCount += (estCount == 0); /* Smallest List struct holds 1 element. */
-    listRepPtr = AttemptNewList(interp, estCount, NULL);
-    if (listRepPtr == NULL) {
-	return TCL_ERROR;
-    }
-    elemPtrs = &listRepPtr->elements;
+	estCount = TclMaxListLength(nextElem, length, &limit);
+	estCount += (estCount == 0); /* Smallest List struct holds 1 element. */
+	listRepPtr = AttemptNewList(interp, estCount, NULL);
+	if (listRepPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	elemPtrs = &listRepPtr->elements;
 
-    /* Each iteration, parse and store a list element */
-    for (p=string, lenRemain=length, i=0;
-	    lenRemain > 0;
-	    p=nextElem, lenRemain=limit-nextElem, i++) {
-	int literal;
+	/* Each iteration, parse and store a list element */
+	while (nextElem < limit) {
+	    const char *elemStart;
+	    int elemSize, literal;
 
-	result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
-		&elemSize, &literal);
-	if (result != TCL_OK) {
-	    for (j = 0;  j < i;  j++) {
-		elemPtr = elemPtrs[j];
-		Tcl_DecrRefCount(elemPtr);
+	    if (TCL_OK != TclFindElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal)) {
+		while (--elemPtrs >= &listRepPtr->elements) {
+		    Tcl_DecrRefCount(*elemPtrs);
+		}
+		ckfree((char *) listRepPtr);
+		return TCL_ERROR;
 	    }
-	    ckfree(listRepPtr);
-	    if (interp != NULL) {
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL);
+	    if (elemStart == limit) {
+		break;
 	    }
-	    return result;
-	}
-	if (elemStart >= limit) {
-	    break;
-	}
-	if (i > estCount) {
-	    Tcl_Panic("SetListFromAny: bad size estimate for list");
-	}
 
-	/*
-	 * Allocate a Tcl object for the element and initialize it from the
-	 * "elemSize" bytes starting at "elemStart".
-	 */
+	    /* TODO: replace panic with error on alloc failure? */
+	    if (literal) {
+		TclNewStringObj(*elemPtrs, elemStart, elemSize);
+	    } else {
+		TclNewObj(*elemPtrs);
+		(*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
+		(*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
+			(*elemPtrs)->bytes);
+	    }
 
-	s = ckalloc(elemSize + 1);
-	if (literal) {
-	    memcpy(s, elemStart, (size_t) elemSize);
-	    s[elemSize] = 0;
-	} else {
-	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
+	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
 	}
 
-	TclNewObj(elemPtr);
-	elemPtr->bytes = s;
-	elemPtr->length = elemSize;
-	elemPtrs[i] = elemPtr;
-	Tcl_IncrRefCount(elemPtr);	/* Since list now holds ref to it. */
+ 	listRepPtr->elemCount = elemPtrs - &listRepPtr->elements;
     }
 
-    listRepPtr->elemCount = i;
-
     /*
      * Free the old internalRep before setting the new one. We do this as late
      * as possible to allow the conversion code, in particular
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
-  commitRepresentation:
     TclFreeIntRep(objPtr);
     ListSetIntRep(objPtr, listRepPtr);
     return TCL_OK;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 7baadff..6189d19 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -179,7 +179,7 @@ TclMaxListLength(
  *	the element is in braces, then *elementPtr will point to the character
  *	after the opening brace and *sizePtr will not include either of the
  *	braces. If there isn't an element in the list, *sizePtr will be zero,
- *	and both *elementPtr and *termPtr will point just after the last
+ *	and both *elementPtr and *nextPtr will point just after the last
  *	character in the list. If literalPtr is non-NULL, *literalPtr is set
  *	to a boolean value indicating whether the substring returned as
  *	the values of **elementPtr and *sizePtr is the literal value of
@@ -550,8 +550,7 @@ Tcl_SplitList(
 	    *p = 0;
 	    p++;
 	} else {
-	    TclCopyAndCollapse(elSize, element, p);
-	    p += elSize+1;
+	    p += 1 + TclCopyAndCollapse(elSize, element, p);
 	}
     }
 
diff --git a/tests/join.test b/tests/join.test
index 5c06936..4abe233 100644
--- a/tests/join.test
+++ b/tests/join.test
@@ -37,7 +37,7 @@ test join-2.2 {join errors} {
 } {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
 test join-2.3 {join errors} {
     list [catch {join "a \{ c" 111} msg] $msg $errorCode
-} {1 {unmatched open brace in list} {TCL VALUE LIST}}
+} {1 {unmatched open brace in list} {TCL VALUE LIST BRACE}}
 
 test join-3.1 {joinString is binary ok} {
   string length [join {a b c} a\0b]
diff --git a/tests/mathop.test b/tests/mathop.test
index db713bf..f122b7b 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -1092,7 +1092,7 @@ test mathop-24.3 { binary ops, bad values } {
     }
     foreach op {in ni} {
         lappend res [TestOp $op 5 "a b \{ c"]
-        lappend exp "unmatched open brace in list TCL VALUE LIST"
+        lappend exp "unmatched open brace in list TCL VALUE LIST BRACE"
     }
     lappend res [TestOp % 5 0]
     lappend exp "divide by zero ARITH DIVZERO {divide by zero}"