merge core-8-branch

4 files changed, 33 insertions, 3 deletions

diff --git a/tests/dstring.test b/tests/dstring.test
index 23863d0..7c9d9f6 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/ooUtil.test b/tests/ooUtil.test
index c8be9c8..f41c668 100644
--- a/tests/ooUtil.test
+++ b/tests/ooUtil.test
@@ -429,7 +429,7 @@ test ooUtil-5.1 {TIP 478: abstract} -setup {
     parent destroy
 } -result {1 1 1 123 456 ::y}
 
-test ooUtil-6.1 {TIP 478: classvarable} -setup {
+test ooUtil-6.1 {TIP 478: classvariable} -setup {
     oo::class create parent
 } -body {
     oo::class create xyz {
@@ -459,7 +459,7 @@ test ooUtil-6.1 {TIP 478: classvarable} -setup {
 } -cleanup {
     parent destroy
 } -result {{1 2} {1 2} {2 3}}
-test ooUtil-6.2 {TIP 478: classvarable error case} -setup {
+test ooUtil-6.2 {TIP 478: classvariable error case} -setup {
     oo::class create parent
 } -body {
     oo::class create xyz {
@@ -475,7 +475,7 @@ test ooUtil-6.2 {TIP 478: classvarable error case} -setup {
 } -returnCodes error -cleanup {
     parent destroy
 } -result {bad variable name "x(1)": can't create a scalar variable that looks like an array element}
-test ooUtil-6.3 {TIP 478: classvarable error case} -setup {
+test ooUtil-6.3 {TIP 478: classvariable error case} -setup {
     oo::class create parent
 } -body {
     oo::class create xyz {
diff --git a/tests/scan.test b/tests/scan.test
index cf58828..98ec314 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -858,6 +858,11 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
     set msg [scan "10 20 30" {%100$d %5$d %200$d}]
     list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
 } {200 10 20 30}
+test scan-13.9 {Tcl_ScanObjCmd, inline XPG case limit error} -body {
+    # Note this applies to 64-bit builds as well so long as max number of
+    # command line arguments allowed for scan command is INT_MAX
+    scan abc {%2147483648$s}
+} -result {"%n$" argument index out of range} -returnCodes error
 
 # scan infinities - not working
 
diff --git a/tests/tailcall.test b/tests/tailcall.test
index c738bb3..0016845 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.test
@@ -708,6 +708,13 @@ 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}
+    # Must be EXACTLY 254 for crash
+    proc p {} [list tailcall tccrash {*}[lrepeat 254 x]]
+    p
+} -result 254
+
 # cleanup
 ::tcltest::cleanupTests