diff options
| -rw-r--r-- | generic/tclCmdMZ.c | 3 | ||||
| -rw-r--r-- | generic/tclInt.h | 2 | ||||
| -rw-r--r-- | generic/tclOO.c | 211 | ||||
| -rw-r--r-- | generic/tclOODefineCmds.c | 21 | ||||
| -rw-r--r-- | generic/tclUtil.c | 255 | ||||
| -rw-r--r-- | tests/oo.test | 8 |
6 files changed, 191 insertions, 309 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 3c5c5e4..ba96d7c 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3228,7 +3228,8 @@ StringTrimCmd( } string1 = TclGetStringFromObj(objv[1], &length1); - triml = TclTrim(string1, length1, string2, length2, &trimr); + triml = TclTrimLeft(string1, length1, string2, length2); + trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2); Tcl_SetObjResult(interp, Tcl_NewStringObj(string1 + triml, length1 - triml - trimr)); diff --git a/generic/tclInt.h b/generic/tclInt.h index 57f648c..e7794c7 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3198,8 +3198,6 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, int *tokensLeftPtr, int line, int *clNextOuter, const char *outerScript); -MODULE_SCOPE int TclTrim(const char *bytes, int numBytes, - const char *trim, int numTrim, int *trimRight); MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, diff --git a/generic/tclOO.c b/generic/tclOO.c index c80f039..dcf48ef 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -523,47 +523,47 @@ InitClassSystemRoots( fakeCls.thisPtr = &fakeObject; - fPtr->objectCls = AllocClass(interp, AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL)); - /* Corresponding TclOODecrRefCount in KillFoudation */ - AddRef(fPtr->objectCls->thisPtr); - - /* This is why it is unnecessary in this routine to replace the - * incremented reference count of fPtr->objectCls that was swallowed by - * fakeObject. */ - fPtr->objectCls->superclasses.num = 0; - ckfree(fPtr->objectCls->superclasses.list); - fPtr->objectCls->superclasses.list = NULL; - - /* special initialization for the primordial objects */ - fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; - fPtr->objectCls->flags |= ROOT_OBJECT; - fPtr->classCls = AllocClass(interp, AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL)); - /* Corresponding TclOODecrRefCount in KillFoudation */ - AddRef(fPtr->classCls->thisPtr); /* - * Increment reference counts for each reference because these - * relationships can be dynamically changed. - * - * Corresponding TclOODecrRefCount for all incremented refcounts is in - * KillFoundation. + * Rewire bootstrapped objects. */ - /* Rewire bootstrapped objects. */ fPtr->objectCls->thisPtr->selfCls = fPtr->classCls; - AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr); - fPtr->classCls->thisPtr->selfCls = fPtr->classCls; + + AddRef(fPtr->objectCls->thisPtr); + AddRef(fPtr->classCls->thisPtr); AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr); + AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr); + + /* + * Special initialization for the primordial objects. + */ + + fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT; + fPtr->objectCls->flags |= ROOT_OBJECT; + + /* + * This is why it is unnecessary in this routine to make up for the + * incremented reference count of fPtr->objectCls that was sallwed by + * fakeObject. + */ + + fPtr->objectCls->superclasses.num = 0; + ckfree(fPtr->objectCls->superclasses.list); + fPtr->objectCls->superclasses.list = NULL; fPtr->classCls->thisPtr->flags |= ROOT_CLASS; fPtr->classCls->flags |= ROOT_CLASS; - /* Standard initialization for new Objects */ + /* + * Standard initialization for new Objects. + */ + TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls); TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls); TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls); @@ -632,20 +632,20 @@ KillFoundation( { Foundation *fPtr = GetFoundation(interp); + /* + * Crude mechanism to avoid leaking the Object struct of the + * foundation components oo::object and oo::class + * + * Should probably be replaced with something more elegantly designed. + */ + while (TclOODecrRefCount(fPtr->objectCls->thisPtr) == 0) {}; + while (TclOODecrRefCount(fPtr->classCls->thisPtr) == 0) {}; + TclDecrRefCount(fPtr->unknownMethodNameObj); TclDecrRefCount(fPtr->constructorName); TclDecrRefCount(fPtr->destructorName); TclDecrRefCount(fPtr->clonedName); TclDecrRefCount(fPtr->defineName); - if (fPtr->objectCls->thisPtr->selfCls != NULL) { - TclOODecrRefCount(fPtr->objectCls->thisPtr->selfCls->thisPtr); - } - if (fPtr->classCls->thisPtr->selfCls != NULL) { - TclOODecrRefCount(fPtr->classCls->thisPtr->selfCls->thisPtr); - } - TclOODecrRefCount(fPtr->objectCls->thisPtr); - TclOODecrRefCount(fPtr->classCls->thisPtr); - ckfree(fPtr); } @@ -729,8 +729,6 @@ AllocObject( Tcl_ResetResult(interp); } - ((Namespace *)oPtr->namespacePtr)->refCount++; - /* * Make the namespace know about the helper commands. This grants access * to the [self] and [next] commands. @@ -903,9 +901,10 @@ ObjectRenamedTrace( /* * ---------------------------------------------------------------------- * - * DeleteDescendants -- + * DeleteDescendants, ReleaseClassContents -- * - * Delete all descendants of a particular class. + * Tear down the special class data structure, including deleting all + * dependent classes and objects. * * ---------------------------------------------------------------------- */ @@ -917,55 +916,44 @@ DeleteDescendants( { Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr; Object *instancePtr; + int i; /* * Squelch classes that this class has been mixed into. */ - if (clsPtr->mixinSubs.num > 0) { - while (clsPtr->mixinSubs.num > 0) { - mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1]; - /* This condition also covers the case where mixinSubclassPtr == - * clsPtr - */ - if (!Deleted(mixinSubclassPtr->thisPtr)) { - Tcl_DeleteCommandFromToken(interp, - mixinSubclassPtr->thisPtr->command); - } - TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); + FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) { + /* + * This condition also covers the case where mixinSubclassPtr == + * clsPtr + */ + + if (!Deleted(mixinSubclassPtr->thisPtr)) { + Tcl_DeleteCommandFromToken(interp, + mixinSubclassPtr->thisPtr->command); } - } - if (clsPtr->mixinSubs.size > 0) { - ckfree(clsPtr->mixinSubs.list); - clsPtr->mixinSubs.size = 0; + i -= TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr); + TclOODecrRefCount(mixinSubclassPtr->thisPtr); } /* * Squelch subclasses of this class. */ - if (clsPtr->subclasses.num > 0) { - while (clsPtr->subclasses.num > 0) { - subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1]; - if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) { - Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); - } - TclOORemoveFromSubclasses(subclassPtr, clsPtr); + FOREACH(subclassPtr, clsPtr->subclasses) { + if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) { + Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command); } - } - if (clsPtr->subclasses.size > 0) { - ckfree(clsPtr->subclasses.list); - clsPtr->subclasses.list = NULL; - clsPtr->subclasses.size = 0; + i -= TclOORemoveFromSubclasses(subclassPtr, clsPtr); + TclOODecrRefCount(subclassPtr->thisPtr); } /* * Squelch instances of this class (includes objects we're mixed into). */ - if (clsPtr->instances.num > 0) { - while (clsPtr->instances.num > 0) { - instancePtr = clsPtr->instances.list[clsPtr->instances.num-1]; + if (!IsRootClass(oPtr)) { + FOREACH(instancePtr, clsPtr->instances) { /* * This condition also covers the case where instancePtr == oPtr */ @@ -973,26 +961,10 @@ DeleteDescendants( if (!Deleted(instancePtr) && !IsRoot(instancePtr)) { Tcl_DeleteCommandFromToken(interp, instancePtr->command); } - TclOORemoveFromInstances(instancePtr, clsPtr); + i -= TclOORemoveFromInstances(instancePtr, clsPtr); } } - if (clsPtr->instances.size > 0) { - ckfree(clsPtr->instances.list); - clsPtr->instances.list = NULL; - clsPtr->instances.size = 0; - } } - -/* - * ---------------------------------------------------------------------- - * - * ReleaseClassContents -- - * - * Tear down the special class data structure, including deleting all - * dependent classes and objects. - * - * ---------------------------------------------------------------------- - */ static void ReleaseClassContents( @@ -1062,6 +1034,21 @@ ReleaseClassContents( } /* + * Squelch our instances. + */ + + if (clsPtr->instances.num) { + Object *oPtr; + + FOREACH(oPtr, clsPtr->instances) { + TclOODecrRefCount(oPtr); + } + ckfree(clsPtr->instances.list); + clsPtr->instances.list = NULL; + clsPtr->instances.num = 0; + } + + /* * Squelch our metadata. */ @@ -1077,21 +1064,11 @@ ReleaseClassContents( clsPtr->metadataPtr = NULL; } - if (clsPtr->mixins.num) { - FOREACH(tmpClsPtr, clsPtr->mixins) { - TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr); - } - ckfree(clsPtr->mixins.list); + FOREACH(tmpClsPtr, clsPtr->mixins) { + TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr); } - - if (clsPtr->superclasses.num > 0) { - FOREACH(tmpClsPtr, clsPtr->superclasses) { - TclOORemoveFromSubclasses(clsPtr, tmpClsPtr); - TclOODecrRefCount(tmpClsPtr->thisPtr); - } - ckfree(clsPtr->superclasses.list); - clsPtr->superclasses.num = 0; - clsPtr->superclasses.list = NULL; + FOREACH(tmpClsPtr, clsPtr->superclasses) { + TclOORemoveFromSubclasses(clsPtr, tmpClsPtr); } FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) { @@ -1227,10 +1204,10 @@ ObjectNamespaceDeleted( TclOORemoveFromInstances(oPtr, oPtr->selfCls); - if (oPtr->mixins.num > 0) { - FOREACH(mixinPtr, oPtr->mixins) { - TclOORemoveFromInstances(oPtr, mixinPtr); - } + FOREACH(mixinPtr, oPtr->mixins) { + i -= TclOORemoveFromInstances(oPtr, mixinPtr); + } + if (i) { ckfree(oPtr->mixins.list); } @@ -1299,9 +1276,7 @@ ObjectNamespaceDeleted( * Delete the object structure itself. */ - TclNsDecrRefCount((Namespace *)oPtr->namespacePtr); oPtr->namespacePtr = NULL; - TclOODecrRefCount(oPtr->selfCls->thisPtr); oPtr->selfCls = NULL; TclOODecrRefCount(oPtr); return; @@ -1324,8 +1299,14 @@ TclOODecrRefCount( Object *oPtr) { if (oPtr->refCount-- <= 1) { + Class *clsPtr = oPtr->classPtr; if (oPtr->classPtr != NULL) { + ckfree(clsPtr->superclasses.list); + ckfree(clsPtr->subclasses.list); + ckfree(clsPtr->instances.list); + ckfree(clsPtr->mixinSubs.list); + ckfree(clsPtr->mixins.list); ckfree(oPtr->classPtr); } ckfree(oPtr); @@ -1354,6 +1335,10 @@ TclOORemoveFromInstances( int i, res = 0; Object *instPtr; + if (Deleted(clsPtr->thisPtr)) { + return res; + } + FOREACH(instPtr, clsPtr->instances) { if (oPtr == instPtr) { RemoveItem(Object, clsPtr->instances, i); @@ -1416,6 +1401,10 @@ TclOORemoveFromSubclasses( int i, res = 0; Class *subclsPtr; + if (Deleted(superPtr->thisPtr)) { + return res; + } + FOREACH(subclsPtr, superPtr->subclasses) { if (subPtr == subclsPtr) { RemoveItem(Class, superPtr->subclasses, i); @@ -1480,6 +1469,10 @@ TclOORemoveFromMixinSubs( int i, res = 0; Class *subclsPtr; + if (Deleted(superPtr->thisPtr)) { + return res; + } + FOREACH(subclsPtr, superPtr->mixinSubs) { if (subPtr == subclsPtr) { RemoveItem(Class, superPtr->mixinSubs, i); @@ -1787,7 +1780,6 @@ TclNewObjectInstanceCommon( oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr); oPtr->selfCls = classPtr; - AddRef(classPtr->thisPtr); TclOOAddToInstances(oPtr, classPtr); /* @@ -2033,11 +2025,6 @@ Tcl_CopyObjectInstance( cls2Ptr->superclasses.num = clsPtr->superclasses.num; FOREACH(superPtr, cls2Ptr->superclasses) { TclOOAddToSubclasses(cls2Ptr, superPtr); - - /* For the new item in cls2Ptr->superclasses that memcpy just - * created - */ - AddRef(superPtr->thisPtr); } /* diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 6c1d58a..7c2a641 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -1185,13 +1185,15 @@ TclOODefineClassObjCmd( */ if (oPtr->selfCls != clsPtr) { - TclOORemoveFromInstances(oPtr, oPtr->selfCls); - TclOODecrRefCount(oPtr->selfCls->thisPtr); + + /* + * Reference count already incremented a few lines up. + */ + oPtr->selfCls = clsPtr; - AddRef(oPtr->selfCls->thisPtr); - TclOOAddToInstances(oPtr, oPtr->selfCls); + TclOOAddToInstances(oPtr, oPtr->selfCls); if (oPtr->classPtr != NULL) { BumpGlobalEpoch(interp, oPtr->classPtr); } else { @@ -2232,6 +2234,11 @@ ClassSuperSet( superclasses[0] = oPtr->fPtr->objectCls; } superc = 1; + + /* + * Corresponding TclOODecrRefCount is near the end of this function. + */ + AddRef(superclasses[0]->thisPtr); } else { for (i=0 ; i<superc ; i++) { @@ -2288,6 +2295,12 @@ ClassSuperSet( oPtr->classPtr->superclasses.num = superc; FOREACH(superPtr, oPtr->classPtr->superclasses) { TclOOAddToSubclasses(oPtr->classPtr, superPtr); + + /* + * To account for the AddRef() earlier in this function. + */ + + TclOODecrRefCount(superPtr->thisPtr); } BumpGlobalEpoch(interp, oPtr->classPtr); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 3fbc325..d1b81a9 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1647,46 +1647,11 @@ Tcl_Backslash( /* *---------------------------------------------------------------------- * - * UtfWellFormedEnd -- - * Checks the end of utf string is malformed, if yes - wraps bytes - * to the given buffer (as well-formed NTS string). The buffer - * argument should be initialized by the caller and ready to use. - * - * Results: - * The bytes with well-formed end of the string. - * - * Side effects: - * Buffer (DString) may be allocated, so must be released. - * - *---------------------------------------------------------------------- - */ - -static inline const char* -UtfWellFormedEnd( - Tcl_DString *buffer, /* Buffer used to hold well-formed string. */ - const char *bytes, /* Pointer to the beginning of the string. */ - int length) /* Length of the string. */ -{ - const char *l = bytes + length; - const char *p = Tcl_UtfPrev(l, bytes); - - if (Tcl_UtfCharComplete(p, l - p)) { - return bytes; - } - /* - * Malformed utf-8 end, be sure we've NTS to safe compare of end-character, - * avoid segfault by access violation out of range. - */ - Tcl_DStringAppend(buffer, bytes, length); - return Tcl_DStringValue(buffer); -} -/* - *---------------------------------------------------------------------- - * * TclTrimRight -- - * Takes two counted strings in the Tcl encoding. Conceptually - * finds the sub string (offset) to trim from the right side of the - * first string all characters found in the second string. + * + * Takes two counted strings in the Tcl encoding which must both be null + * terminated. Conceptually trims from the right side of the first string + * all characters found in the second string. * * Results: * The number of bytes to be removed from the end of the string. @@ -1697,8 +1662,8 @@ UtfWellFormedEnd( *---------------------------------------------------------------------- */ -static inline int -TrimRight( +int +TclTrimRight( const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ @@ -1708,6 +1673,18 @@ TrimRight( int pInc; Tcl_UniChar ch1 = 0, ch2 = 0; + if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) { + Tcl_Panic("TclTrimRight works only on null-terminated strings"); + } + + /* + * Empty strings -> nothing to do. + */ + + if ((numBytes == 0) || (numTrim == 0)) { + return 0; + } + /* * Outer loop: iterate over string to be trimmed. */ @@ -1746,46 +1723,15 @@ TrimRight( return numBytes - (p - bytes); } - -int -TclTrimRight( - const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ - const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ -{ - int res; - Tcl_DString bytesBuf, trimBuf; - - /* Empty strings -> nothing to do */ - if ((numBytes == 0) || (numTrim == 0)) { - return 0; - } - - Tcl_DStringInit(&bytesBuf); - Tcl_DStringInit(&trimBuf); - bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes); - trim = UtfWellFormedEnd(&trimBuf, trim, numTrim); - - res = TrimRight(bytes, numBytes, trim, numTrim); - if (res > numBytes) { - res = numBytes; - } - - Tcl_DStringFree(&bytesBuf); - Tcl_DStringFree(&trimBuf); - - return res; -} /* *---------------------------------------------------------------------- * * TclTrimLeft -- * - * Takes two counted strings in the Tcl encoding. Conceptually - * finds the sub string (offset) to trim from the left side of the - * first string all characters found in the second string. + * Takes two counted strings in the Tcl encoding which must both be null + * terminated. Conceptually trims from the left side of the first string + * all characters found in the second string. * * Results: * The number of bytes to be removed from the start of the string. @@ -1796,8 +1742,8 @@ TclTrimRight( *---------------------------------------------------------------------- */ -static inline int -TrimLeft( +int +TclTrimLeft( const char *bytes, /* String to be trimmed... */ int numBytes, /* ...and its length in bytes */ const char *trim, /* String of trim characters... */ @@ -1806,6 +1752,18 @@ TrimLeft( const char *p = bytes; Tcl_UniChar ch1 = 0, ch2 = 0; + if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) { + Tcl_Panic("TclTrimLeft works only on null-terminated strings"); + } + + /* + * Empty strings -> nothing to do. + */ + + if ((numBytes == 0) || (numTrim == 0)) { + return 0; + } + /* * Outer loop: iterate over string to be trimmed. */ @@ -1840,99 +1798,10 @@ TrimLeft( p += pInc; numBytes -= pInc; - } while (numBytes > 0); + } while (numBytes); return p - bytes; } - -int -TclTrimLeft( - const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ - const char *trim, /* String of trim characters... */ - int numTrim) /* ...and its length in bytes */ -{ - int res; - Tcl_DString bytesBuf, trimBuf; - - /* Empty strings -> nothing to do */ - if ((numBytes == 0) || (numTrim == 0)) { - return 0; - } - - Tcl_DStringInit(&bytesBuf); - Tcl_DStringInit(&trimBuf); - bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes); - trim = UtfWellFormedEnd(&trimBuf, trim, numTrim); - - res = TrimLeft(bytes, numBytes, trim, numTrim); - if (res > numBytes) { - res = numBytes; - } - - Tcl_DStringFree(&bytesBuf); - Tcl_DStringFree(&trimBuf); - - return res; -} - -/* - *---------------------------------------------------------------------- - * - * TclTrim -- - * Finds the sub string (offset) to trim from both sides of the - * first string all characters found in the second string. - * - * Results: - * The number of bytes to be removed from the start of the string - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TclTrim( - const char *bytes, /* String to be trimmed... */ - int numBytes, /* ...and its length in bytes */ - const char *trim, /* String of trim characters... */ - int numTrim, /* ...and its length in bytes */ - int *trimRight) /* Offset from the end of the string. */ -{ - int trimLeft; - Tcl_DString bytesBuf, trimBuf; - - /* Empty strings -> nothing to do */ - if ((numBytes == 0) || (numTrim == 0)) { - *trimRight = 0; - return 0; - } - - Tcl_DStringInit(&bytesBuf); - Tcl_DStringInit(&trimBuf); - bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes); - trim = UtfWellFormedEnd(&trimBuf, trim, numTrim); - - trimLeft = TrimLeft(bytes, numBytes, trim, numTrim); - if (trimLeft > numBytes) { - trimLeft = numBytes; - } - numBytes -= trimLeft; - *trimRight = 0; - if (numBytes) { - bytes += trimLeft; - *trimRight = TrimRight(bytes, numBytes, trim, numTrim); - if (*trimRight > numBytes) { - *trimRight = numBytes; - } - } - - Tcl_DStringFree(&bytesBuf); - Tcl_DStringFree(&trimBuf); - - return trimLeft; -} /* *---------------------------------------------------------------------- @@ -2000,20 +1869,30 @@ Tcl_Concat( result = ckalloc((unsigned) (bytesNeeded + argc)); for (p = result, i = 0; i < argc; i++) { - int triml, trimr, elemLength; + int trim, elemLength; const char *element; element = argv[i]; elemLength = strlen(argv[i]); - /* Trim away the leading/trailing whitespace. */ - triml = TclTrim(element, elemLength, CONCAT_TRIM_SET, - CONCAT_WS_SIZE, &trimr); - element += triml; - elemLength -= triml + trimr; + /* + * Trim away the leading whitespace. + */ + + trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET, + CONCAT_WS_SIZE); + element += trim; + elemLength -= trim; + + /* + * Trim away the trailing whitespace. Do not permit trimming to expose + * a final backslash character. + */ - /* Do not permit trimming to expose a final backslash character. */ - elemLength += trimr && (element[elemLength - 1] == '\\'); + trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET, + CONCAT_WS_SIZE); + trim -= trim && (element[elemLength - trim - 1] == '\\'); + elemLength -= trim; /* * If we're left with empty element after trimming, do nothing. @@ -2133,18 +2012,28 @@ Tcl_ConcatObj( Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - int triml, trimr; + int trim; element = TclGetStringFromObj(objv[i], &elemLength); - /* Trim away the leading/trailing whitespace. */ - triml = TclTrim(element, elemLength, CONCAT_TRIM_SET, - CONCAT_WS_SIZE, &trimr); - element += triml; - elemLength -= triml + trimr; + /* + * Trim away the leading whitespace. + */ + + trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET, + CONCAT_WS_SIZE); + element += trim; + elemLength -= trim; + + /* + * Trim away the trailing whitespace. Do not permit trimming to expose + * a final backslash character. + */ - /* Do not permit trimming to expose a final backslash character. */ - elemLength += trimr && (element[elemLength - 1] == '\\'); + trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET, + CONCAT_WS_SIZE); + trim -= trim && (element[elemLength - trim - 1] == '\\'); + elemLength -= trim; /* * If we're left with empty element after trimming, do nothing. diff --git a/tests/oo.test b/tests/oo.test index 22e3f11..4f9490b 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -57,13 +57,7 @@ test oo-0.4 {basic test of OO's ability to clean up its initial state} -body { foo destroy } } -constraints memory -result 0 -test oo-0.5.1 {testing object foundation cleanup} memory { - leaktest { - interp create foo - interp delete foo - } -} 0 -test oo-0.5.2 {testing literal leak on interp delete} memory { +test oo-0.5 {testing literal leak on interp delete} memory { leaktest { interp create foo foo eval {oo::object new} |