summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-07-12 18:48:09 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-07-12 18:48:09 (GMT)
commit38001ef18f91865e3e510aa9e641e81e664413e8 (patch)
tree690ab1478c51dccdd6f3353de4a0c7497f3fd695
parent95089adb47fee26e3c41c8d88e3dfd356d48dcc2 (diff)
downloadtcl-38001ef18f91865e3e510aa9e641e81e664413e8.zip
tcl-38001ef18f91865e3e510aa9e641e81e664413e8.tar.gz
tcl-38001ef18f91865e3e510aa9e641e81e664413e8.tar.bz2
* generic/tclCompExpr.c: Factored out, corrected, and commented
common code for reporting syntax errors in LEAF elements.
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclCompExpr.c87
2 files changed, 48 insertions, 44 deletions
diff --git a/ChangeLog b/ChangeLog
index 0e39af7..9e8012b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2007-07-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompExpr.c: Factored out, corrected, and commented
+ common code for reporting syntax errors in LEAF elements.
+
2007-07-11 Miguel Sofer <msofer@users.sf.net>
* generic/tclCompCmds.c (TclCompileWhileCmd):
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 63b8216..f8277d4 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompExpr.c,v 1.66 2007/07/11 14:43:47 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.67 2007/07/12 18:48:10 dgp Exp $
*/
#include "tclInt.h"
@@ -352,7 +352,6 @@ static const unsigned char prec[] = {
PREC_OPEN_PAREN, /* OPEN_PAREN */
PREC_UNARY, /* NOT*/
PREC_UNARY, /* BIT_NOT*/
- 0, 0, 0, 0, 0, 0, 0, 0,
};
/*
@@ -656,24 +655,14 @@ ParseExpr(
case LEAF: {
Tcl_Token *tokenPtr;
- const char *end;
+ const char *end = start;
int wordIndex;
/*
- * Store away any literals on the list now, so they'll
- * be available for our caller to free if we error out
- * of this routine. [Bug 1705778, leak K23]
+ * A leaf operand appearing just after something that's not an
+ * operator is a syntax error.
*/
- switch (lexeme) {
- case NUMBER:
- case BOOLEAN:
- Tcl_ListObjAppendElement(NULL, litList, literal);
- break;
- default:
- break;
- }
-
if (NotOperator(lastParsed)) {
msg = Tcl_ObjPrintf("missing operator at %s", mark);
if (lastStart[0] == '0') {
@@ -689,12 +678,17 @@ ParseExpr(
insertMark = 1;
parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
code = TCL_ERROR;
- continue;
+ /*
+ * Delay our escape from the parse loop until any literal
+ * can be appended to litList, making it available to our
+ * caller to be freed, to avoid leaking it.
+ */
}
switch (lexeme) {
case NUMBER:
case BOOLEAN:
+ Tcl_ListObjAppendElement(NULL, litList, literal);
lastParsed = OT_LITERAL;
start += scanned;
numBytes -= scanned;
@@ -703,6 +697,11 @@ ParseExpr(
break;
}
+ if (code != TCL_OK) {
+ /* Escaping the loop due to syntax error is fine now. */
+ continue;
+ }
+
/*
* Remaining LEAF cases may involve filling Tcl_Tokens, so
* make room for at least 2 more tokens.
@@ -721,38 +720,25 @@ ParseExpr(
case QUOTED:
code = Tcl_ParseQuotedString(interp, start, numBytes,
parsePtr, 1, &end);
- if (code != TCL_OK) {
- /* TODO: This adjustment of scanned is untested and
- * and uncommented. Correct that. Its only possible
- * purpose is to influence the error message. */
- scanned = parsePtr->term - start;
- scanned += (scanned < numBytes);
- continue;
- }
scanned = end - start;
break;
case BRACED:
code = Tcl_ParseBraces(interp, start, numBytes,
parsePtr, 1, &end);
- if (code != TCL_OK) {
- continue;
- }
scanned = end - start;
break;
case VARIABLE:
code = Tcl_ParseVarName(interp, start, numBytes, parsePtr, 1);
- if (code != TCL_OK) {
- /* TODO: This adjustment of scanned is untested and
- * and uncommented. Correct that. Its only possible
- * purpose is to influence the error message. */
- scanned = parsePtr->term - start;
- scanned += (scanned < numBytes);
- continue;
- }
+
+ /*
+ * Handle the quirk that Tcl_ParseVarName reports a successful
+ * parse even when it gets only a "$" with no variable name.
+ */
+
tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
- if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
+ if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) {
TclNewLiteralStringObj(msg, "invalid character \"$\"");
code = TCL_ERROR;
continue;
@@ -799,20 +785,33 @@ ParseExpr(
TclStackFree(interp, nestedPtr);
end = start;
start = tokenPtr->start;
- if (code != TCL_OK) {
- /* TODO: This adjustment of scanned is untested and
- * and uncommented. Correct that. Its only possible
- * purpose is to influence the error message. */
- scanned = parsePtr->term - start;
- scanned += (scanned < numBytes);
- continue;
- }
scanned = end - start;
tokenPtr->size = scanned;
parsePtr->numTokens++;
break;
}
}
+ if (code != TCL_OK) {
+ /*
+ * Here we handle all the syntax errors generated by
+ * the Tcl_Token generating parsing routines called in the
+ * switch just above. If the value of parsePtr->incomplete
+ * is 1, then the error was an unbalanced '[', '(', '{',
+ * or '"' and parsePtr->term is pointing to that unbalanced
+ * character. If the value of parsePtr->incomplete is 0,
+ * then the error is one of lacking whitespace following a
+ * quoted word, for example: expr {[an error {foo}bar]},
+ * and parsePtr->term points to where the whitespace is
+ * missing. We reset our values of start and scanned so that
+ * when our error message is constructed, the location of
+ * the syntax error is sure to appear in it, even if the
+ * quoted expression is truncated.
+ */
+ start = parsePtr->term;
+ scanned = parsePtr->incomplete;
+ /* Escape the parse loop to report the syntax error. */
+ continue;
+ }
tokenPtr = parsePtr->tokenPtr + wordIndex;
tokenPtr->size = scanned;