From cadf55303e72b696eedb9b29a469156b27fffa47 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 19 Sep 2013 19:37:05 +0000
Subject: [3970f54c4e]: Corrected regression in argument order processing in
 [unset].

---
 generic/tclCompCmdsSZ.c | 40 +++++++++++++++++++++++++---------------
 tests/var.test          |  3 +++
 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 " ;#"
-- 
cgit v0.12