diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 192 | ||||
| -rw-r--r-- | generic/tclListObj.c | 115 | ||||
| -rw-r--r-- | generic/tclUtil.c | 5 | ||||
| -rw-r--r-- | tests/join.test | 2 | ||||
| -rw-r--r-- | tests/mathop.test | 2 |
6 files changed, 116 insertions, 208 deletions
@@ -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}" |