summaryrefslogtreecommitdiffstats
path: root/generic/tclCompCmdsSZ.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-09-19 22:37:06 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-09-19 22:37:06 (GMT)
commit2139c0e39e6fb83eb76edc0088de73b9caa7cdb3 (patch)
tree5e96f06e3251cd779e7094309b66f456b6c0bb5f /generic/tclCompCmdsSZ.c
parentcadf55303e72b696eedb9b29a469156b27fffa47 (diff)
downloadtcl-2139c0e39e6fb83eb76edc0088de73b9caa7cdb3.zip
tcl-2139c0e39e6fb83eb76edc0088de73b9caa7cdb3.tar.gz
tcl-2139c0e39e6fb83eb76edc0088de73b9caa7cdb3.tar.bz2
[3970f54c4e]: Improved fix that is more tolerant of a single variable varname.
Diffstat (limited to 'generic/tclCompCmdsSZ.c')
-rw-r--r--generic/tclCompCmdsSZ.c82
1 files changed, 57 insertions, 25 deletions
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index b90bff8..44cb66e 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2815,49 +2815,81 @@ TclCompileUnsetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
- int isScalar, localIndex, flags = 1, i;
+ int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
DefineLineInformation; /* TIP #280 */
/* TODO: Consider support for compiling expanded args. */
/*
- * 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]
+ * Verify that all words - except the first non-option one - 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++) {
+ Tcl_Obj *leadingWord = Tcl_NewObj();
+
varTokenPtr = TokenAfter(varTokenPtr);
- if (!TclWordKnownAtCompileTime(varTokenPtr, NULL)) {
+ if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+ TclDecrRefCount(leadingWord);
+
+ /*
+ * We can tolerate non-trivial substitutions in the first variable
+ * to be unset. If a '--' or '-nocomplain' was present, anything
+ * goes in that one place! (All subsequent variable names must be
+ * constants since we don't want to have to push them all first.)
+ */
+
+ if (varCount == 0) {
+ if (haveFlags) {
+ continue;
+ }
+
+ /*
+ * In fact, we're OK as long as we're the first argument *and*
+ * we provably don't start with a '-'. If that is true, then
+ * even if everything else is varying, we still can't be a
+ * flag. Otherwise we'll spill to runtime to place a limit on
+ * the trickiness.
+ */
+
+ if (varTokenPtr->type == TCL_TOKEN_WORD
+ && varTokenPtr[1].type == TCL_TOKEN_TEXT
+ && varTokenPtr[1].size > 0
+ && varTokenPtr[1].start[0] != '-') {
+ continue;
+ }
+ }
return TCL_ERROR;
}
+ if (i == 1) {
+ const char *bytes;
+ int len;
+
+ bytes = Tcl_GetStringFromObj(leadingWord, &len);
+ if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
+ flags = 0;
+ haveFlags = 1;
+ } else if (len == 2 && !strncmp("--", bytes, 2)) {
+ haveFlags = 1;
+ } else {
+ varCount++;
+ }
+ } else {
+ varCount++;
+ }
+ TclDecrRefCount(leadingWord);
}
/*
- * Check for options; if they're present we'll know for sure because we
- * know we're all constant arguments.
+ * Issue instructions to unset each of the named variables.
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- i = 1;
- if (parsePtr->numWords > 1) {
- Tcl_Obj *leadingWord = Tcl_NewObj();
- const char *bytes;
- int len;
-
- (void) TclWordKnownAtCompileTime(varTokenPtr, leadingWord);
- bytes = Tcl_GetStringFromObj(leadingWord, &len);
- if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
- flags = 0;
- varTokenPtr = TokenAfter(varTokenPtr);
- i++;
- } else if (len == 2 && !strncmp("--", bytes, 2)) {
- varTokenPtr = TokenAfter(varTokenPtr);
- i++;
- }
- TclDecrRefCount(leadingWord);
+ if (haveFlags) {
+ varTokenPtr = TokenAfter(varTokenPtr);
}
-
- for ( ; i<parsePtr->numWords ; i++) {
+ for (i=1+haveFlags ; i<parsePtr->numWords ; i++) {
/*
* Decide if we can use a frame slot for the var/array name or if we
* need to emit code to compute and push the name at runtime. We use a