From 73dbbaaa23c0ab5d0233211c9f2e34782991a87d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 7 May 2023 20:06:50 +0000 Subject: New testcase, contributed by @chrstphrchvz. Many thanks! See [3837178c25] --- tests/dstring.test | 18 ++++++++++++++++++ tests/tailcall.test | 2 +- 2 files changed, 19 insertions(+), 1 deletion(-) 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 -- cgit v0.12