summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2011-05-03 19:44:49 (GMT)
committerdgp <dgp@users.sourceforge.net>2011-05-03 19:44:49 (GMT)
commit19116759e64449669cf7b7e9e6fdebdae5f0071f (patch)
treec8649bb795101ff5e75096911bc52b26fda97fc5
parent3c27ceb6976c6e0b3aecf4280b26e980813baca4 (diff)
parentaed8684173b0fe3f9627c9ff7343d176dfd1afa7 (diff)
downloadtcl-19116759e64449669cf7b7e9e6fdebdae5f0071f.zip
tcl-19116759e64449669cf7b7e9e6fdebdae5f0071f.tar.gz
tcl-19116759e64449669cf7b7e9e6fdebdae5f0071f.tar.bz2
merge 8.5
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclDictObj.c192
-rw-r--r--generic/tclListObj.c115
-rw-r--r--generic/tclUtil.c5
-rw-r--r--tests/join.test2
-rw-r--r--tests/mathop.test2
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}"