Tidiness, comments, and tests.dgp_3401704

2 files changed, 89 insertions, 5 deletions

diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 3fdcc22..36e1c9d 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1919,7 +1919,8 @@ ParseLexeme(
     literal = Tcl_NewObj();
     if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
 	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
-	if (!isalnum(UCHAR(*end)) && UCHAR(*end) != '_') {
+	if (end < start + numBytes && !isalnum(UCHAR(*end))
+		&& UCHAR(*end) != '_') {
 	
 	number:
 	    TclInitStringRep(literal, start, end-start);
@@ -1932,16 +1933,38 @@ ParseLexeme(
 	    return (end-start);
 	} else {
 	    unsigned char lexeme;
-	    const char *p = start;
-	    while (p < end) {
-		if (!isalnum(UCHAR(*p++))) {
-		    goto number;
+
+	    /*
+	     * 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.
+	     */
 	}
     }
 
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