summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-04-08 13:26:23 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-04-08 13:26:23 (GMT)
commitf10d81b895d8ca9d30428aac9884685fb284986a (patch)
tree7f94efe33eb67e54166bcce1f6f00fe697506798 /tests
parent9a41057f12f98c43dddf469be6d0822f1c90384c (diff)
downloadtcl-f10d81b895d8ca9d30428aac9884685fb284986a.zip
tcl-f10d81b895d8ca9d30428aac9884685fb284986a.tar.gz
tcl-f10d81b895d8ca9d30428aac9884685fb284986a.tar.bz2
* 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.
Diffstat (limited to 'tests')
-rw-r--r--tests/subst.test20
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: