* 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.

1 files changed, 17 insertions, 3 deletions

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: