diff options
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 2 | ||||
| -rw-r--r-- | generic/tclScan.c | 15 | ||||
| -rw-r--r-- | tests/scan.test | 5 | ||||
| -rw-r--r-- | tests/tailcall.test | 7 |
4 files changed, 22 insertions, 7 deletions
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 5146b33..5d190a1 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -2661,7 +2661,7 @@ TclCompileTailcallCmd( Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; - if (parsePtr->numWords < 2 || parsePtr->numWords > 256 + if (parsePtr->numWords < 2 || parsePtr->numWords >= 256 || envPtr->procPtr == NULL) { return TCL_ERROR; } diff --git a/generic/tclScan.c b/generic/tclScan.c index c200fa0..f332d24 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -306,7 +306,7 @@ ValidateFormat( * format string. */ - value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ + unsigned long ul = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ if (*end != '$') { goto notXpg; } @@ -316,17 +316,20 @@ ValidateFormat( if (gotSequential) { goto mixedXPG; } - objIndex = value - 1; - if ((objIndex < 0) || (numVars && (objIndex >= numVars))) { + if (ul == 0 || ul >= INT_MAX) { + goto badIndex; + } + objIndex = (int) ul - 1; + if (numVars && (objIndex >= numVars)) { goto badIndex; } else if (numVars == 0) { /* * In the case where no vars are specified, the user can * specify %9999$ legally, so we have to consider special - * rules for growing the assign array. 'value' is guaranteed - * to be > 0. + * rules for growing the assign array. 'ul' is guaranteed + * to be > 0 and < INT_MAX as per checks above. */ - xpgSize = (xpgSize > value) ? xpgSize : value; + xpgSize = (xpgSize > (int)ul) ? xpgSize : (int)ul; } goto xpgCheckDone; } 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..c9ec674 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 |