summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclCompCmdsSZ.c25
-rw-r--r--tests/subst.test20
3 files changed, 48 insertions, 6 deletions
diff --git a/ChangeLog b/ChangeLog
index 2df8edc..a232ac5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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: