* generic/tclCompExpr.c: Factored out, corrected, and commented

        common code for reporting syntax errors in LEAF elements.

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;