diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 197 | ||||
| -rw-r--r-- | tests/stringObj.test | 4 |
3 files changed, 60 insertions, 152 deletions
@@ -1,5 +1,16 @@ 2009-02-17 Don Porter <dgp@users.sourceforge.net> + * generic/tclStringObj.c: Factor out common GrowStringBuffer(). + + * generic/tclStringObj.c: Convert Tcl_AppendStringsToObj into + * tests/stringObj.test: a radically simpler implementation + where we just loop over calls to Tcl_AppendToObj. This fixes [Bug + 2597185]. It also creates a *** POTENTIAL INCOMPATIBILITY *** in + that T_ASTO can now allocate more space than is strictly required, + like all the other Tcl_Append* routines. The incompatibility was + detected by test stringObj-6.5, which I've updated to reflect the + new behavior. + * generic/tclStringObj.c: Revise buffer growth implementation in ExtendStringRepWithUnicode. Use cheap checks to determine that no reallocation is necessary without cost of computing the precise diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 52e6019..ad8ec05 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.110 2009/02/17 06:52:05 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.111 2009/02/17 17:17:32 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -61,6 +61,7 @@ static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, int numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); +static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); @@ -189,6 +190,43 @@ typedef struct String { #ifndef TCL_GROWTH_MIN_ALLOC #define TCL_GROWTH_MIN_ALLOC 1024 #endif + +static void +GrowStringBuffer( + Tcl_Obj *objPtr, + int needed, + int flag) +{ + /* Pre-conditions: + * objPtr->typePtr == &tclStringType + * needed > stringPtr->allocated + * flag || objPtr->bytes != NULL + */ + String *stringPtr = GET_STRING(objPtr); + + if (flag && stringPtr->allocated == 0) { + /* First allocation - just big enough */ + if (objPtr->bytes == tclEmptyStringRep) { + objPtr->bytes = ckalloc((unsigned) needed + 1); + } else { + objPtr->bytes = ckrealloc(objPtr->bytes, (unsigned) needed + 1); + } + stringPtr->allocated = needed; + } else { + /* Subsequent appends - apply the growth algorithm. */ + if (Tcl_AttemptSetObjLength(objPtr, 2 * needed) == 0) { + /* + * Take care computing the amount of modest growth to avoid + * overflow into invalid argument values for Tcl_SetObjLength. + */ + unsigned int limit = INT_MAX - needed; + unsigned int extra = needed - objPtr->length + TCL_GROWTH_MIN_ALLOC; + int growth = (int) ((extra > limit) ? limit : extra); + + Tcl_SetObjLength(objPtr, needed + growth); + } + } +} /* *---------------------------------------------------------------------- @@ -1489,14 +1527,6 @@ AppendUtfToUtfRep( stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { /* - * There isn't currently enough space in the string representation so - * allocate additional space. First, try to double the length - * required. If that fails, try a more modest allocation. See the "TCL - * STRING GROWTH ALGORITHM" comment at the top of this file for an - * explanation of this growth algorithm. - */ - - /* * Protect against case where unicode points into the existing * stringPtr->unicode array. Force it to follow any relocations * due to the reallocs below. @@ -1507,17 +1537,9 @@ AppendUtfToUtfRep( offset = bytes - objPtr->bytes; } - if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) { - /* - * Take care computing the amount of modest growth to avoid - * overflow into invalid argument values for Tcl_SetObjLength. - */ - unsigned int limit = INT_MAX - newLength; - unsigned int extra = numBytes + TCL_GROWTH_MIN_ALLOC; - int growth = (int) ((extra > limit) ? limit : extra); - - Tcl_SetObjLength(objPtr, newLength + growth); - } + /* TODO: consider passing flag=1: no overalloc on first append. + * This would make test stringObj-8.1 fail.*/ + GrowStringBuffer(objPtr, newLength, 0); /* Relocate bytes if needed; see above. */ if (offset >= 0) { @@ -1536,6 +1558,7 @@ AppendUtfToUtfRep( objPtr->bytes[newLength] = 0; objPtr->length = newLength; } + /* *---------------------------------------------------------------------- @@ -1560,125 +1583,17 @@ Tcl_AppendStringsToObjVA( Tcl_Obj *objPtr, /* Points to the object to append to. */ va_list argList) /* Variable argument list. */ { -#define STATIC_LIST_SIZE 16 - String *stringPtr; - int newLength, oldLength, attemptLength; - char *string, *dst; - char *static_list[STATIC_LIST_SIZE]; - char **args = static_list; - int nargs_space = STATIC_LIST_SIZE; - int nargs, i; - if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); } - SetStringFromAny(NULL, objPtr); - - /* - * Figure out how much space is needed for all the strings, and expand the - * string representation if it isn't big enough. If no bytes would be - * appended, just return. Note that on some platforms (notably OS/390) the - * argList is an array so we need to use memcpy. - */ - - nargs = 0; - newLength = 0; - oldLength = objPtr->length; while (1) { - string = va_arg(argList, char *); - if (string == NULL) { + const char *bytes = va_arg(argList, char *); + if (bytes == NULL) { break; } - if (nargs >= nargs_space) { - /* - * Expand the args buffer. - */ - - nargs_space += STATIC_LIST_SIZE; - if (args == static_list) { - args = (void *) ckalloc(nargs_space * sizeof(char *)); - for (i = 0; i < nargs; ++i) { - args[i] = static_list[i]; - } - } else { - args = (void *) ckrealloc((void *) args, - nargs_space * sizeof(char *)); - } - } - newLength += strlen(string); - args[nargs++] = string; - } - if (newLength == 0) { - goto done; - } - - stringPtr = GET_STRING(objPtr); - /* TODO: pure unicode will crash! */ - if (oldLength + newLength > stringPtr->allocated) { - /* - * There isn't currently enough space in the string representation, so - * allocate additional space. If the current string representation - * isn't empty (i.e. it looks like we're doing a series of appends) - * then try to allocate extra space to accomodate future growth: first - * try to double the required memory; if that fails, try a more modest - * allocation. See the "TCL STRING GROWTH ALGORITHM" comment at the - * top of this file for an explanation of this growth algorithm. - * Otherwise, if the current string representation is empty, exactly - * enough memory is allocated. - */ - - if (oldLength == 0) { - Tcl_SetObjLength(objPtr, newLength); - } else { - attemptLength = 2 * (oldLength + newLength); - if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) { - attemptLength = oldLength + (2 * newLength) + - TCL_GROWTH_MIN_ALLOC; - Tcl_SetObjLength(objPtr, attemptLength); - } - } + Tcl_AppendToObj(objPtr, bytes, -1); } - - /* - * Make a second pass through the arguments, appending all the strings to - * the object. - */ - - dst = objPtr->bytes + oldLength; - for (i = 0; i < nargs; ++i) { - string = args[i]; - if (string == NULL) { - break; - } - while (*string != 0) { - *dst = *string; - dst++; - string++; - } - } - - /* - * Add a null byte to terminate the string. However, be careful: it's - * possible that the object is totally empty (if it was empty originally - * and there was nothing to append). In this case dst is NULL; just leave - * everything alone. - */ - - if (dst != NULL) { - *dst = 0; - } - objPtr->length = oldLength + newLength; - - done: - /* - * If we had to allocate a buffer from the heap, free it now. - */ - - if (args != static_list) { - ckfree((char *) args); - } -#undef STATIC_LIST_SIZE } /* @@ -2935,25 +2850,7 @@ ExtendStringRepWithUnicode( /* Grow space if needed */ if (size > stringPtr->allocated) { - if (stringPtr->allocated == 0) { - /* First allocation - just big enough */ - objPtr->bytes = ckrealloc(objPtr->bytes, (unsigned) size+1); - stringPtr->allocated = size; - } else { - /* Subsequent appends - apply the growth algorithm. */ - if (Tcl_AttemptSetObjLength(objPtr, 2 * size) == 0) { - /* - * Take care computing the amount of modest growth to avoid - * overflow into invalid argument values for Tcl_SetObjLength. - */ - unsigned int limit = INT_MAX - size; - unsigned int extra = size - objPtr->length - + TCL_GROWTH_MIN_ALLOC; - int growth = (int) ((extra > limit) ? limit : extra); - - Tcl_SetObjLength(objPtr, size + growth); - } - } + GrowStringBuffer(objPtr, size, 1); } copyBytes: diff --git a/tests/stringObj.test b/tests/stringObj.test index 6b8e739..057d8e8 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringObj.test,v 1.20 2009/02/16 04:33:10 dgp Exp $ +# RCS: @(#) $Id: stringObj.test,v 1.21 2009/02/17 17:17:32 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -136,7 +136,7 @@ test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if init testobj newobj 1 teststringobj appendstrings 1 123 abcdefg list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1] -} {10 10 123abcdefg} +} {10 20 123abcdefg} test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj { testobj freeallvars teststringobj set 1 abc |