From 23889e745ac1e3ba5e76c3ffb94736a5c475de7e Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Sun, 16 Feb 2003 01:36:32 +0000 Subject: Don Porter's fix for bad parsing of nested scripts [Bug 681841]. --- ChangeLog | 15 +++++ generic/tclBasic.c | 160 ++++++++++++++++++++++++++++--------------------- generic/tclCompExpr.c | 4 +- generic/tclCompile.c | 104 ++++++++++++++++++++++---------- generic/tclParse.c | 22 ++++++- generic/tclParseExpr.c | 17 +++++- tests/basic.test | 6 +- tests/main.test | 8 +-- tests/misc.test | 17 ++++-- tests/parse.test | 6 +- tests/parseExpr.test | 6 +- tests/subst.test | 6 +- 12 files changed, 251 insertions(+), 120 deletions(-) diff --git a/ChangeLog b/ChangeLog index b8d0cba..18b482c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2003-02-15 Miguel Sofer + + * generic/tclBasic.c (Tcl_EvalEx): + * generic/tclCompExpr.c (CompileSubExpr): + * generic/tclCompile.c (TclCompileScript): + * generic/tclParse.c (Tcl_ParseCommand, ParseTokens): + * generic/tclParseExpr.c (ParsePrimaryExpr): + * tests/basic.test (47.1): + * tests/main.test (3.4): + * tests/misc.test (1.2): + * tests/parse.test (6.18): + * tests/parseExpr.test (15.35): + * tests/subst.test (8.6): Don Porter's fix for bad parsing of + nested scripts [Bug 681841]. + 2003-02-15 Kevin Kenny * tests/notify.test (new-file): diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e7b0aa0..45f1422 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.72 2003/02/03 20:16:52 kennykb Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.73 2003/02/16 01:36:32 msofer Exp $ */ #include "tclInt.h" @@ -3579,13 +3579,6 @@ Tcl_EvalEx(interp, script, numBytes, flags) * in case TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); - /* For nested scripts, this variable will be set to point to the first - * char after the end of the script - needed only to compare pointers, - * nothing will be read nor written there. - */ - - CONST char *onePast = NULL; - /* * The variables below keep track of how much state has been * allocated while evaluating the script, so that it can be freed @@ -3614,7 +3607,6 @@ Tcl_EvalEx(interp, script, numBytes, flags) bytesLeft = numBytes; if (iPtr->evalFlags & TCL_BRACKET_TERM) { nested = 1; - onePast = script + numBytes; } else { nested = 0; } @@ -3627,14 +3619,13 @@ Tcl_EvalEx(interp, script, numBytes, flags) } gotParse = 1; - /* - * A nested script can only terminate in ']'. If the script is not - * nested, onePast is NULL and the second test is not performed. - */ + if (nested && parse.term == (script + numBytes)) { + /* + * A nested script can only terminate in ']'. If + * the parsing got terminated at the end of the script, + * there was no closing ']'. Report the syntax error. + */ - next = parse.commandStart + parse.commandSize; - if ((next == onePast) && (onePast[-1] != ']')) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("missing close-bracket", -1)); code = TCL_ERROR; goto error; } @@ -3702,15 +3693,17 @@ Tcl_EvalEx(interp, script, numBytes, flags) * Advance to the next command in the script. */ + next = parse.commandStart + parse.commandSize; bytesLeft -= next - p; p = next; Tcl_FreeParse(&parse); gotParse = 0; - if ((nested != 0) && (p > script) && (p[-1] == ']')) { + if (nested && (*parse.term == ']')) { /* * We get here in the special case where the TCL_BRACKET_TERM - * flag was set in the interpreter and we reached a close - * bracket in the script. Return immediately. + * flag was set in the interpreter and the latest parsed command + * was terminated by the matching close-bracket we seek. + * Return immediately. */ iPtr->termOffset = (p - 1) - script; @@ -3732,12 +3725,12 @@ Tcl_EvalEx(interp, script, numBytes, flags) if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { commandLength = parse.commandSize; - if ((parse.commandStart + commandLength) != (script + numBytes)) { + if (parse.term == parse.commandStart + commandLength - 1) { /* - * The command where the error occurred didn't end at the end - * of the script (i.e. it ended at a terminator character such - * as ";". Reduce the length by one so that the error message - * doesn't include the terminator character. + * The terminator character (such as ; or ]) of the command where + * the error occurred is the last character in the parsed command. + * Reduce the length by one so that the error message doesn't + * include the terminator character. */ commandLength -= 1; @@ -3749,60 +3742,91 @@ Tcl_EvalEx(interp, script, numBytes, flags) Tcl_DecrRefCount(objv[i]); } if (gotParse) { - next = parse.commandStart + parse.commandSize; - bytesLeft -= next - p; - p = next; Tcl_FreeParse(&parse); + } + if (objv != staticObjArray) { + ckfree((char *) objv); + } + iPtr->varFramePtr = savedVarFramePtr; - if ((nested != 0) && (p > script)) { - CONST char *nextCmd = NULL; /* pointer to start of next command */ + /* + * All that's left to do before returning is to set iPtr->termOffset + * to point past the end of the script we just evaluated. + */ - /* - * We get here in the special case where the TCL_BRACKET_TERM - * flag was set in the interpreter. - * - * At this point, we want to find the end of the script - * (either end of script or the closing ']'). - */ + next = parse.commandStart + parse.commandSize; + bytesLeft -= next - p; + p = next; - while ((p[-1] != ']') && bytesLeft) { - if (Tcl_ParseCommand(NULL, p, bytesLeft, nested, &parse) - != TCL_OK) { - /* - * We were looking for the ']' to close the script. - * But if we find a syntax error, it is ok to quit - * early since in that case we no longer need to know - * where the ']' is (if there was one). We reset the - * pointer to the start of the command that after the - * one causing the return. -- hobbs - */ - - p = (nextCmd == NULL) ? parse.commandStart : nextCmd; - break; - } + if (!nested) { + iPtr->termOffset = p - script; + return code; + } - if (nextCmd == NULL) { - nextCmd = parse.commandStart; - } + /* + * When we are nested (the TCL_BRACKET_TERM flag was set in the + * interpreter), we must find the matching close-bracket to + * end the script we are evaluating. + * + * When our return code is TCL_CONTINUE or TCL_RETURN, we want + * to correctly set iPtr->termOffset to point to that matching + * close-bracket so our caller can move to the part of the + * string beyond the script we were asked to evaluate. + * So we try to parse past the rest of the commands. + */ - /* - * Advance to the next command in the script. - */ + next = NULL; + while (bytesLeft && (*parse.term != ']')) { + if (TCL_OK != Tcl_ParseCommand(NULL, p, bytesLeft, 1, &parse)) { + /* + * Syntax error. Set the termOffset to the beginning of + * the last command parsed. + */ - next = parse.commandStart + parse.commandSize; - bytesLeft -= next - p; - p = next; - Tcl_FreeParse(&parse); + if (next == NULL) { + iPtr->termOffset = (parse.commandStart - 1) - script; + } else { + iPtr->termOffset = (next - 1) - script; } - iPtr->termOffset = (p - 1) - script; - } else { - iPtr->termOffset = p - script; - } + return code; + } + next = parse.commandStart + parse.commandSize; + bytesLeft -= next - p; + p = next; + next = parse.commandStart; + Tcl_FreeParse(&parse); } - if (objv != staticObjArray) { - ckfree((char *) objv); + + if (bytesLeft) { + /* + * parse.term points to the close-bracket. + */ + + iPtr->termOffset = parse.term - script; + } else if (parse.term == script + numBytes) { + /* + * There was no close-bracket. Syntax error. + */ + + iPtr->termOffset = parse.term - script; + Tcl_SetObjResult(interp, + Tcl_NewStringObj("missing close-bracket", -1)); + return TCL_ERROR; + } else if (*parse.term != ']') { + /* + * There was no close-bracket. Syntax error. + */ + + iPtr->termOffset = (parse.term + 1) - script; + Tcl_SetObjResult(interp, + Tcl_NewStringObj("missing close-bracket", -1)); + return TCL_ERROR; + } else { + /* + * parse.term points to the close-bracket. + */ + iPtr->termOffset = parse.term - script; } - iPtr->varFramePtr = savedVarFramePtr; return code; } diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 8d74efa..1465f69 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompExpr.c,v 1.12 2002/08/05 03:24:40 dgp Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.13 2003/02/16 01:36:32 msofer Exp $ */ #include "tclInt.h" @@ -398,7 +398,7 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) case TCL_TOKEN_COMMAND: code = TclCompileScript(interp, tokenPtr->start+1, - tokenPtr->size-2, /*nested*/ 1, envPtr); + tokenPtr->size-2, /*nested*/ 0, envPtr); if (code != TCL_OK) { goto done; } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c069d76..feeb7e6 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.41 2002/09/24 12:53:33 dkf Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.42 2003/02/16 01:36:32 msofer Exp $ */ #include "tclInt.h" @@ -798,7 +798,9 @@ TclFreeCompileEnv(envPtr) int TclCompileScript(interp, script, numBytes, nested, envPtr) - Tcl_Interp *interp; /* Used for error and status reporting. */ + Tcl_Interp *interp; /* Used for error and status reporting. + * Also serves as context for finding and + * compiling commands. May not be NULL. */ CONST char *script; /* The source script to compile. */ int numBytes; /* Number of bytes in script. If < 0, the * script consists of all bytes up to the @@ -824,7 +826,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) Tcl_Token *tokenPtr; int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex; int commandLength, objIndex, code; - char prev; Tcl_DString ds; Tcl_DStringInit(&ds); @@ -843,12 +844,56 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) p = script; bytesLeft = numBytes; gotParse = 0; - while (bytesLeft > 0) { + do { if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) { code = TCL_ERROR; goto error; } gotParse = 1; + if (nested) { + /* + * This is an unusual situation where the caller has passed us + * a non-zero value for "nested". How unusual? Well, this + * procedure, TclCompileScript, is internal to Tcl, so all + * callers should be within Tcl itself. All but one of those + * callers explicitly pass in (nested = 0). The exceptional + * caller is TclSetByteCodeFromAny, which will pass in + * (nested = 1) if and only if the flag TCL_BRACKET_TERM + * is set in the evalFlags field of interp. + * + * It appears that the TCL_BRACKET_TERM flag is only ever set + * by Tcl_SubstObj, and it immediately calls Tcl_EvalEx + * which clears the flag before passing the interp along. + * So, I don't think this procedure, TclCompileScript, is + * **ever** called with (nested != 0). + * (The testsuite indeed doesn't exercise this code. MS) + * + * This means that the branches in this procedure that are + * only active when (nested != 0) are probably never exercised. + * This means that any bugs in them go unnoticed, and any bug + * fixes in them have a semi-theoretical nature. + * + * All that said, the spec for this procedure says it should + * handle the (nested != 0) case, so here's an attempt to fix + * bugs (Tcl Bug 681841) in that case. Just in case some + * callers eventually come along and expect it to work... + */ + + if (parse.term == (script + numBytes)) { + /* + * The (nested != 0) case is meant to indicate that the + * caller found an open bracket ([) and asked us to + * parse and compile Tcl commands up to the matching + * close bracket (]). We have to detect and handle + * the case where the close bracket is missing. + */ + + Tcl_SetObjResult(interp, + Tcl_NewStringObj("missing close-bracket", -1)); + code = TCL_ERROR; + goto error; + } + } if (parse.numWords > 0) { /* * If not the first command, pop the previous command's result @@ -870,15 +915,10 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) */ commandLength = parse.commandSize; - prev = '\0'; - if (commandLength > 0) { - prev = parse.commandStart[commandLength-1]; - } - if (((parse.commandStart+commandLength) != (script+numBytes)) - || ((prev=='\n') || (nested && (prev==']')))) { + if (parse.term == parse.commandStart + commandLength - 1) { /* - * The command didn't end at the end of the script (i.e. it - * ended at a terminator character such as ";". Reduce the + * The command terminator character (such as ; or ]) is + * the last character in the parsed command. Reduce the * length by one so that the trace message doesn't include * the terminator character. */ @@ -963,7 +1003,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) * claimed to be in (*envPtr). */ envPtr->numCommands--; - goto error; + goto log; } } @@ -993,7 +1033,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) code = TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr); if (code != TCL_OK) { - goto error; + goto log; } } } @@ -1031,16 +1071,17 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) p = next; Tcl_FreeParse(&parse); gotParse = 0; - if (nested && (p[-1] == ']')) { + if (nested && (*parse.term == ']')) { /* * We get here in the special case where TCL_BRACKET_TERM was - * set in the interpreter and we reached a close bracket in the - * script. Stop compilation. + * set in the interpreter and the latest parsed command was + * terminated by the matching close-bracket we were looking for. + * Stop compilation. */ break; } - } + } while (bytesLeft > 0); /* * If the source script yielded no instructions (e.g., if it was empty), @@ -1052,7 +1093,13 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) envPtr); } - if ((nested != 0) && (p > script) && (p[-1] == ']')) { + if (nested) { + /* + * When (nested != 0) back up 1 character to have + * iPtr->termOffset indicate the offset to the matching + * close-bracket. + */ + iPtr->termOffset = (p - 1) - script; } else { iPtr->termOffset = (p - script); @@ -1069,21 +1116,18 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) */ commandLength = parse.commandSize; - prev = '\0'; - if (commandLength > 0) { - prev = parse.commandStart[commandLength-1]; - } - if (((parse.commandStart+commandLength) != (script+numBytes)) - || ((prev == '\n') || (nested && (prev == ']')))) { + if (parse.term == parse.commandStart + commandLength - 1) { /* - * The command where the error occurred didn't end at the end - * of the script (i.e. it ended at a terminator character such - * as ";". Reduce the length by one so that the error message - * doesn't include the terminator character. + * The terminator character (such as ; or ]) of the command where + * the error occurred is the last character in the parsed command. + * Reduce the length by one so that the error message doesn't + * include the terminator character. */ commandLength -= 1; } + + log: LogCompilationInfo(interp, script, parse.commandStart, commandLength); if (gotParse) { Tcl_FreeParse(&parse); @@ -1163,7 +1207,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr) } code = TclCompileScript(interp, tokenPtr->start+1, - tokenPtr->size-2, /*nested*/ 1, envPtr); + tokenPtr->size-2, /*nested*/ 0, envPtr); if (code != TCL_OK) { goto error; } diff --git a/generic/tclParse.c b/generic/tclParse.c index 7e8fced..ec8c9f0 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.24 2003/02/11 18:34:43 hobbs Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.25 2003/02/16 01:36:32 msofer Exp $ */ #include "tclInt.h" @@ -306,6 +306,7 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); src += scanned; numBytes -= scanned; if (numBytes == 0) { + parsePtr->term = src; break; } if ((type & terminators) != 0) { @@ -376,6 +377,7 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) } if (numBytes == 0) { + parsePtr->term = src; break; } if ((type & terminators) != 0) { @@ -408,7 +410,7 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) if (parsePtr->commandStart == NULL) { parsePtr->commandStart = string; } - parsePtr->commandSize = parsePtr->term - parsePtr->commandStart; + parsePtr->commandSize = parsePtr->end - parsePtr->commandStart; return TCL_ERROR; } @@ -859,10 +861,24 @@ ParseTokens(src, numBytes, mask, parsePtr) } src = nested.commandStart + nested.commandSize; numBytes = parsePtr->end - src; + + /* + * This is equivalent to Tcl_FreeParse(&nested), but + * presumably inlined here for sake of runtime optimization + */ + if (nested.tokenPtr != nested.staticTokens) { ckfree((char *) nested.tokenPtr); } - if ((*nested.term == ']') && !nested.incomplete) { + + /* + * Check for the closing ']' that ends the command + * substitution. It must have been the last character of + * the parsed command. + */ + + if ((nested.term < parsePtr->end) && (*nested.term == ']') + && !nested.incomplete) { break; } if (numBytes == 0) { diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index 85be0cd..bb88159 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.c @@ -13,7 +13,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.16 2002/12/11 20:30:16 dgp Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.17 2003/02/16 01:36:32 msofer Exp $ */ #include "tclInt.h" @@ -1287,10 +1287,23 @@ ParsePrimaryExpr(infoPtr) return TCL_ERROR; } src = (nested.commandStart + nested.commandSize); + + /* + * This is equivalent to Tcl_FreeParse(&nested), but + * presumably inlined here for sake of runtime optimization + */ + if (nested.tokenPtr != nested.staticTokens) { ckfree((char *) nested.tokenPtr); } - if ((src[-1] == ']') && !nested.incomplete) { + + /* + * Check for the closing ']' that ends the command substitution. + * It must have been the last character of the parsed command. + */ + + if ((nested.term < parsePtr->end) && (*nested.term == ']') + && !nested.incomplete) { break; } if (src == parsePtr->end) { diff --git a/tests/basic.test b/tests/basic.test index dbc5216..c45a763 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: basic.test,v 1.24 2003/02/04 17:06:52 vincentdarley Exp $ +# RCS: @(#) $Id: basic.test,v 1.25 2003/02/16 01:36:32 msofer Exp $ # package require tcltest 2 @@ -638,6 +638,10 @@ test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} {exec} { "return -code return" (file "BREAKtest" line 2)}} +test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -body { + subst {a[set b [format cd]} +} -returnCodes error -result {missing close-bracket} + # cleanup catch {eval namespace delete [namespace children :: test_ns_*]} diff --git a/tests/main.test b/tests/main.test index c005c41..6778b88 100644 --- a/tests/main.test +++ b/tests/main.test @@ -1,6 +1,6 @@ # This file contains a collection of tests for generic/tclMain.c. # -# RCS: @(#) $Id: main.test,v 1.12 2003/01/31 18:54:32 dgp Exp $ +# RCS: @(#) $Id: main.test,v 1.13 2003/02/16 01:36:32 msofer Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -277,13 +277,13 @@ namespace eval ::tcl::test::main { } -body { set code [catch {exec [interpreter] script >& result} result] set f [open result] - list $code $result [read $f] + join [list $code $result [read $f]] \n } -cleanup { close $f file delete result removeFile script - } -match glob -result [list 1 {child process exited abnormally}\ - "missing close-brace\n while executing*"] + } -match glob -result [join [list 1 {child process exited abnormally}\ + "missing close-brace\n while executing*"] \n] test Tcl_Main-3.5 { Tcl_Main: startup script sets main loop diff --git a/tests/misc.test b/tests/misc.test index 12ef1bd..d6536b7 100644 --- a/tests/misc.test +++ b/tests/misc.test @@ -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: misc.test,v 1.5 2000/04/10 17:19:02 ericm Exp $ +# RCS: @(#) $Id: misc.test,v 1.6 2003/02/16 01:36:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -51,13 +51,20 @@ test misc-1.2 {error in variable ref. in command in array reference} { # this is a bogus comment " set msg {} - list [catch tstProc msg] $msg $errorInfo -} {1 {missing close-brace for variable name} {missing close-brace for variable name + join [list [catch tstProc msg] $msg $errorInfo] \n +} [subst -novariables -nocommands {1 +missing close-brace for variable name +missing close-brace for variable name while compiling -"set tst $a([winfo name " +"set tst $a([winfo name $\{zz) + # this is a bogus comment + # this is a bogus comment + # this is a bogus comment + # this is a bogus comment + # this is a ..." (compiling body of proc "tstProc", line 4) invoked from within -"tstProc"}} +"tstProc"}] # cleanup ::tcltest::cleanupTests diff --git a/tests/parse.test b/tests/parse.test index 8dcf480..95330be 100644 --- a/tests/parse.test +++ b/tests/parse.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: parse.test,v 1.10 2003/02/11 18:27:37 hobbs Exp $ +# RCS: @(#) $Id: parse.test,v 1.11 2003/02/16 01:36:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -209,6 +209,10 @@ test parse-6.16 {ParseTokens procedure, backslash substitution} { test parse-6.17 {ParseTokens procedure, null characters} { testparser [bytestring "foo\0zz"] 0 } "- [bytestring foo\0zz] 1 word [bytestring foo\0zz] 3 text foo 0 text [bytestring \0] 0 text zz 0 {}" +test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} { + # Test for Bug 681841 + list [catch {testparser {[a]} 2} msg] $msg +} {1 {missing close-bracket}} test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} { testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0 diff --git a/tests/parseExpr.test b/tests/parseExpr.test index ad5bd17..7b87b85 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.9 2002/12/11 20:30:16 dgp Exp $ +# RCS: @(#) $Id: parseExpr.test,v 1.10 2003/02/16 01:36:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -491,6 +491,10 @@ test parseExpr-15.34 {ParsePrimaryExpr procedure, single equal-specific message} test parseExpr-15.35 {ParsePrimaryExpr procedure, error in parenthesized subexpr} { list [catch {testexprparser {(: 123 : 456)} -1} msg] $msg } {1 {syntax error in expression "(: 123 : 456)": unexpected ternary 'else' separator}} +test parseExpr-15.36 {ParsePrimaryExpr procedure, missing close-bracket} { + # Test for Bug 681841 + list [catch {testexprparser {[set a [format bc]} -1} msg] $msg +} {1 {missing close-bracket}} test parseExpr-16.1 {GetLexeme procedure, whitespace before lexeme} { testexprparser { 123} -1 diff --git a/tests/subst.test b/tests/subst.test index 0ff69f8..0e46f02 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -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: subst.test,v 1.12 2002/08/08 15:28:55 msofer Exp $ +# RCS: @(#) $Id: subst.test,v 1.13 2003/02/16 01:36:32 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -156,8 +156,8 @@ test subst-8.5 {return in a subst} { subst {foo [return {]}; bogus code] bar} } {foo ] bar} test subst-8.6 {return in a subst} { - subst {foo [return {x}; bogus code bar} -} {foo x} + list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg +} {1 {missing close-bracket}} test subst-8.7 {return in a subst, parse error} { subst {foo [return {x} ; set a {}" ; stuff] bar} } {foo xset a {}" ; stuff] bar} -- cgit v0.12