summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2003-02-16 01:36:32 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2003-02-16 01:36:32 (GMT)
commit23889e745ac1e3ba5e76c3ffb94736a5c475de7e (patch)
treeb9cac46b6b2fb5373a629e8d3758b7742b6a651c
parentaf570109241e78092cb2e80486e479b3a71524ef (diff)
downloadtcl-23889e745ac1e3ba5e76c3ffb94736a5c475de7e.zip
tcl-23889e745ac1e3ba5e76c3ffb94736a5c475de7e.tar.gz
tcl-23889e745ac1e3ba5e76c3ffb94736a5c475de7e.tar.bz2
Don Porter's fix for bad parsing of nested scripts [Bug 681841].
-rw-r--r--ChangeLog15
-rw-r--r--generic/tclBasic.c160
-rw-r--r--generic/tclCompExpr.c4
-rw-r--r--generic/tclCompile.c104
-rw-r--r--generic/tclParse.c22
-rw-r--r--generic/tclParseExpr.c17
-rw-r--r--tests/basic.test6
-rw-r--r--tests/main.test8
-rw-r--r--tests/misc.test17
-rw-r--r--tests/parse.test6
-rw-r--r--tests/parseExpr.test6
-rw-r--r--tests/subst.test6
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 <msofer@users.sf.net>
+
+ * 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 <kennykb@users.sourceforge.net>
* 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}