diff options
| -rw-r--r-- | generic/tclCompile.c | 31 | ||||
| -rw-r--r-- | tests/bigdata.test | 21 | ||||
| -rw-r--r-- | tests/binary.test | 5 |
3 files changed, 53 insertions, 4 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 9448241..926c492 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -870,6 +870,18 @@ TclSetByteCodeFromAny( } /* + * After optimization is all done, check that byte code length limits + * are not exceeded. Bug [27b3ce2997]. + */ + if ((compEnv.codeNext - compEnv.codeStart) > INT_MAX) { + /* + * Cannot just return TCL_ERROR as callers ignore return value. + * TODO - May be use TclCompileSyntaxError here? + */ + Tcl_Panic("Maximum byte code length %d exceeded.", INT_MAX); + } + + /* * Change the object into a ByteCode object. Ownership of the literal * objects and aux data items passes to the ByteCode object. */ @@ -2136,7 +2148,7 @@ TclCompileScript( * serves as context for finding and compiling * commands. May not be NULL. */ const char *script, /* The source script to compile. */ - Tcl_Size numBytes, /* Number of bytes in script. If -1, the + Tcl_Size numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ @@ -2167,9 +2179,26 @@ TclCompileScript( return; } + if (numBytes < 0) { + numBytes = strlen(script); + } + /* Each iteration compiles one command from the script. */ if (numBytes > 0) { + if (numBytes >= INT_MAX) { + /* + * Note this gets -errorline as 1. Not worth figuring out which line + * crosses the limit to get -errorline for this error case. + */ + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER + "d exceeds max permitted length %d.", + numBytes, (int)INT_MAX-1)); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL); + TclCompileSyntaxError(interp, envPtr); + return; + } /* * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so * many nested compilations (body enclosed in body) can cause abnormal diff --git a/tests/bigdata.test b/tests/bigdata.test index ccd34af..6ecf4a0 100644 --- a/tests/bigdata.test +++ b/tests/bigdata.test @@ -116,6 +116,26 @@ set ::bigLengths(patlenmultiple) [bigPatlenMultiple $::bigLengths(intmax)] set ::bigLengths(upatlenmultiple) [bigPatlenMultiple $::bigLengths(uintmax)] # +# script limits +bigtestRO script-length-bigdata-1 {Test script length limit} b -body { + try [string cat [string repeat " " 0x7ffffff7] "set a b"] +} +# TODO - different behaviour between compiled and uncompiled +test script-length-bigdata-2.compiled {Test script length limit} -body { + try [string cat [string repeat " " 0x7ffffff8] "set a b"] +} -result {Script length 2147483647 exceeds max permitted length 2147483646.} -returnCodes error +test script-length-bigdata-2.uncompiled {Test script length limit} -body { + testevalex [string cat [string repeat " " 0x7ffffff8] "set a b"] +} -result b +test script-bytecode-length-bigdata-1 {Test bytecode length limit} -body { + # Note we need to exceed bytecode limit without exceeding script char limit + set s [string repeat {{*}$x;} [expr 0x7fffffff/6]] + catch $s r e +} -cleanup { + bigClean +} -constraints panic-in-EnterCmdStartData + +# # string cat bigtest string-cat-bigdata-1 "string cat large small result > INT_MAX" 1 -body { string equal \ @@ -159,7 +179,6 @@ bigtestRO string-equal/compare-bigdata-2 "string compare/equal -length unequal s } -cleanup { bigClean } -# -constraints bug-a814ee5bbd # # string first diff --git a/tests/binary.test b/tests/binary.test index 940de47..2984fec 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -20,6 +20,7 @@ catch [list package require -exact tcl::test [info patchlevel]] testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}] testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}] testConstraint testbytestring [llength [info commands testbytestring]] +testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] # Big test for correct ordering of data in [expr] proc testIEEE {} { @@ -3039,9 +3040,9 @@ test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"] } -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)" -test binary-80.5 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { +test binary-80.5 {Tcl_GetBytesFromObj} -constraints testbytestring -constraints pointerIs64bit -body { testbytestring [string repeat A [expr 2**31]] -} -result "byte sequence length exceeds INT_MAX" +} -returnCodes 1 -result "byte sequence length exceeds INT_MAX" # ---------------------------------------------------------------------- # cleanup |