summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
authorstanton <stanton>1998-06-18 18:24:29 (GMT)
committerstanton <stanton>1998-06-18 18:24:29 (GMT)
commitb0f1b14712284a529378c8c977380cccd020b0f5 (patch)
tree93bf66b281dad75b3aa2373a16db7aff9f592e9e /generic/tclCompile.c
parent7e4ff74f9ec9abae9982ca4edd8bd536ea1f5d56 (diff)
downloadtcl-b0f1b14712284a529378c8c977380cccd020b0f5.zip
tcl-b0f1b14712284a529378c8c977380cccd020b0f5.tar.gz
tcl-b0f1b14712284a529378c8c977380cccd020b0f5.tar.bz2
added fix for foreach compile proc so it handles non-local names correctly
fixed compile procs so they no longer corrupt the exception stack don't inline expressions when it is unsafe to do so
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c81
1 files changed, 51 insertions, 30 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d4aeb13..e040bc8 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -4009,7 +4009,7 @@ TclCompileForCmd(interp, string, lastChar, flags, envPtr)
* to execute cmd. */
ArgInfo argInfo; /* Structure holding information about the
* start and end of each argument word. */
- int range1, range2; /* Indexes in the ExceptionRange array of
+ int range1 = -1, range2; /* Indexes in the ExceptionRange array of
* the loop ranges for this loop: one for
* its body and one for its "next" cmd. */
JumpFixup jumpFalseFixup; /* Used to update or replace the ifFalse
@@ -4040,17 +4040,20 @@ TclCompileForCmd(interp, string, lastChar, flags, envPtr)
}
/*
- * If the test expression is enclosed in quotes (""s), don't compile
+ * If the test expression is not enclosed in braces, don't compile
* the for inline. As a result of Tcl's two level substitution
* semantics for expressions, the expression might have a constant
* value that results in the loop never executing, or executing forever.
* Consider "set x 0; for {} "$x > 5" {incr x} {}": the loop body
* should never be executed.
+ * NOTE: This is an overly aggressive test, since there are legitimate
+ * literals that could be compiled but aren't in braces. However, until
+ * the parser is integrated in 8.1, this is the simplest implementation.
*/
- if (*(argInfo.startArray[1]) == '"') {
+ if (*(argInfo.startArray[1]) != '{') {
result = TCL_OUT_LINE_COMPILE;
- goto done;
+ goto done;
}
/*
@@ -4242,7 +4245,9 @@ TclCompileForCmd(interp, string, lastChar, flags, envPtr)
}
envPtr->pushSimpleWords = savePushSimpleWords;
envPtr->maxStackDepth = maxDepth;
- envPtr->excRangeDepth--;
+ if (range1 != -1) {
+ envPtr->excRangeDepth--;
+ }
FreeArgInfo(&argInfo);
return result;
}
@@ -4294,7 +4299,7 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
ArgInfo argInfo; /* Structure holding information about the
* start and end of each argument word. */
int numLists = 0; /* Count of variable (and value) lists. */
- int range; /* Index in the ExceptionRange array of the
+ int range = -1; /* Index in the ExceptionRange array of the
* ExceptionRange record for this loop. */
ForeachInfo *infoPtr; /* Points to the structure describing this
* foreach command. Stored in a AuxData
@@ -4418,7 +4423,7 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
/*
* Check that each variable name has no substitutions and that
- * it is a scalar name.
+ * it is a local scalar name.
*/
numVars = varcList[i];
@@ -4430,6 +4435,11 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
result = TCL_OUT_LINE_COMPILE;
goto done;
}
+ if ((*p == ':') && (*(p+1) == ':')) { /* non-local name */
+ result = TCL_OUT_LINE_COMPILE;
+ goto done;
+ }
+
if (*p == '(') {
char *q = p;
do {
@@ -4666,7 +4676,9 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
envPtr->termOffset = (argInfo.endArray[numWords-1] + 1 - string);
envPtr->pushSimpleWords = savePushSimpleWords;
envPtr->maxStackDepth = maxDepth;
- envPtr->excRangeDepth--;
+ if (range != -1) {
+ envPtr->excRangeDepth--;
+ }
FreeArgInfo(&argInfo);
return result;
}
@@ -5847,7 +5859,7 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
register int type; /* Current char's CHAR_TYPE type. */
int maxDepth = 0; /* Maximum number of stack elements needed
* to execute cmd. */
- int range; /* Index in the ExceptionRange array of the
+ int range = -1; /* Index in the ExceptionRange array of the
* ExceptionRange record for this loop. */
JumpFixup jumpFalseFixup; /* Used to update or replace the ifFalse
* jump after test when its target PC is
@@ -5856,18 +5868,6 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
int jumpDist, jumpBackDist, jumpBackOffset, objIndex, result;
int savePushSimpleWords = envPtr->pushSimpleWords;
- envPtr->excRangeDepth++;
- envPtr->maxExcRangeDepth =
- TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
-
- /*
- * Create and initialize a ExceptionRange record to hold information
- * about this loop. This is used to implement break and continue.
- */
-
- range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
- envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
-
AdvanceToNextWord(src, envPtr);
src += envPtr->termOffset;
type = CHAR_TYPE(src, lastChar);
@@ -5881,20 +5881,35 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
}
/*
- * If the test expression is enclosed in quotes (""s), don't compile
+ * If the test expression is not enclosed in braces, don't compile
* the while inline. As a result of Tcl's two level substitution
* semantics for expressions, the expression might have a constant
* value that results in the loop never executing, or executing forever.
- * Consider "set x 0; while "$x < 5" {incr x}": the loop body should
- * never be executed.
+ * Consider "set x 0; whie "$x > 5" {incr x}": the loop body
+ * should never be executed.
+ * NOTE: This is an overly aggressive test, since there are legitimate
+ * literals that could be compiled but aren't in braces. However, until
+ * the parser is integrated in 8.1, this is the simplest implementation.
*/
- if (*src == '"') {
+ if (*src != '{') {
result = TCL_OUT_LINE_COMPILE;
- goto done;
+ goto done;
}
/*
+ * Create and initialize a ExceptionRange record to hold information
+ * about this loop. This is used to implement break and continue.
+ */
+
+ envPtr->excRangeDepth++;
+ envPtr->maxExcRangeDepth =
+ TclMax(envPtr->excRangeDepth, envPtr->maxExcRangeDepth);
+
+ range = CreateExceptionRange(LOOP_EXCEPTION_RANGE, envPtr);
+ envPtr->excRangeArrayPtr[range].continueOffset = TclCurrCodeOffset();
+
+ /*
* Compile the next word: the test expression.
*/
@@ -5902,7 +5917,8 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
result = CompileExprWord(interp, src, lastChar, flags, envPtr);
if (result != TCL_OK) {
if (result == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp, "\n (\"while\" test expression)", -1);
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"while\" test expression)", -1);
}
goto done;
}
@@ -6038,7 +6054,9 @@ TclCompileWhileCmd(interp, string, lastChar, flags, envPtr)
envPtr->termOffset = (src - string);
envPtr->pushSimpleWords = savePushSimpleWords;
envPtr->maxStackDepth = maxDepth;
- envPtr->excRangeDepth--;
+ if (range != -1) {
+ envPtr->excRangeDepth--;
+ }
return result;
}
@@ -6095,7 +6113,7 @@ CompileExprWord(interp, string, lastChar, flags, envPtr)
int range = -1; /* If we inline compile an un-{}'d
* expression, the index for its catch range
* record in the ExceptionRange array.
- * Initialized to avoid compile warning. */
+ * Initialized to enable proper cleanup. */
JumpFixup jumpFixup; /* Used to emit the "success" jump after
* the inline expression code. */
char *p;
@@ -6295,6 +6313,9 @@ CompileExprWord(interp, string, lastChar, flags, envPtr)
} /* if expression isn't in {}s */
done:
+ if (range != -1) {
+ envPtr->excRangeDepth--;
+ }
envPtr->termOffset = (src - string);
envPtr->maxStackDepth = maxDepth;
envPtr->pushSimpleWords = savePushSimpleWords;
@@ -7309,7 +7330,7 @@ FreeArgInfo(argInfoPtr)
/*
*----------------------------------------------------------------------
*
- * CreateLoopExceptionRange --
+ * CreateExceptionRange --
*
* Procedure that allocates and initializes a new ExceptionRange
* structure of the specified kind in a CompileEnv's ExceptionRange