From 952b64858571bcdda08403a25f573f8db387f6e8 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Fri, 20 Apr 2007 21:39:41 +0000 Subject: * generic/tclListObj.c (SetListFromAny): avoid discarding internal reps of objects converted to singleton lists [Patch 738900] --- ChangeLog | 9 +-- generic/tclListObj.c | 162 +++++++++++++++++++++++++++++++++------------------ 2 files changed, 111 insertions(+), 60 deletions(-) diff --git a/ChangeLog b/ChangeLog index bce368f..33fd297 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2007-04-20 Miguel Sofer + + * generic/tclListObj.c (SetListFromAny): avoid discarding internal + reps of objects converted to singleton lists [Patch 738900] + 2007-04-20 Kevin B. Kenny * doc/clock.n: Corrected a silly error (transposed 'uppercase' @@ -70,14 +75,10 @@ testsuite did not pick this mistake. Rewrote to make the intention clear. -2007-04-18 Miguel Sofer - * generic/tclInt.h (TclDecrRefCount): change the order of the branches, use empty 'if ; else' to handle use in unbraced outer if/else conditions (as already done in tcl.h) -2007-04-18 Miguel Sofer - * generic/tclExecute.c: slight changes in Tcl_Obj management. 2007-04-17 Kevin B. Kenny diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 7278384..5e679ff 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclListObj.c,v 1.43 2007/03/20 19:47:48 kennykb Exp $ + * RCS: @(#) $Id: tclListObj.c,v 1.44 2007/04/20 21:39:42 msofer Exp $ */ #include "tclInt.h" @@ -1628,34 +1628,65 @@ SetListFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { - char *string, *s; + char *string = NULL, *s; const char *elemStart, *nextElem; int lenRemain, length, estCount, elemSize, hasBrace, i, j, result; - const char *limit; /* Points just after string's last byte. */ + const char *limit = NULL; /* Points just after string's last byte. */ register const char *p; register Tcl_Obj **elemPtrs; register Tcl_Obj *elemPtr; List *listRepPtr; + Tcl_ObjType *typePtr = objPtr->typePtr; + int avoidParse; - /* - * Get the string representation. Make it up-to-date if necessary. - */ - - string = Tcl_GetStringFromObj(objPtr, &length); + estCount = 1; + avoidParse = 1; + i = 1; + if (objPtr->bytes && (objPtr->length == 0)) { + i = 0; + } else if ((typePtr != &tclIntType) +#ifndef NO_WIDE_TYPE + && (typePtr != &tclWideIntType) +#endif + && (typePtr != &tclDoubleType) + && (typePtr != &tclBignumType)) { + + /* + * Get the string representation. Make it up-to-date if necessary. + */ - /* - * Parse the string into separate string objects, and create a List - * structure that points to the element string objects. We use a modified - * version of Tcl_SplitList's implementation to avoid one malloc and a - * string copy for each list element. First, estimate the number of - * elements by counting the number of space characters in the list. - */ + string = Tcl_GetStringFromObj(objPtr, &length); + + /* + * Get an overestimate of the number of elements by counting + * whitespaces; force a thorough parsing of the list if the string + * contains whitespaces or backslashes. + */ + + limit = string + length; + for (p = string; p < limit; p++) { + if (isspace(UCHAR(*p))) { /* INTL: ISO space. */ + estCount++; + avoidParse = 0; + } + if (*p == '\\') { + avoidParse = 0; + } + } - limit = string + length; - estCount = 1; - for (p = string; p < limit; p++) { - if (isspace(UCHAR(*p))) { /* INTL: ISO space. */ - estCount++; + if (avoidParse) { + /* + * It is a single element without braces or spaces: check + * that is a valid one-element list, and force full parsing if it + * contains braces. + */ + + result = TclFindElement(interp, string, length, &elemStart, + &nextElem, &elemSize, &hasBrace); + if (result != TCL_OK) { + return result; + } + avoidParse = !hasBrace; } } @@ -1674,54 +1705,73 @@ SetListFromAny( } elemPtrs = &listRepPtr->elements; - for (p=string, lenRemain=length, i=0; - lenRemain > 0; - p=nextElem, lenRemain=limit-nextElem, i++) { - result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem, - &elemSize, &hasBrace); - if (result != TCL_OK) { - for (j = 0; j < i; j++) { - elemPtr = elemPtrs[j]; - Tcl_DecrRefCount(elemPtr); - } - ckfree((char *) listRepPtr); - return result; - } - if (elemStart >= limit) { - break; - } - if (i > estCount) { - Tcl_Panic("SetListFromAny: bad size estimate for list"); - } + if (avoidParse) { + if (i) { + /* + * Single element list containing a duplicate of objPtr. + */ + + elemPtr = Tcl_DuplicateObj(objPtr); + elemPtrs[0] = elemPtr; + Tcl_IncrRefCount(elemPtr); + } + } else { /* - * Allocate a Tcl object for the element and initialize it from the - * "elemSize" bytes starting at "elemStart". + * Parse the string into separate string objects, create a string + * object for each element, and insert it into the List structure. We + * use a modified version of Tcl_SplitList's implementation to avoid + * one malloc and a string copy for each list element. */ - s = ckalloc((unsigned) elemSize + 1); - if (hasBrace) { - memcpy(s, elemStart, (size_t) elemSize); - s[elemSize] = 0; - } else { - elemSize = TclCopyAndCollapse(elemSize, elemStart, s); - } + for (p=string, lenRemain=length, i=0; + lenRemain > 0; + p=nextElem, lenRemain=limit-nextElem, i++) { + result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem, + &elemSize, &hasBrace); + if (result != TCL_OK) { + for (j = 0; j < i; j++) { + elemPtr = elemPtrs[j]; + Tcl_DecrRefCount(elemPtr); + } + ckfree((char *) listRepPtr); + return result; + } + if (elemStart >= limit) { + break; + } + if (i > estCount) { + Tcl_Panic("SetListFromAny: bad size estimate for list"); + } - TclNewObj(elemPtr); - elemPtr->bytes = s; - elemPtr->length = elemSize; - elemPtrs[i] = elemPtr; - Tcl_IncrRefCount(elemPtr); /* Since list now holds ref to it. */ - } + /* + * Allocate a Tcl object for the element and initialize it from + * the "elemSize" bytes starting at "elemStart". + */ - listRepPtr->elemCount = i; + s = ckalloc((unsigned) elemSize + 1); + if (hasBrace) { + memcpy(s, elemStart, (size_t) elemSize); + s[elemSize] = 0; + } else { + elemSize = TclCopyAndCollapse(elemSize, elemStart, s); + } + + TclNewObj(elemPtr); + elemPtr->bytes = s; + elemPtr->length = elemSize; + elemPtrs[i] = elemPtr; + Tcl_IncrRefCount(elemPtr); /* Since list now holds ref to it. */ + } + } /* * 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. + * Tcl_GetStringFromObj, to use that old internalRep. */ + listRepPtr->elemCount = i; listRepPtr->refCount++; TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; -- cgit v0.12