diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2016-03-20 20:43:57 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2016-03-20 20:43:57 (GMT) |
| commit | c2bbf3cc3a6c2c35b0911def8f5759e4e0307053 (patch) | |
| tree | ef1ff2da03b8dfbd37d7a9454b7297df6a7ef342 | |
| parent | e3777c3fae15755d6c7951309e8c2f6a152e737c (diff) | |
| parent | 6f7c0d0cb81c0a6d9144679065e189a6274ac1ed (diff) | |
| download | tcl-c2bbf3cc3a6c2c35b0911def8f5759e4e0307053.zip tcl-c2bbf3cc3a6c2c35b0911def8f5759e4e0307053.tar.gz tcl-c2bbf3cc3a6c2c35b0911def8f5759e4e0307053.tar.bz2 | |
[1af8de570511] Fix crash in [string replace] caused by cut-n-paste.
| -rw-r--r-- | generic/tclExecute.c | 35 | ||||
| -rw-r--r-- | tests/stringComp.test | 10 |
2 files changed, 23 insertions, 22 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 20504bd..065bf34 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5605,6 +5605,17 @@ TEBCresume( if (length3 - 1 == toIdx - fromIdx) { unsigned char *bytes1, *bytes2; + /* + * Flush the info in the string internal rep that refers to the + * about-to-be-invalidated UTF-8 rep. This sets the 'allocated' + * field of the String structure to 0 to indicate that a new + * buffer needs to be allocated. This assumes that the value is + * already of tclStringTypePtr type, which should be true provided + * we call it after Tcl_GetUnicodeFromObj. + */ +#define MarkStringInternalRepForFlush(objPtr) \ + (((int *) ((objPtr)->internalRep.twoPtrValue.ptr1))[1] = 0) + if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_DuplicateObj(valuePtr); if (TclIsPureByteArray(objResultPtr) @@ -5617,17 +5628,7 @@ TEBCresume( ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL); memcpy(ustring1 + fromIdx, ustring2, length3 * sizeof(Tcl_UniChar)); - - /* - * Magic! Flush the info in the string internal rep that - * refers to the about-to-be-invalidated UTF-8 rep. This - * sets the 'allocated' field of the String structure to 0 - * to indicate that a new buffer needs to be allocated. - * This is safe; we know we've got a tclStringTypePtr set - * at this point (post Tcl_GetUnicodeFromObj). - */ - - ((int *) objResultPtr->internalRep.twoPtrValue.ptr1)[1] = 0; + MarkStringInternalRepForFlush(objResultPtr); } Tcl_InvalidateStringRep(objResultPtr); TclDecrRefCount(value3Ptr); @@ -5644,17 +5645,7 @@ TEBCresume( ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL); memcpy(ustring1 + fromIdx, ustring2, length3 * sizeof(Tcl_UniChar)); - - /* - * Magic! Flush the info in the string internal rep that - * refers to the about-to-be-invalidated UTF-8 rep. This - * sets the 'allocated' field of the String structure to 0 - * to indicate that a new buffer needs to be allocated. - * This is safe; we know we've got a tclStringTypePtr set - * at this point (post Tcl_GetUnicodeFromObj). - */ - - ((int *) objResultPtr->internalRep.twoPtrValue.ptr1)[1] = 0; + MarkStringInternalRepForFlush(valuePtr); } Tcl_InvalidateStringRep(valuePtr); TclDecrRefCount(value3Ptr); diff --git a/tests/stringComp.test b/tests/stringComp.test index f5ba002..77e14d6 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -728,6 +728,16 @@ test stringComp-14.3 {Bug 0dca3bfa8f} { expr {$arg ne $argCopy} }} abcde } 1 +test stringComp-14.4 {Bug 1af8de570511} { + apply {{x y} { + # Generate an unshared string value + set val "" + for { set i 0 } { $i < $x } { incr i } { + set val [format "0%s" $val] + } + string replace $val[unset val] 1 1 $y + }} 4 x +} 0x00 ## string tolower ## not yet bc |
