diff options
-rw-r--r-- | ChangeLog | 8 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 118 | ||||
-rw-r--r-- | tests/parseExpr.test | 66 |
3 files changed, 147 insertions, 45 deletions
@@ -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 d1d7403..80f21e4 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -659,11 +659,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 @@ -754,33 +749,39 @@ ParseExpr( Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...", (scanned < limit) ? scanned : limit - 3, start, (scanned < limit) ? "" : "..."); - if (NotOperator(lastParsed)) { - errCode = "BADNUMBER"; - 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))) { + errCode = "BAREWORD"; + 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)) { + switch (start[1]) { + case 'b': + Tcl_AppendToObj(post, + " (invalid binary number?)", -1); + parsePtr->errorType = TCL_PARSE_BAD_NUMBER; + errCode = "BADNUMBER"; + subErrCode = "BINARY"; + break; + case 'o': Tcl_AppendToObj(post, " (invalid octal number?)", -1); + parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "OCTAL"; + break; + default: + if (isdigit(UCHAR(start[1]))) { + Tcl_AppendToObj(post, + " (invalid octal number?)", -1); + parsePtr->errorType = TCL_PARSE_BAD_NUMBER; + errCode = "BADNUMBER"; + subErrCode = "OCTAL"; + } + break; } - Tcl_DecrRefCount(copy); } - scanned = 0; - insertMark = 1; - parsePtr->errorType = TCL_PARSE_BAD_NUMBER; - } else { - errCode = "BAREWORD"; } goto error; } @@ -824,20 +825,8 @@ ParseExpr( if (NotOperator(lastParsed)) { msg = Tcl_ObjPrintf("missing operator at %s", mark); errCode = "MISSING"; - 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"); - errCode = "BADNUMBER_OCTAL"; - } - 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)) { @@ -1996,14 +1985,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)) { @@ -2015,7 +2043,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..cd0342a 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -997,6 +997,72 @@ test parseExpr-21.63 {error message} -body { } -returnCodes error -result "missing close-brace in expression \"...12345678901234567890*\[\{abcdefghijklmnopqrstuv...\"" +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 { + catch {testexprparser nan!() -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR MISSING} +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 { + catch {testexprparser 1.3_() -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR BADCHAR} +test parseExpr-22.11 {Bug 3401704} -constraints testexprparser -body { + catch {testexprparser 1e-3_() -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR BADCHAR} +test parseExpr-22.12 {Bug 3401704} -constraints testexprparser -body { + catch {testexprparser naneq() -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR EMPTY} +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 { + catch {testexprparser 08 -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR BADNUMBER OCTAL} +test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body { + catch {testexprparser 0o8 -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR BADNUMBER OCTAL} +test parseExpr-22.16 {Bug 3401704} -constraints testexprparser -body { + catch {testexprparser 0o08 -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR BADNUMBER OCTAL} +test parseExpr-22.17 {Bug 3401704} -constraints testexprparser -body { + catch {testexprparser 0b2 -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR BADNUMBER BINARY} +test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body { + catch {testexprparser 0b02 -1} m o + dict get $o -errorcode +} -result {TCL PARSE EXPR BADNUMBER BINARY} + + # cleanup ::tcltest::cleanupTests return |