summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2016-03-20 20:42:26 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2016-03-20 20:42:26 (GMT)
commit0aecb943f5d14659cbcee9ca6733c69744ffabe1 (patch)
tree091f9fd81e52275d399e2762e077201f3f8d4992
parent40526e0d3a5b496eb7566e47ec87a44920ea1ba5 (diff)
parent01d1cdb5e8789884ae310c5e38fb976559157460 (diff)
downloadtcl-0aecb943f5d14659cbcee9ca6733c69744ffabe1.zip
tcl-0aecb943f5d14659cbcee9ca6733c69744ffabe1.tar.gz
tcl-0aecb943f5d14659cbcee9ca6733c69744ffabe1.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 dacc9e2..c43cc40 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5737,6 +5737,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)
@@ -5749,17 +5760,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);
@@ -5776,17 +5777,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 a66525e..140a270 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