Don Porter's fix for bad parsing of nested scripts [Bug 681841].

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}