3401704 Allow function names like influence(), nanobot(), and 99bottles()

that have been parsed as missing operator syntax errors before
with the form NUMBER + FUNCTION.
***POTENTIAL INCOMPATIBILITY***

3 files changed, 136 insertions, 43 deletions

diff --git a/ChangeLog b/ChangeLog
index a193a78..83a8096 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2011-09-07  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclCompExpr.c: [Bug 3401704] Allow function names like
+	* tests/parseExpr.test:	 influence(), nanobot(), and 99bottles()
+	that have been parsed as missing operator syntax errors before
+	with the form NUMBER + FUNCTION.
+	***POTENTIAL INCOMPATIBILITY***
+
 2011-09-06  Venkat Iyer <venkat@comit.com>
 
 	* library/tzdata/America/Goose_Bay: Update to Olson's tzdata2011i
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index d5300db..36e1c9d 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -651,12 +651,6 @@ ParseExpr(
 	Tcl_Obj *literal;	/* Filled by the ParseLexeme() call when
 				 * a literal is parsed that has a Tcl_Obj
 				 * rep worth preserving. */
-	const char *lastStart = start - scanned;
-				/* Compute where the lexeme parsed the
-				 * previous pass through the loop began.
-				 * This is helpful for detecting invalid
-				 * octals and providing more complete error
-				 * messages. */
 
 	/*
 	 * Each pass through this loop adds up to one more OpNode. Allocate
@@ -742,29 +736,30 @@ ParseExpr(
 				" or \"%.*s%s(...)\" or ...",
 				(scanned < limit) ? scanned : limit - 3,
 				start, (scanned < limit) ? "" : "...");
-			if (NotOperator(lastParsed)) {
-			    if ((lastStart[0] == '0')
-				    && ((lastStart[1] == 'o')
-				    || (lastStart[1] == 'O'))
-				    && (lastStart[2] >= '0')
-				    && (lastStart[2] <= '9')) {
-				const char *end = lastStart + 2;
-				Tcl_Obj* copy;
-				while (isdigit(UCHAR(*end))) {
-				    end++;
-				}
-				copy = Tcl_NewStringObj(lastStart,
-					end - lastStart);
-				if (TclCheckBadOctal(NULL,
-					Tcl_GetString(copy))) {
+			if (start[0] == '0') {
+			    const char *stop;
+			    TclParseNumber(NULL, NULL, NULL, start, scanned,
+				    &stop, TCL_PARSE_NO_WHITESPACE);
+
+			    if (isdigit(UCHAR(*stop)) || (stop == start + 1)) {
+				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
+
+				switch (start[1]) {
+				case 'b':
 				    Tcl_AppendToObj(post,
-					    "(invalid octal number?)", -1);
+					    " (invalid binary number?)", -1);
+				    break;
+				case 'o':
+				    Tcl_AppendToObj(post,
+					    " (invalid octal number?)", -1);
+				default:
+				    if (isdigit(UCHAR(start[1]))) {
+				        Tcl_AppendToObj(post,
+						" (invalid octal number?)", -1);
+				    }
+				    break;
 				}
-				Tcl_DecrRefCount(copy);
 			    }
-			    scanned = 0;
-			    insertMark = 1;
-			    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
 			}
 			goto error;
 		    }
@@ -809,18 +804,8 @@ ParseExpr(
 
 	    if (NotOperator(lastParsed)) {
 		msg = Tcl_ObjPrintf("missing operator at %s", mark);
-		if (lastStart[0] == '0') {
-		    Tcl_Obj *copy = Tcl_NewStringObj(lastStart,
-			    start + scanned - lastStart);
-		    if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
-			TclNewLiteralStringObj(post,
-				"looks like invalid octal number");
-		    }
-		    Tcl_DecrRefCount(copy);
-		}
 		scanned = 0;
 		insertMark = 1;
-		parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
 
 		/* Free any literal to avoid a memleak. */
 		if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
@@ -1934,14 +1919,53 @@ ParseLexeme(
     literal = Tcl_NewObj();
     if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
 	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
-	TclInitStringRep(literal, start, end-start);
-	*lexemePtr = NUMBER;
-	if (literalPtr) {
-	    *literalPtr = literal;
+	if (end < start + numBytes && !isalnum(UCHAR(*end))
+		&& UCHAR(*end) != '_') {
+	
+	number:
+	    TclInitStringRep(literal, start, end-start);
+	    *lexemePtr = NUMBER;
+	    if (literalPtr) {
+		*literalPtr = literal;
+	    } else {
+		Tcl_DecrRefCount(literal);
+	    }
+	    return (end-start);
 	} else {
-	    Tcl_DecrRefCount(literal);
+	    unsigned char lexeme;
+
+	    /*
+	     * We have a number followed directly by bareword characters
+	     * (alpha, digit, underscore).  Is this a number followed by
+	     * bareword syntax error?  Or should we join into one bareword?
+	     * Example: Inf + luence + () becomes a valid function call.
+	     * [Bug 3401704]
+	     */
+	    if (literal->typePtr == &tclDoubleType) {
+		const char *p = start;
+		while (p < end) {
+		    if (!isalnum(UCHAR(*p++))) {
+			/*
+			 * The number has non-bareword characters, so we 
+			 * must treat it as a number.
+			 */
+			goto number;
+		    }
+		}
+	    }
+	    ParseLexeme(end, numBytes-(end-start), &lexeme, NULL);
+	    if ((NODE_TYPE & lexeme) == BINARY) {
+		/*
+		 * The bareword characters following the number take the
+		 * form of an operator (eq, ne, in, ni, ...) so we treat
+		 * as number + operator.
+		 */
+		goto number;
+	    }
+	    /*
+	     * Otherwise, fall through and parse the whole as a bareword.
+	     */
 	}
-	return (end-start);
     }
 
     if (Tcl_UtfCharComplete(start, numBytes)) {
@@ -1952,7 +1976,7 @@ ParseLexeme(
 	utfBytes[numBytes] = '\0';
 	scanned = Tcl_UtfToUniChar(utfBytes, &ch);
     }
-    if (!isalpha(UCHAR(ch))) {
+    if (!isalnum(UCHAR(ch))) {
 	*lexemePtr = INVALID;
 	Tcl_DecrRefCount(literal);
 	return scanned;
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index 7673dbe..1620a62 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -997,6 +997,67 @@ test parseExpr-21.63 {error message} -body {
 } -returnCodes error -result "missing close-brace
 in expression \"...12345678901234567890*\[\{abcdefghijklmnopqrstuv...\""
 
+test parseExpr-18.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -constraints testexprparser -body {
+    testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1
+} -returnCodes error -match glob -result *
+
+test parseExpr-22.1 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 2a() 1
+} -result {- {} 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-22.2 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nana() 3
+} -result {- {} 0 subexpr nan 1 text nan 0 {}}
+test parseExpr-22.3 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 2a() -1
+} -result {- {} 0 subexpr 2a() 1 operator 2a 0 {}}
+test parseExpr-22.4 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nana() -1
+} -result {- {} 0 subexpr nana() 1 operator nana 0 {}}
+test parseExpr-22.5 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nan9() -1
+} -result {- {} 0 subexpr nan9() 1 operator nan9 0 {}}
+test parseExpr-22.6 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 2_() -1
+} -result {- {} 0 subexpr 2_() 1 operator 2_ 0 {}}
+test parseExpr-22.7 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nan_() -1
+} -result {- {} 0 subexpr nan_() 1 operator nan_ 0 {}}
+test parseExpr-22.8 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nan!() -1
+} -returnCodes error -match glob -result *
+test parseExpr-22.9 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 1e3_() -1
+} -result {- {} 0 subexpr 1e3_() 1 operator 1e3_ 0 {}}
+test parseExpr-22.10 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 1.3_() -1
+} -returnCodes error -match glob -result *
+test parseExpr-22.11 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 1e-3_() -1
+} -returnCodes error -match glob -result *
+test parseExpr-22.12 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser naneq() -1
+} -returnCodes error -match glob -result *
+test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser naner() -1
+} -result {- {} 0 subexpr naner() 1 operator naner 0 {}}
+
+test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 08 -1
+} -returnCodes error -match glob -result {*invalid octal number*}
+test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 0o8 -1
+} -returnCodes error -match glob -result {*invalid octal number*}
+test parseExpr-22.16 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 0o08 -1
+} -returnCodes error -match glob -result {*invalid octal number*}
+test parseExpr-22.17 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 0b2 -1
+} -returnCodes error -match glob -result {*invalid binary number*}
+test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 0b02 -1
+} -returnCodes error -match glob -result {*invalid binary number*}
+
+
 # cleanup
 ::tcltest::cleanupTests
 return