Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | * 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. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk | potential incompatibility |
Files: | files | file ages | folders |
SHA1: |
820ba0e29a10df3d23fcd8e05771b3da |
User & Date: | dgp 2009-02-17 17:17:32.000 |
Context
2009-02-17
| ||
18:10 |
* win/tcl.m4, win/configure: Check if cl groks _WIN64 already to avoid CC manipulation that can sc...check-in: e587ee7ca9 user: hobbs tags: trunk | |
17:17 |
* generic/tclStringObj.c: Factor out common GrowStringBuffer(). * generic/tcl...check-in: 820ba0e29a user: dgp tags: trunk, potential incompatibility | |
06:52 |
* generic/tclStringObj.c: Revise buffer growth implementation in ExtendStringR...check-in: e188de7032 user: dgp tags: trunk | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 8 | 2009-02-17 Don Porter <[email protected]> * 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 number of bytes needed. Also make use of the string growth algortihm in the case of repeated appends. | > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | 2009-02-17 Don Porter <[email protected]> * 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 number of bytes needed. Also make use of the string growth algortihm in the case of repeated appends. |
︙ | ︙ |
Changes to generic/tclStringObj.c.
︙ | ︙ | |||
29 30 31 32 33 34 35 | * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * * 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.111 2009/02/17 17:17:32 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" /* * Prototypes for functions defined later in this file: */ |
︙ | ︙ | |||
57 58 59 60 61 62 63 64 65 66 67 68 69 70 | static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, const char *bytes, int numBytes, int numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); static int UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); /* | > | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, const char *bytes, int numBytes, 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); static int UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); /* |
︙ | ︙ | |||
185 186 187 188 189 190 191 192 193 194 195 196 197 198 | * the double allocation has failed. Default is * 1024 (1 kilobyte). */ #ifndef TCL_GROWTH_MIN_ALLOC #define TCL_GROWTH_MIN_ALLOC 1024 #endif /* *---------------------------------------------------------------------- * * Tcl_NewStringObj -- * * This function is normally called when not debugging: i.e., when | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 | * the double allocation has failed. Default is * 1024 (1 kilobyte). */ #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); } } } /* *---------------------------------------------------------------------- * * Tcl_NewStringObj -- * * This function is normally called when not debugging: i.e., when |
︙ | ︙ | |||
1484 1485 1486 1487 1488 1489 1490 | if (numBytes > INT_MAX - oldLength) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } newLength = numBytes + oldLength; stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { | < < < < < < < < | < < < < < < < | | < > | 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 | if (numBytes > INT_MAX - oldLength) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } newLength = numBytes + oldLength; stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { /* * Protect against case where unicode points into the existing * stringPtr->unicode array. Force it to follow any relocations * due to the reallocs below. */ int offset = -1; if (bytes >= objPtr->bytes && bytes <= objPtr->bytes + objPtr->length) { offset = bytes - objPtr->bytes; } /* 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) { bytes = objPtr->bytes + offset; } } /* * Invalidate the unicode data. */ stringPtr->numChars = -1; stringPtr->hasUnicode = 0; memcpy(objPtr->bytes + oldLength, bytes, numBytes); objPtr->bytes[newLength] = 0; objPtr->length = newLength; } /* *---------------------------------------------------------------------- * * Tcl_AppendStringsToObjVA -- * * This function appends one or more null-terminated strings to an |
︙ | ︙ | |||
1556 1557 1558 1559 1560 1561 1562 | */ void Tcl_AppendStringsToObjVA( Tcl_Obj *objPtr, /* Points to the object to append to. */ va_list argList) /* Variable argument list. */ { | < < < < < < < < < < < < < < < < < < < < < | | < < < < | < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 | */ void Tcl_AppendStringsToObjVA( Tcl_Obj *objPtr, /* Points to the object to append to. */ va_list argList) /* Variable argument list. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); } while (1) { const char *bytes = va_arg(argList, char *); if (bytes == NULL) { break; } Tcl_AppendToObj(objPtr, bytes, -1); } } /* *---------------------------------------------------------------------- * * Tcl_AppendStringsToObj -- * |
︙ | ︙ | |||
2931 2932 2933 2934 2935 2936 2937 | } if (size < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } /* Grow space if needed */ if (size > stringPtr->allocated) { | < < < < < < < < < < < < < < < < | < < | 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 | } if (size < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } /* Grow space if needed */ if (size > stringPtr->allocated) { GrowStringBuffer(objPtr, size, 1); } copyBytes: dst = objPtr->bytes + origLength; for (i = 0; i < numChars; i++) { dst += Tcl_UniCharToUtf((int) unicode[i], dst); } |
︙ | ︙ |
Changes to tests/stringObj.test.
︙ | ︙ | |||
8 9 10 11 12 13 14 | # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # 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.21 2009/02/17 17:17:32 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } testConstraint testobj [llength [info commands testobj]] |
︙ | ︙ | |||
132 133 134 135 136 137 138 | list [teststringobj length 1] [teststringobj get 1] } {15 {abc 123 abcdefg}} test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj { testobj freeallvars testobj newobj 1 teststringobj appendstrings 1 123 abcdefg list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1] | | | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | list [teststringobj length 1] [teststringobj get 1] } {15 {abc 123 abcdefg}} test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj { testobj freeallvars testobj newobj 1 teststringobj appendstrings 1 123 abcdefg list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1] } {10 20 123abcdefg} test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj { testobj freeallvars teststringobj set 1 abc teststringobj setlength 1 10 teststringobj setlength 1 2 teststringobj appendstrings 1 34567890 list [teststringobj length 1] [teststringobj length2 1] \ |
︙ | ︙ |