* generic/tclCompile.c: Revised the new set of expression

        * generic/tclParseExpr.c:       parse error messages.

3 files changed, 89 insertions, 104 deletions

diff --git a/ChangeLog b/ChangeLog
index 12ef5b9..1bb8d13 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2006-08-17  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclCompile.c:		Revised the new set of expression
+	* generic/tclParseExpr.c:	parse error messages.
+
 2006-08-16  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclParseExpr.c:	Replace PrecedenceOf() function
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a24571b..56aa708 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.94 2006/08/10 12:15:31 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.95 2006/08/17 17:43:38 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1604,6 +1604,7 @@ TclCompileExprWords(
 	if (TclCompileExpr(interp, script, numBytes, envPtr) == TCL_OK) {
 	    return;
 	}
+	Tcl_ResetResult(interp);
 	envPtr->numCommands = savedNumCmds;
 	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
     }
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index dc277b6..199a9cf 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.36 2006/08/16 17:56:30 dgp Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.37 2006/08/17 17:43:38 dgp Exp $
  */
 
 #define OLD_EXPR_PARSER 0
@@ -2102,10 +2102,10 @@ Tcl_ParseExpr(
     int nodesAvailable = NUM_STATIC_NODES;
     int nodesUsed = 0;
     Tcl_Parse scratch;		/* Parsing scratch space */
-    Tcl_Obj *msg = NULL;
+    Tcl_Obj *msg = NULL, *post = NULL;
     unsigned char precedence;
-    CONST char *space, *operand, *end;
-    int scanned = 0, size, limit = 25, code = TCL_OK;
+    CONST char *space, *operand, *end, *mark = "_@_";
+    int scanned = 0, size, limit = 25, code = TCL_OK, insertMark = 0;
     static unsigned char prec[80] = {
 	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,
 	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,
@@ -2184,16 +2184,16 @@ Tcl_ParseExpr(
 	    switch (nodePtr->lexeme) {
 	    case INVALID:
 		msg = Tcl_NewObj();
-		TclObjPrintf(NULL, msg,
-			"invalid character \"%.*s\" in expression",
-			scanned, start);
+		TclObjPrintf(NULL, msg, "invalid character \"%.*s%s\"",
+			(scanned < limit) ? scanned : limit - 3, start,
+			(scanned < limit) ? "" : "...");
 		code = TCL_ERROR;
 		continue;
 	    case INCOMPLETE:
 		msg = Tcl_NewObj();
-		TclObjPrintf(NULL, msg,
-			"incomplete operator \"%.*s\" in expression",
-			scanned, start);
+		TclObjPrintf(NULL, msg, "incomplete operator \"%.*s%s\"",
+			(scanned < limit) ? scanned : limit - 3, start,
+			(scanned < limit) ? "" : "...");
 		code = TCL_ERROR;
 		continue;
 	    case BAREWORD:
@@ -2209,13 +2209,19 @@ Tcl_ParseExpr(
 			nodePtr->lexeme = BOOLEAN;
 		    } else {
 			msg = Tcl_NewObj();
-			TclObjPrintf(NULL, msg,
-				"invalid bareword \"%.*s\" in expression",
-				scanned, start);
-			Tcl_AppendToObj(msg,
-				"\n    (prepend $ for variable; ", -1);
-			Tcl_AppendToObj(msg,
-				"append argument list for function call)", -1);
+			TclObjPrintf(NULL, msg, "invalid bareword \"%.*s%s\"",
+				(scanned < limit) ? scanned : limit - 3, start,
+				(scanned < limit) ? "" : "...");
+			post = Tcl_NewObj();
+			TclObjPrintf(NULL, post,
+				"should be \"$%.*s%s\" or \"{%.*s%s}\"",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...");
+			TclObjPrintf(NULL, post, " or \"%.*s%s(...)\" ?",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...");
 			continue;
 		    }
 		}
@@ -2236,37 +2242,14 @@ Tcl_ParseExpr(
 	case LEAF:
 
 	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
-		msg = Tcl_NewStringObj("missing operator ", -1);
-		while (lastNodePtr->parent >= 0) {
-		    lastNodePtr = nodes + lastNodePtr->parent;
-		}
-		while (lastNodePtr->left >= 0) {
-		    lastNodePtr = nodes + lastNodePtr->left;
-		}
+		msg = Tcl_NewObj();
+		TclObjPrintf(NULL, msg, "missing operator at %s", mark);
+		scanned = 0;
+		insertMark = 1;
 		operand = scratch.tokenPtr[lastNodePtr->token].start;
-		size = space - operand;
-		switch (nodePtr->lexeme) {
-		case NUMBER:
-		case BOOLEAN:
-		    TclObjPrintf(NULL, msg,
-			    "between operands \"%s%.*s\" and \"%.*s%s\"",
-			    (size < limit) ? "" : "...",
-			    (size < limit) ? size : limit - 3,
-			    (size < limit) ? operand : operand+size+3-limit,
-			    (scanned < limit) ? scanned : limit - 3,
-			    (scanned < limit) ? start : start+scanned+3-limit,
-			    (scanned < limit) ? "" : "...");
-		    if ((operand[0] == '0')
-			    && TclCheckBadOctal(NULL, operand)) {
-			Tcl_AppendToObj(msg,
-			        "\n    (looks like invalid octal number)", -1);
-		    }
-		    break;
-		default:
-		    TclObjPrintf(NULL, msg, "following operand \"%s%.*s\"",
-			    (size < limit) ? "" : "...",
-			    (size < limit) ? size : limit - 3,
-			    (size < limit) ? operand : operand+size+3-limit);
+		if ((operand[0] == '0') && TclCheckBadOctal(NULL, operand)) {
+		    post = Tcl_NewStringObj(
+			    "looks like invalid octal number", -1);
 		}
 		code = TCL_ERROR;
 		continue;
@@ -2322,8 +2305,7 @@ Tcl_ParseExpr(
 		}
 		tokenPtr = scratch.tokenPtr + nodePtr->token + 1;
 		if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
-		    msg = Tcl_NewStringObj(
-			    "invalid character \"$\" in expression", -1);
+		    msg = Tcl_NewStringObj("invalid character \"$\"", -1);
 		    code = TCL_ERROR;
 		    continue;
 		}
@@ -2391,19 +2373,9 @@ Tcl_ParseExpr(
 	case UNARY:
 	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
 		msg = Tcl_NewObj();
-		while (lastNodePtr->parent >= 0) {
-		    lastNodePtr = nodes + lastNodePtr->parent;
-		}
-		while (lastNodePtr->left >= 0) {
-		    lastNodePtr = nodes + lastNodePtr->left;
-		}
-		operand = scratch.tokenPtr[lastNodePtr->token].start;
-		size = space - operand;
-		TclObjPrintf(NULL, msg,
-			"missing operator following operand \"%s%.*s\"",
-			(size < limit) ? "" : "...",
-			(size < limit) ? size : limit - 3,
-			(size < limit) ? operand : operand+size+3-limit);
+		TclObjPrintf(NULL, msg, "missing operator at %s", mark);
+		scanned = 0;
+		insertMark = 1;
 		code = TCL_ERROR;
 		continue;
 	    }
@@ -2446,7 +2418,10 @@ Tcl_ParseExpr(
 		    break;
 
 		}
-		msg = Tcl_NewStringObj("empty subexpression", -1);
+		msg = Tcl_NewObj();
+		TclObjPrintf(NULL, msg, "empty subexpression at %s", mark);
+		scanned = 0;
+		insertMark = 1;
 		code = TCL_ERROR;
 		continue;
 	    }
@@ -2454,7 +2429,6 @@ Tcl_ParseExpr(
 	    precedence = prec[nodePtr->lexeme];
 
 	    if ((NODE_TYPE & lastNodePtr->lexeme) != LEAF) {
-		msg = Tcl_NewObj();
 		if (prec[lastNodePtr->lexeme] > precedence) {
 		    if (lastNodePtr->lexeme == OPEN_PAREN) {
 			lastOrphanPtr = lastNodePtr;
@@ -2463,7 +2437,11 @@ Tcl_ParseExpr(
 			continue;
 		    }
 		    if (lastNodePtr->lexeme == COMMA) {
-			msg = Tcl_NewStringObj("missing function argument", -1);
+			msg = Tcl_NewObj();
+			TclObjPrintf(NULL, msg,
+				"missing function argument at %s", mark);
+			scanned = 0;
+			insertMark = 1;
 			code = TCL_ERROR;
 			continue;
 		    }
@@ -2472,18 +2450,20 @@ Tcl_ParseExpr(
 			code = TCL_ERROR;
 			continue;
 		    }
+		    msg = Tcl_NewObj();
 		    operand = scratch.tokenPtr[lastNodePtr->token].start;
 		    size = space - operand;
-		    TclObjPrintf(NULL, msg,
-			"missing right operand following operator \"%.*s\"",
-			size, operand);
+		    TclObjPrintf(NULL, msg, "missing operand at %s", mark);
+		    scanned = 0;
+		    insertMark = 1;
 		} else {
 		    if (nodePtr->lexeme == CLOSE_PAREN) {
 			msg = Tcl_NewStringObj("unbalanced close paren", -1);
 		    } else {
-			TclObjPrintf(NULL, msg,
-				"missing left operand before operator \"%.*s\"",
-				scanned, start);
+			msg = Tcl_NewObj();
+			TclObjPrintf(NULL, msg, "missing operand at %s", mark);
+			scanned = 0;
+			insertMark = 1;
 		    }
 		}
 		code = TCL_ERROR;
@@ -2523,9 +2503,11 @@ Tcl_ParseExpr(
 		}
 		if ((otherPtr->lexeme == QUESTION)
 			&& (lastOrphanPtr->lexeme != COLON)) {
-		    msg = Tcl_NewStringObj(
-			    "missing operator \":\" in ternary conditional",
-			    -1);
+		    msg = Tcl_NewObj();
+		    TclObjPrintf(NULL, msg,
+			    "missing operator \":\" at %s", mark);
+		    scanned = 0;
+		    insertMark = 1;
 		    code = TCL_ERROR;
 		    break;
 		}
@@ -2625,40 +2607,37 @@ Tcl_ParseExpr(
 		Tcl_DecrRefCount(msg);
 	    }
 	} else {
-	    CONST char *subexpr = NULL;
 	    if (msg == NULL) {
 		msg = Tcl_GetObjResult(interp);
 	    }
-	    while (lastOrphanPtr != nodes) {
-		if (lastOrphanPtr->lexeme == OPEN_PAREN) {
-		    subexpr = scratch.tokenPtr[lastOrphanPtr->token].start;
-		    lastOrphanPtr--;
-		} else {
-		    precedence = prec[lastOrphanPtr->lexeme];
-		    while (lastOrphanPtr->left >= 0) {
-			lastOrphanPtr = nodes + lastOrphanPtr->left;
-		    }
-		    subexpr = scratch.tokenPtr[lastOrphanPtr->token].start;
-		    lastOrphanPtr--;
-		    if (prec[lastOrphanPtr->lexeme] >= precedence) {
-			continue;
-		    }
-		}
-		size = start + scanned - subexpr;
-		if ((subexpr > scratch.string)
-			|| ((start + scanned < scratch.end)
-			&& (size < limit))) {
-		    TclObjPrintf(NULL, msg,
-			    "\n    (parsing subexpression \"%.*s%s\")",
-			    (size < limit) ? size : limit - 3, subexpr,
-			    (size < limit) ? "" : "...");
-		}
+	    TclObjPrintf(NULL, msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
+		    ((start - limit) < scratch.string) ? "" : "...",
+		    ((start - limit) < scratch.string)
+		    ? (start - scratch.string)
+		    : (start - Tcl_UtfPrev(start-limit, scratch.string)),
+		    ((start - limit) < scratch.string) 
+		    ? scratch.string
+		    : Tcl_UtfPrev(start-limit, scratch.string),
+		    (scanned < limit) ? scanned : limit - 3, start,
+		    (scanned < limit) ? "" : "...",
+		    insertMark ? mark : "",
+		    (start + scanned + limit > scratch.end)
+		    ? scratch.end - (start + scanned)
+		    : Tcl_UtfPrev(start+scanned+limit, start+scanned)
+		    - (start + scanned), start + scanned,
+		    (start + scanned + limit > scratch.end) ? "" : "..."
+		    );
+	    if (post != NULL) {
+		Tcl_AppendToObj(msg, ";\n", -1);
+		Tcl_AppendObjToObj(msg, post);
+		Tcl_DecrRefCount(post);
 	    }
-	    numBytes = scratch.end - scratch.string;
-	    TclObjPrintf(NULL, msg, "\n    (parsing expression \"%.*s%s\")",
-		    (numBytes < limit) ? numBytes : limit - 3, scratch.string,
-		    (numBytes < limit) ? "" : "...");
 	    Tcl_SetObjResult(interp, msg);
+	    numBytes = scratch.end - scratch.string;
+	    TclFormatToErrorInfo(interp,
+		    "\n    (parsing expression \"%.*s%s\")",
+		    (numBytes < limit) ? numBytes : limit - 3,
+		    scratch.string, (numBytes < limit) ? "" : "...");
 	}
     }