summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-09-19 20:07:41 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-09-19 20:07:41 (GMT)
commit54a81d4f0e97770518fd43186017b03d2663f210 (patch)
tree4be717f218065bad7e5e86b4691800dd9d84c96f
parent5285fe3edefa318fa7293cecd792e1fd746556a4 (diff)
parentf95a5e7c8241472de7873a2daa7798f06dcda8eb (diff)
downloadtcl-54a81d4f0e97770518fd43186017b03d2663f210.zip
tcl-54a81d4f0e97770518fd43186017b03d2663f210.tar.gz
tcl-54a81d4f0e97770518fd43186017b03d2663f210.tar.bz2
merge trunk
-rw-r--r--generic/tclCompCmdsSZ.c40
-rw-r--r--tests/var.test3
2 files changed, 28 insertions, 15 deletions
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 468c1c0..b90bff8 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2815,19 +2815,37 @@ TclCompileUnsetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
- int isScalar, localIndex, flags, i;
- Tcl_Obj *leadingWord;
+ int isScalar, localIndex, flags = 1, i;
DefineLineInformation; /* TIP #280 */
/* TODO: Consider support for compiling expanded args. */
- flags = 1;
- i = 1;
+
+ /*
+ * Verify that all words are known at compile time so that we can handle
+ * them without needing to do a nasty push/rotate. [Bug 3970f54c4e]
+ */
+
+ for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+ varTokenPtr = TokenAfter(varTokenPtr);
+ if (!TclWordKnownAtCompileTime(varTokenPtr, NULL)) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Check for options; if they're present we'll know for sure because we
+ * know we're all constant arguments.
+ */
+
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- leadingWord = Tcl_NewObj();
- if (parsePtr->numWords > 1 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+ i = 1;
+ if (parsePtr->numWords > 1) {
+ Tcl_Obj *leadingWord = Tcl_NewObj();
+ const char *bytes;
int len;
- const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
+ (void) TclWordKnownAtCompileTime(varTokenPtr, leadingWord);
+ bytes = Tcl_GetStringFromObj(leadingWord, &len);
if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
flags = 0;
varTokenPtr = TokenAfter(varTokenPtr);
@@ -2836,16 +2854,8 @@ TclCompileUnsetCmd(
varTokenPtr = TokenAfter(varTokenPtr);
i++;
}
- } else {
- /*
- * Cannot guarantee that the first word is not '-nocomplain' at
- * evaluation with reasonable effort, so spill to interpreted version.
- */
-
TclDecrRefCount(leadingWord);
- return TCL_ERROR;
}
- TclDecrRefCount(leadingWord);
for ( ; i<parsePtr->numWords ; i++) {
/*
diff --git a/tests/var.test b/tests/var.test
index 6d4be26..208b361 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -748,6 +748,9 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
namespace eval test A useSomeUnlikelyNameHere
namespace eval test unset useSomeUnlikelyNameHere
} {}
+test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {
+ apply {{} {unset foo [return ok]}}
+} ok
test var-16.1 {CallVarTraces: save/restore interp error state} {
trace add variable ::errorCode write " ;#"