diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 25 | ||||
| -rw-r--r-- | tests/subst.test | 20 |
3 files changed, 48 insertions, 6 deletions
@@ -1,3 +1,12 @@ +2010-04-08 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmdsSZ.c (TclSubstCompile): If the first token does + not result in a *guaranteed* push of a Tcl_Obj on the stack, we must + push an empty object. Otherwise it is possible to get to a 'concat1' + or 'done' without enough values on the stack, resulting in a crash. + Thanks to Joe Mistachkin for identifying a script that could trigger + this case. + 2010-04-07 Donal K. Fellows <dkf@users.sf.net> * doc/catch.n, doc/info.n, doc/return.n: Formatting. diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index b19dfc8..3d45833 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.7 2010/03/27 22:40:14 nijtmans Exp $ + * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.8 2010/04/08 13:26:24 dkf Exp $ */ #include "tclInt.h" @@ -659,7 +659,21 @@ TclSubstCompile( TclSubstParse(interp, bytes, numBytes, flags, &parse, &state); - for (tokenPtr = parse.tokenPtr, endTokenPtr = tokenPtr + parse.numTokens; + /* + * Tricky point! If the first token does not result in a *guaranteed* push + * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it + * is possible to get to an INST_CONCAT1 or INST_DONE without enough + * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for + * identifying a script that could trigger this case. + */ + + tokenPtr = parse.tokenPtr; + if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) { + PushLiteral(envPtr, "", 0); + count++; + } + + for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { int length, literal, catchRange, breakJump; char buf[TCL_UTF_MAX]; @@ -790,7 +804,11 @@ TclSubstCompile( Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d", CurrentOffset(envPtr) - otherFixup.codeOffset); } - /* Pull the result to top of stack, discard options dict */ + + /* + * Pull the result to top of stack, discard options dict. + */ + TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitOpcode(INST_POP, envPtr); @@ -802,6 +820,7 @@ TclSubstCompile( * through them all. So, we now have a stack requirements estimate * that is too low. Here we manually fix that up. */ + TclAdjustStackDepth(5, envPtr); /* OK destination */ diff --git a/tests/subst.test b/tests/subst.test index a7d6feb..1b9ccf6 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -11,13 +11,13 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: subst.test,v 1.19 2008/04/23 15:44:38 dkf Exp $ +# RCS: @(#) $Id: subst.test,v 1.20 2010/04/08 13:26:25 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 namespace import -force ::tcltest::* } - + test subst-1.1 {basics} -returnCodes error -body { subst } -result {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"} @@ -261,7 +261,21 @@ test subst-12.5 {nasty case, Bug 1036649} { } lappend res $x } {1 {missing close-bracket} 0} - +test subst-12.6 {nasty case with compilation} { + set x unset + set y unset + list [eval [list subst {[set x 1;break;incr x][set y $x]}]] $x $y +} {{} 1 unset} +test subst-12.7 {nasty case with compilation} { + set x unset + set y unset + list [eval [list subst {[set x 1;continue;incr x][set y $x]}]] $x $y +} {1 1 1} + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |