* generic/tclParseExpr.c: Minimal collection of new tests

        * tests/parseExpr.test:         testing the error messages of the
        new expr parser.  Several bug fixes and code simplifications that
        appeared during that effort.

3 files changed, 221 insertions, 44 deletions

diff --git a/ChangeLog b/ChangeLog
index 852611e..405e981 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2006-08-23  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclParseExpr.c:	Minimal collection of new tests
+	* tests/parseExpr.test:		testing the error messages of the
+	new expr parser.  Several bug fixes and code simplifications that
+	appeared during that effort.
+
 2006-08-21  Don Porter  <dgp@users.sourceforge.net>
 
         * generic/tclIOUtil.c:  Revisions to complete the thread finalization
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index 2f6589d..9560630 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.38 2006/08/21 17:15:21 dgp Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.39 2006/08/23 21:31:55 dgp Exp $
  */
 
 #define OLD_EXPR_PARSER 0
@@ -2104,8 +2104,9 @@ Tcl_ParseExpr(
     Tcl_Parse scratch;		/* Parsing scratch space */
     Tcl_Obj *msg = NULL, *post = NULL;
     unsigned char precedence;
-    CONST char *space, *operand, *end, *mark = "_@_";
-    int scanned = 0, size, limit = 25, code = TCL_OK, insertMark = 0;
+    CONST char *end, *mark = "_@_";
+    int scanned = 0, code = TCL_OK, insertMark = 0;
+    CONST int limit = 25;
     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,
@@ -2141,9 +2142,9 @@ Tcl_ParseExpr(
 	 */
 	if (nodesUsed >= nodesAvailable) {
 	    int lastOrphanIdx = lastOrphanPtr - nodes;
+	    int size = nodesUsed * 2;
 	    ExprNode *newPtr;
 
-	    size = nodesUsed * 2;
 	    if (nodes == staticNodes) {
 		nodes = NULL;
 	    }
@@ -2171,7 +2172,6 @@ Tcl_ParseExpr(
 
 	/* Skip white space between lexemes */
 
-	space = start;		/* Remember where last lexeme ended */
 	scanned = TclParseAllWhiteSpace(start, numBytes);
 	start += scanned;
 	numBytes -= scanned;
@@ -2184,16 +2184,14 @@ Tcl_ParseExpr(
 	    switch (nodePtr->lexeme) {
 	    case INVALID:
 		msg = Tcl_NewObj();
-		TclObjPrintf(NULL, msg, "invalid character \"%.*s%s\"",
-			(scanned < limit) ? scanned : limit - 3, start,
-			(scanned < limit) ? "" : "...");
+		TclObjPrintf(NULL, msg,
+			"invalid character \"%.*s\"", scanned, start);
 		code = TCL_ERROR;
 		continue;
 	    case INCOMPLETE:
 		msg = Tcl_NewObj();
-		TclObjPrintf(NULL, msg, "incomplete operator \"%.*s%s\"",
-			(scanned < limit) ? scanned : limit - 3, start,
-			(scanned < limit) ? "" : "...");
+		TclObjPrintf(NULL, msg,
+			"incomplete operator \"%.*s\"", scanned, start);
 		code = TCL_ERROR;
 		continue;
 	    case BAREWORD:
@@ -2242,9 +2240,11 @@ Tcl_ParseExpr(
 	case LEAF:
 
 	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
+		CONST char *operand =
+			scratch.tokenPtr[lastNodePtr->token].start;
+
 		msg = Tcl_NewObj();
 		TclObjPrintf(NULL, msg, "missing operator at %s", mark);
-		operand = scratch.tokenPtr[lastNodePtr->token].start;
 		if (operand[0] == '0') {
 		    Tcl_Obj *copy = Tcl_NewStringObj(operand,
 			    start + scanned - operand);
@@ -2436,41 +2436,35 @@ Tcl_ParseExpr(
 	    if ((NODE_TYPE & lastNodePtr->lexeme) != LEAF) {
 		if (prec[lastNodePtr->lexeme] > precedence) {
 		    if (lastNodePtr->lexeme == OPEN_PAREN) {
-			lastOrphanPtr = lastNodePtr;
 			msg = Tcl_NewStringObj("unbalanced open paren", -1);
-			code = TCL_ERROR;
-			continue;
-		    }
-		    if (lastNodePtr->lexeme == COMMA) {
+		    } else if (lastNodePtr->lexeme == COMMA) {
 			msg = Tcl_NewObj();
 			TclObjPrintf(NULL, msg,
 				"missing function argument at %s", mark);
 			scanned = 0;
 			insertMark = 1;
-			code = TCL_ERROR;
-			continue;
-		    }
-		    if (lastNodePtr->lexeme == START) {
+		    } else if (lastNodePtr->lexeme == START) {
 			msg = Tcl_NewStringObj("empty expression", -1);
-			code = TCL_ERROR;
-			continue;
 		    }
-		    msg = Tcl_NewObj();
-		    operand = scratch.tokenPtr[lastNodePtr->token].start;
-		    size = space - 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 {
+		    } else if ((nodePtr->lexeme == COMMA)
+			    && (lastNodePtr->lexeme == OPEN_PAREN)
+			    && (lastNodePtr[-1].lexeme == FUNCTION)) {
 			msg = Tcl_NewObj();
-			TclObjPrintf(NULL, msg, "missing operand at %s", mark);
+			TclObjPrintf(NULL, msg,
+				"missing function argument at %s", mark);
 			scanned = 0;
 			insertMark = 1;
 		    }
 		}
+		if (msg == NULL) {
+		    msg = Tcl_NewObj();
+		    TclObjPrintf(NULL, msg, "missing operand at %s", mark);
+		    scanned = 0;
+		    insertMark = 1;
+		}
 		code = TCL_ERROR;
 		continue;
 	    }
@@ -2524,15 +2518,6 @@ Tcl_ParseExpr(
 		    code = TCL_ERROR;
 		    break;
 		}
-		if ((lastOrphanPtr->lexeme == COMMA)
-			&& ((otherPtr->lexeme != OPEN_PAREN)
-			|| (otherPtr[-1].lexeme != FUNCTION)) ) {
-		    msg = Tcl_NewStringObj(
-			    "unexpected \",\" outside function argument list",
-			    -1);
-		    code = TCL_ERROR;
-		    break;
-		}
 
 		/* Link orphan as right operand of otherPtr */
 		otherPtr->right = lastOrphanPtr - nodes;
@@ -2564,6 +2549,14 @@ Tcl_ParseExpr(
 		break;
 	    }
 
+	    if ((nodePtr->lexeme == COMMA) && ((otherPtr->lexeme != OPEN_PAREN)
+		    || (otherPtr[-1].lexeme != FUNCTION))) {
+		msg = Tcl_NewStringObj(
+			"unexpected \",\" outside function argument list", -1);
+		code = TCL_ERROR;
+		continue;
+	    }
+
 	    if (lastOrphanPtr->lexeme == COLON) {
 		msg = Tcl_NewStringObj(
 			"unexpected operator \":\" without preceding \"?\"",
@@ -2619,16 +2612,16 @@ Tcl_ParseExpr(
 		    ((start - limit) < scratch.string) ? "" : "...",
 		    ((start - limit) < scratch.string)
 		    ? (start - scratch.string)
-		    : (start - Tcl_UtfPrev(start-limit, scratch.string)),
+		    : (start - Tcl_UtfPrev(start+1-limit+3, scratch.string)),
 		    ((start - limit) < scratch.string) 
 		    ? scratch.string
-		    : Tcl_UtfPrev(start-limit, scratch.string),
+		    : Tcl_UtfPrev(start+1-limit+3, 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)
+		    : Tcl_UtfPrev(start+scanned+limit-3+1, start+scanned)
 		    - (start + scanned), start + scanned,
 		    (start + scanned + limit > scratch.end) ? "" : "..."
 		    );
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index 3336203..d2261bf 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: parseExpr.test,v 1.24 2006/08/22 04:03:24 dgp Exp $
+# RCS: @(#) $Id: parseExpr.test,v 1.25 2006/08/23 21:31:55 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -735,6 +735,183 @@ test parseExpr-20.3 {Bug 1451233} {
     expr 10000000000000000000020000000002
 } 10000000000000000000020000000002
 
+test parseExpr-21.1 {error messages} -body {
+    expr @
+} -returnCodes error -result {invalid character "@"
+in expression "@"}
+test parseExpr-21.2 {error messages} -body {
+    expr =
+} -returnCodes error -result {incomplete operator "="
+in expression "="}
+test parseExpr-21.3 {error messages} -body {
+    expr x
+} -returnCodes error -result {invalid bareword "x"
+in expression "x";
+should be "$x" or "{x}" or "x(...)" or ...}
+test parseExpr-21.4 {error messages} -body {
+    expr abcdefghijklmnopqrstuvwxyz
+} -returnCodes error -result {invalid bareword "abcdefghijklmnopqrstuv..."
+in expression "abcdefghijklmnopqrstuv...";
+should be "$abcdefghijklmnopqrstuv..." or "{abcdefghijklmnopqrstuv...}" or "abcdefghijklmnopqrstuv...(...)" or ...}
+test parseExpr-21.5 {error messages} -body {
+    expr {[][]}
+} -returnCodes error -result {missing operator at _@_
+in expression "[]_@_[]"}
+test parseExpr-21.6 {error messages} -body {
+    expr {0 0}
+} -returnCodes error -result {missing operator at _@_
+in expression "0 _@_0"}
+test parseExpr-21.7 {error messages} -body {
+    expr {08}
+} -returnCodes error -result {missing operator at _@_
+in expression "0_@_8";
+looks like invalid octal number}
+test parseExpr-21.8 {error messages} -body {
+    expr {08x}
+} -returnCodes error -result {missing operator at _@_
+in expression "0_@_8x";
+looks like invalid octal number}
+test parseExpr-21.9 {error messages} -body {
+    expr {"} 
+} -returnCodes error -result {missing "
+in expression """}
+test parseExpr-21.10 {error messages} -body {
+    expr \{ 
+} -returnCodes error -result "missing close-brace
+in expression \"\{\""
+test parseExpr-21.11 {error messages} -body {
+    expr $
+} -returnCodes error -result {invalid character "$"
+in expression "$"}
+test parseExpr-21.12 {error messages} -body {
+    expr {$(}
+} -returnCodes error -result {missing )
+in expression "$("}
+test parseExpr-21.13 {error messages} -body {
+    expr {[""x]}
+} -returnCodes error -result {extra characters after close-quote
+in expression "[""x]"}
+test parseExpr-21.14 {error messages} -body {
+    expr {[}
+} -returnCodes error -result {missing close-bracket
+in expression "["}
+test parseExpr-21.15 {error messages} -body {
+    expr 0~0
+} -returnCodes error -result {missing operator at _@_
+in expression "0_@_~0"}
+test parseExpr-21.16 {error messages} -body {
+    expr ()
+} -returnCodes error -result {empty subexpression at _@_
+in expression "(_@_)"}
+test parseExpr-21.17 {error messages} -body {
+    expr (
+} -returnCodes error -result {unbalanced open paren
+in expression "("}
+test parseExpr-21.18 {error messages} -body {
+    expr a(0,)
+} -returnCodes error -result {missing function argument at _@_
+in expression "a(0,_@_)"}
+test parseExpr-21.19 {error messages} -body {
+    expr {}
+} -returnCodes error -result {empty expression
+in expression ""}
+test parseExpr-21.20 {error messages} -body {
+    expr )
+} -returnCodes error -result {unbalanced close paren
+in expression ")"}
+test parseExpr-21.21 {error messages} -body {
+    expr a(,0)
+} -returnCodes error -result {missing function argument at _@_
+in expression "a(_@_,0)"}
+test parseExpr-21.22 {error messages} -body {
+    expr 0&|0
+} -returnCodes error -result {missing operand at _@_
+in expression "0&_@_|0"}
+test parseExpr-21.23 {error messages} -body {
+    expr 0^^0
+} -returnCodes error -result {missing operand at _@_
+in expression "0^_@_^0"}
+test parseExpr-21.24 {error messages} -body {
+    expr 0|&0
+} -returnCodes error -result {missing operand at _@_
+in expression "0|_@_&0"}
+test parseExpr-21.25 {error messages} -body {
+    expr a(1+,0)
+} -returnCodes error -result {missing operand at _@_
+in expression "a(1+_@_,0)"}
+test parseExpr-21.26 {error messages} -body {
+    expr (0
+} -returnCodes error -result {unbalanced open paren
+in expression "(0"}
+test parseExpr-21.27 {error messages} -body {
+    expr 0?0
+} -returnCodes error -result {missing operator ":" at _@_
+in expression "0?0_@_"}
+test parseExpr-21.28 {error messages} -body {
+    expr 0:0
+} -returnCodes error -result {unexpected operator ":" without preceding "?"
+in expression "0:0"}
+test parseExpr-21.29 {error messages} -body {
+    expr 0)
+} -returnCodes error -result {unbalanced close paren
+in expression "0)"}
+test parseExpr-21.30 {error messages} -body {
+    expr 0,
+} -returnCodes error -result {unexpected "," outside function argument list
+in expression "0,"}
+test parseExpr-21.31 {error messages} -body {
+    expr 0,0
+} -returnCodes error -result {unexpected "," outside function argument list
+in expression "0,0"}
+test parseExpr-21.32 {error messages} -body {
+    expr (0,0)
+} -returnCodes error -result {unexpected "," outside function argument list
+in expression "(0,0)"}
+test parseExpr-21.33 {error messages} -body {
+    expr a(0:0,0)
+} -returnCodes error -result {unexpected operator ":" without preceding "?"
+in expression "a(0:0,0)"}
+test parseExpr-21.34 {error messages} -body {
+    expr {"abcdefghijklmnopqrstuvwxyz"@0}
+} -returnCodes error -result {invalid character "@"
+in expression "...fghijklmnopqrstuvwxyz"@0"}
+test parseExpr-21.35 {error messages} -body {
+    expr {0@"abcdefghijklmnopqrstuvwxyz"}
+} -returnCodes error -result {invalid character "@"
+in expression "0@"abcdefghijklmnopqrstu..."}
+test parseExpr-21.36 {error messages} -body {
+    expr {"abcdefghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstuvwxyz"}
+} -returnCodes error -result {invalid character "@"
+in expression "...fghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstu..."}
+test parseExpr-21.37 {error messages} -body {
+    expr [format {"%s" @ 0} [string repeat \u00a7 25]]
+} -returnCodes error -result [format {invalid character "@"
+in expression "...%s" @ 0"} [string repeat \u00a7 10]]
+test parseExpr-21.38 {error messages} -body {
+    expr [format {0 @ "%s"} [string repeat \u00a7 25]]
+} -returnCodes error -result [format {invalid character "@"
+in expression "0 @ "%s..."} [string repeat \u00a7 10]]
+test parseExpr-21.39 {error messages} -body {
+    expr [format {"%s" @ "%s"} [string repeat \u00a7 25] [string repeat \u00a7 25]]
+} -returnCodes error -result [format {invalid character "@"
+in expression "...%s" @ "%s..."} [string repeat \u00a7 10] [string repeat \u00a7 10]]
+test parseExpr-21.40 {error messages} -body {
+    catch {expr {"abcdefghijklmnopqrstuvwxyz"@0}} m o
+    dict get $o -errorinfo
+} -result {invalid character "@"
+in expression "...fghijklmnopqrstuvwxyz"@0"
+    (parsing expression ""abcdefghijklmnopqrstu...")
+    invoked from within
+"expr {"abcdefghijklmnopqrstuvwxyz"@0}"}
+test parseExpr-21.41 {error messages} -body {
+    catch {expr [format {"%s" @ 0} [string repeat \u00a7 25]]} m o
+    dict get $o -errorinfo
+} -result [format {invalid character "@"
+in expression "...%s" @ 0"
+    (parsing expression ""%s...")
+    invoked from within
+"expr [format {"%%s" @ 0} [string repeat \u00a7 25]]"} [string repeat \u00a7 10] [string repeat \u00a7 10]]
+
 # cleanup
 ::tcltest::cleanupTests
 return