New testcase, contributed by @chrstphrchvz. Many thanks! See [3837178c25]

2 files changed, 19 insertions, 1 deletions

diff --git a/tests/dstring.test b/tests/dstring.test
index 6cf4bb8..59b3459 100644
--- a/tests/dstring.test
+++ b/tests/dstring.test
@@ -418,6 +418,24 @@ test dstring-4.2 {truncation} -constraints testdstring -setup {
 } -cleanup {
     testdstring free
 } -result {{} 0}
+test dstring-4.3 {truncation} -constraints testdstring -setup {
+    testdstring free
+} -body {
+    testdstring append "xwvut" -1
+    # Pass a negative length to Tcl_DStringSetLength();
+    # if not caught, causing '\0' to be written out-of-bounds,
+    # try corrupting dsPtr->length which begins
+    # 2*sizeof(Tcl_Size) bytes before dsPtr->staticSpace[],
+    # so that the result is -256 (on little endian systems)
+    # rather than e.g. -8 or -16.
+    # (sizeof(Tcl_Size) does not seem to be available via Tcl,
+    # so assume sizeof(Tcl_Size) == sizeof(void*) for Tcl 9.)
+    testdstring trunc [expr {-2*([package vsatisfies $tcl_version 9.0-]
+	? $tcl_platform(pointerSize) : 4)}]
+    list [testdstring get] [testdstring length]
+} -cleanup {
+    testdstring free
+} -result {{} 0}
 
 test dstring-5.1 {copying to result} -constraints testdstring -setup {
     testdstring free
diff --git a/tests/tailcall.test b/tests/tailcall.test
index 35a7268..6b09cde 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.test
@@ -709,7 +709,7 @@ test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body {
 } -returnCodes 1 -result {namespace "::ns" not found}
 
 test tailcall-bug-784befb0ba {tailcall crash with 254 args} -body {
-    proc tccrash args {llength $args}	
+    proc tccrash args {llength $args}
     # Must be EXACTLY 254 for crash
     proc p {} [list tailcall tccrash {*}[lrepeat 254 x]]
     p