diff options
author | dgp <dgp@users.sourceforge.net> | 2007-07-12 18:48:09 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2007-07-12 18:48:09 (GMT) |
commit | 38001ef18f91865e3e510aa9e641e81e664413e8 (patch) | |
tree | 690ab1478c51dccdd6f3353de4a0c7497f3fd695 /generic/tclCompExpr.c | |
parent | 95089adb47fee26e3c41c8d88e3dfd356d48dcc2 (diff) | |
download | tcl-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.
Diffstat (limited to 'generic/tclCompExpr.c')
-rw-r--r-- | generic/tclCompExpr.c | 87 |
1 files changed, 43 insertions, 44 deletions
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; |