summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2016-03-20 20:43:57 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2016-03-20 20:43:57 (GMT)
commitc2bbf3cc3a6c2c35b0911def8f5759e4e0307053 (patch)
treeef1ff2da03b8dfbd37d7a9454b7297df6a7ef342
parente3777c3fae15755d6c7951309e8c2f6a152e737c (diff)
parent6f7c0d0cb81c0a6d9144679065e189a6274ac1ed (diff)
downloadtcl-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.c35
-rw-r--r--tests/stringComp.test10
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