From ece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 13 Mar 2003 02:48:51 +0000
Subject:         * generic/tclBasic.c (Tcl_EvalTokensStandard):         *
 generic/tclCmdMZ.c (Tcl_SubstObj):         * generic/tclCompCmds.c
 (TclCompileSwitchCmd):         * generic/tclCompExpr.c (CompileSubExpr):     
    * generic/tclCompile.c (TclSetByteCodeFromAny,TclCompileScript,           
      TclCompileTokens,TclCompileCmdWord):         * generic/tclCompile.h
 (TclCompileScript):         * generic/tclExecute.c (TclCompEvalObj):        
 * generic/tclInt.h (Interp,TCL_BRACKET_TERM,TclSubstTokens):         *
 generic/tclParse.c (ParseTokens,Tcl_SubstObj,TclSubstTokens):         *
 tests/subst.test (2.4, 8.7, 8.8, 11.4, 11.5):         Substantial refactoring
 of Tcl_SubstObj to make use of the same         parsing and substitution
 procedures as normal script evaluation.         Tcl_SubstObj() moved to
 tclParse.c.  New routine TclSubstTokens()         created in tclParse.c which
 implements all substantial functioning         of Tcl_EvalTokensStandard(). 
 TclCompileScript() loses its         "nested" argument, the Tcl_Interp struct
 loses its termOffset         field and the TCL_BRACKET_TERM flag in the
 evalFlags field, all         of which were only used (indirectly) by
 Tcl_SubstObj().  Tests         subst-8.7,8.8,11.4,11.5 modified to accomodate
 the only behavior         change: reporting of parse errors now takes
 precedence over         [return] and [continue] exceptions.  All other
 behavior should

---
 ChangeLog             |  24 +++
 generic/tclBasic.c    | 261 +---------------------------
 generic/tclCmdMZ.c    | 155 +----------------
 generic/tclCompCmds.c |   4 +-
 generic/tclCompExpr.c |   4 +-
 generic/tclCompile.c  | 113 ++-----------
 generic/tclCompile.h  |   5 +-
 generic/tclExecute.c  |  12 +-
 generic/tclInt.h      |  13 +-
 generic/tclParse.c    | 459 +++++++++++++++++++++++++++++++++++++++++++++++++-
 tests/subst.test      |  24 +--
 11 files changed, 524 insertions(+), 550 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 23a416a..8815a82 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,29 @@
 2003-03-12  Don Porter  <dgp@users.sourceforge.net>
 
+	* generic/tclBasic.c (Tcl_EvalTokensStandard):
+	* generic/tclCmdMZ.c (Tcl_SubstObj):
+	* generic/tclCompCmds.c (TclCompileSwitchCmd):
+	* generic/tclCompExpr.c (CompileSubExpr):
+	* generic/tclCompile.c (TclSetByteCodeFromAny,TclCompileScript,
+		TclCompileTokens,TclCompileCmdWord):
+	* generic/tclCompile.h (TclCompileScript):
+	* generic/tclExecute.c (TclCompEvalObj):
+	* generic/tclInt.h (Interp,TCL_BRACKET_TERM,TclSubstTokens):
+	* generic/tclParse.c (ParseTokens,Tcl_SubstObj,TclSubstTokens):
+	* tests/subst.test (2.4, 8.7, 8.8, 11.4, 11.5):
+	Substantial refactoring of Tcl_SubstObj to make use of the same
+	parsing and substitution procedures as normal script evaluation.
+	Tcl_SubstObj() moved to tclParse.c.  New routine TclSubstTokens()
+	created in tclParse.c which implements all substantial functioning
+	of Tcl_EvalTokensStandard().  TclCompileScript() loses its
+	"nested" argument, the Tcl_Interp struct loses its termOffset
+	field and the TCL_BRACKET_TERM flag in the evalFlags field, all
+	of which were only used (indirectly) by Tcl_SubstObj().  Tests
+	subst-8.7,8.8,11.4,11.5 modified to accomodate the only behavior
+	change: reporting of parse errors now takes precedence over
+	[return] and [continue] exceptions.  All other behavior should
+	remain compatible.  [RFE 536831,684982] [Bug 685106]
+
         * generic/tcl.h:        Removed TCL_PREFIX_IDENT and TCL_DEBUG_IDENT
         * win/tclWinPipe.c:     from tcl.h -- they are not part of Tcl's
         public interface.  Put them in win/tclWinPipe.c where they are used.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 713067c..5315494 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.76 2003/03/05 22:31:22 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.77 2003/03/13 02:48:52 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -346,7 +346,6 @@ Tcl_CreateInterp()
     Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
     iPtr->packageUnknown = NULL;
     iPtr->cmdCount = 0;
-    iPtr->termOffset = 0;
     TclInitLiteralTable(&(iPtr->literalTable));
     iPtr->compileEpoch = 0;
     iPtr->compiledProcPtr = NULL;
@@ -3347,143 +3346,7 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
     int count;			/* Number of tokens to consider at tokenPtr.
 				 * Must be at least 1. */
 {
-    Tcl_Obj *resultPtr, *indexPtr, *valuePtr;
-    char buffer[TCL_UTF_MAX];
-#ifdef TCL_MEM_DEBUG
-#   define  MAX_VAR_CHARS 5
-#else
-#   define  MAX_VAR_CHARS 30
-#endif
-    char nameBuffer[MAX_VAR_CHARS+1];
-    char *varName, *index;
-    CONST char *p = NULL;	/* Initialized to avoid compiler warning. */
-    int length, code;
-
-    /*
-     * The only tricky thing about this procedure is that it attempts to
-     * avoid object creation and string copying whenever possible.  For
-     * example, if the value is just a nested command, then use the
-     * command's result object directly.
-     */
-
-    code = TCL_OK;
-    resultPtr = NULL;
-    Tcl_ResetResult(interp);
-    for ( ; count > 0; count--, tokenPtr++) {
-	valuePtr = NULL;
-
-	/*
-	 * The switch statement below computes the next value to be
-	 * concat to the result, as either a range of text or an
-	 * object.
-	 */
-
-	switch (tokenPtr->type) {
-	    case TCL_TOKEN_TEXT:
-		p = tokenPtr->start;
-		length = tokenPtr->size;
-		break;
-
-	    case TCL_TOKEN_BS:
-		length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
-			buffer);
-		p = buffer;
-		break;
-
-	    case TCL_TOKEN_COMMAND:
-		code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
-			0);
-		if (code != TCL_OK) {
-		    goto done;
-		}
-		valuePtr = Tcl_GetObjResult(interp);
-		break;
-
-	    case TCL_TOKEN_VARIABLE:
-		if (tokenPtr->numComponents == 1) {
-		    indexPtr = NULL;
-		    index = NULL;
-		} else {
-		    code = Tcl_EvalTokensStandard(interp, tokenPtr+2,
-			    tokenPtr->numComponents - 1);
-		    if (code != TCL_OK) {
-			goto done;
-		    }
-		    indexPtr = Tcl_GetObjResult(interp);
-		    Tcl_IncrRefCount(indexPtr);
-		    index = Tcl_GetString(indexPtr);
-		}
-
-		/*
-		 * We have to make a copy of the variable name in order
-		 * to have a null-terminated string.  We can't make a
-		 * temporary modification to the script to null-terminate
-		 * the name, because a trace callback might potentially
-		 * reuse the script and be affected by the null character.
-		 */
-
-		if (tokenPtr[1].size <= MAX_VAR_CHARS) {
-		    varName = nameBuffer;
-		} else {
-		    varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
-		}
-		strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
-		varName[tokenPtr[1].size] = 0;
-		valuePtr = Tcl_GetVar2Ex(interp, varName, index,
-			TCL_LEAVE_ERR_MSG);
-		if (varName != nameBuffer) {
-		    ckfree(varName);
-		}
-		if (indexPtr != NULL) {
-		    Tcl_DecrRefCount(indexPtr);
-		}
-		if (valuePtr == NULL) {
-		    code = TCL_ERROR;
-		    goto done;
-		}
-		count -= tokenPtr->numComponents;
-		tokenPtr += tokenPtr->numComponents;
-		break;
-
-	    default:
-		panic("unexpected token type in Tcl_EvalTokensStandard");
-	}
-
-	/*
-	 * If valuePtr isn't NULL, the next piece of text comes from that
-	 * object; otherwise, take length bytes starting at p.
-	 */
-
-	if (resultPtr == NULL) {
-	    if (valuePtr != NULL) {
-		resultPtr = valuePtr;
-	    } else {
-		resultPtr = Tcl_NewStringObj(p, length);
-	    }
-	    Tcl_IncrRefCount(resultPtr);
-	} else {
-	    if (Tcl_IsShared(resultPtr)) {
-		Tcl_DecrRefCount(resultPtr);
-		resultPtr = Tcl_DuplicateObj(resultPtr);
-		Tcl_IncrRefCount(resultPtr);
-	    }
-	    if (valuePtr != NULL) {
-		p = Tcl_GetStringFromObj(valuePtr, &length);
-	    }
-	    Tcl_AppendToObj(resultPtr, p, length);
-	}
-    }
-    if (resultPtr != NULL) {
-	Tcl_SetObjResult(interp, resultPtr);
-    } else {
-	code = TCL_ERROR;
-    }
-
-    done:
-    if (resultPtr != NULL) {
-	Tcl_DecrRefCount(resultPtr);
-    }
-    return code;
+    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL);
 }
 
 
@@ -3579,7 +3442,7 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 #define NUM_STATIC_OBJS 20
     Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
     Tcl_Token *tokenPtr;
-    int i, code, commandLength, bytesLeft, nested;
+    int i, code, commandLength, bytesLeft;
     CallFrame *savedVarFramePtr;   /* Saves old copy of iPtr->varFramePtr
 				    * in case TCL_EVAL_GLOBAL was set. */
     int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
@@ -3610,31 +3473,14 @@ Tcl_EvalEx(interp, script, numBytes, flags)
     objv = staticObjArray;
     p = script;
     bytesLeft = numBytes;
-    if (iPtr->evalFlags & TCL_BRACKET_TERM) {
-	nested = 1;
-    } else {
-	nested = 0;
-    }
     iPtr->evalFlags = 0;
     do {
-	if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
+	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse)
 	        != TCL_OK) {
 	    code = TCL_ERROR;
 	    goto error;
 	}
 	gotParse = 1; 
-
-	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.
-	     */
-
-	    code = TCL_ERROR;
-	    goto error;
-	}
-
 	if (parse.numWords > 0) {
 	    /*
 	     * Generate an array of objects for the words of the command.
@@ -3649,8 +3495,8 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	    for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
 		    objectsUsed < parse.numWords;
 		    objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
-		code = Tcl_EvalTokensStandard(interp, tokenPtr+1, 
-		            tokenPtr->numComponents);
+		code = TclSubstTokens(interp, tokenPtr+1, 
+		            tokenPtr->numComponents, NULL);
 		if (code == TCL_OK) {
 		    objv[objectsUsed] = Tcl_GetObjResult(interp);
 		    Tcl_IncrRefCount(objv[objectsUsed]);
@@ -3703,20 +3549,7 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	p = next;
 	Tcl_FreeParse(&parse);
 	gotParse = 0;
-	if (nested && (*parse.term == ']')) {
-	    /*
-	     * We get here in the special case where the TCL_BRACKET_TERM
-	     * 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;
-	    iPtr->varFramePtr = savedVarFramePtr;
-	    return TCL_OK;
-	}
     } while (bytesLeft > 0);
-    iPtr->termOffset = p - script;
     iPtr->varFramePtr = savedVarFramePtr;
     return TCL_OK;
 
@@ -3753,85 +3586,6 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	ckfree((char *) objv);
     }
     iPtr->varFramePtr = savedVarFramePtr;
-
-    /*
-     * All that's left to do before returning is to set iPtr->termOffset
-     * to point past the end of the script we just evaluated.
-     */
-
-    next = parse.commandStart + parse.commandSize;
-    bytesLeft -= next - p;
-    p = next;
-
-    if (!nested) {
-	iPtr->termOffset = p - script;
-	return code;
-    }
-
-    /*
-     * 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.
-     */
-
-    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.
-	     */
-
-	    if (next == NULL) {
-	        iPtr->termOffset = (parse.commandStart - 1) - script;
-	    } else {
-	        iPtr->termOffset = (next - 1) - script;
-	    }
-	    return code;
-	}
-	next = parse.commandStart + parse.commandSize;
-	bytesLeft -= next - p;
-	p = next;
-	next = parse.commandStart;
-	Tcl_FreeParse(&parse);
-    }
-
-    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;
-    }
     return code;
 }
 
@@ -3933,9 +3687,6 @@ Tcl_GlobalEvalObj(interp, objPtr)
  *	commands will almost certainly have side effects that depend
  *	on those commands.
  *
- *	Just as in Tcl_Eval, interp->termOffset is set to the offset of the
- *	last character executed in the objPtr's string.
- *
  *----------------------------------------------------------------------
  */
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 2ae4819..4e70522 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.82 2003/02/27 00:54:36 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.83 2003/03/13 02:48:52 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2490,159 +2490,6 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SubstObj --
- *
- *	This function performs the substitutions specified on the
- *	given string as described in the user documentation for the
- *	"subst" Tcl command.  This code is heavily based on an
- *	implementation by Andrew Payne.  Note that if a command
- *	substitution returns TCL_CONTINUE or TCL_RETURN from its
- *	evaluation and is not completely well-formed, the results are
- *	not defined (or at least hard to characterise.)  This fault
- *	will be fixed at some point, but the cost of the only sane
- *	fix (well-formedness check first) is such that you need to
- *	"precompile and cache" to stop everyone from being hit with
- *	the consequences every time through.  Note that the current
- *	behaviour is not a security hole; it just restarts parsing
- *	the string following the substitution in a mildly surprising
- *	place, and it is a very bad idea to count on this remaining
- *	the same in future...
- *
- * Results:
- *	A Tcl_Obj* containing the substituted string, or NULL to
- *	indicate that an error occurred.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-Tcl_SubstObj(interp, objPtr, flags)
-    Tcl_Interp *interp;
-    Tcl_Obj *objPtr;
-    int flags;
-{
-    Tcl_Obj *resultObj;
-    char *p, *old;
-
-    old = p = Tcl_GetString(objPtr);
-    resultObj = Tcl_NewStringObj("", 0);
-    while (1) {
-	switch (*p) {
-	case 0:
-	    if (p != old) {
-		Tcl_AppendToObj(resultObj, old, p-old);
-	    }
-	    return resultObj;
-
-	case '\\':
-	    if (flags & TCL_SUBST_BACKSLASHES) {
-		char buf[TCL_UTF_MAX];
-		int count;
-
-		if (p != old) {
-		    Tcl_AppendToObj(resultObj, old, p-old);
-		}
-		Tcl_AppendToObj(resultObj, buf,
-				Tcl_UtfBackslash(p, &count, buf));
-		p += count;
-		old = p;
-	    } else {
-		p++;
-	    }
-	    break;
-
-	case '$':
-	    if (flags & TCL_SUBST_VARIABLES) {
-		Tcl_Parse parse;
-		int code;
-
-		/*
-		 * Code is simpler overall if we (effectively) inline
-		 * Tcl_ParseVar, particularly as that allows us to use
-		 * a non-string interface when we come to appending
-		 * the variable contents to the result object.  There
-		 * are a few other optimisations that doing this
-		 * enables (like being able to continue the run of
-		 * unsubstituted characters straight through if a '$'
-		 * does not precede a variable name.)
-		 */
-		if (Tcl_ParseVarName(interp, p, -1, &parse, 0) != TCL_OK) {
-		    goto errorResult;
-		}
-		if (parse.numTokens == 1) {
-		    /*
-		     * There isn't a variable name after all: the $ is
-		     * just a $.
-		     */
-		    p++;
-		    break;
-		}
-		if (p != old) {
-		    Tcl_AppendToObj(resultObj, old, p-old);
-		}
-		p += parse.tokenPtr->size;
-		code = Tcl_EvalTokensStandard(interp, parse.tokenPtr,
-		        parse.numTokens);
-		if (code == TCL_ERROR) {
-		    goto errorResult;
-		}
-		if (code == TCL_BREAK) {
-		    Tcl_ResetResult(interp);
-		    return resultObj;
-		}
-		if (code != TCL_CONTINUE) {
-		    Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
-		}
-		Tcl_ResetResult(interp);
-		old = p;
-	    } else {
-		p++;
-	    }
-	    break;
-
-	case '[':
-	    if (flags & TCL_SUBST_COMMANDS) {
-		Interp *iPtr = (Interp *) interp;
-		int code;
-
-		if (p != old) {
-		    Tcl_AppendToObj(resultObj, old, p-old);
-		}
-		iPtr->evalFlags = TCL_BRACKET_TERM;
-		code = Tcl_EvalEx(interp, p+1, -1, 0);
-		switch (code) {
-		case TCL_ERROR:
-		    goto errorResult;
-		case TCL_BREAK:
-		    Tcl_ResetResult(interp);
-		    return resultObj;
-		default:
-		    Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
-		case TCL_CONTINUE:
-		    Tcl_ResetResult(interp);
-		    old = p = (p+1 + iPtr->termOffset + 1);
-		}
-	    } else {
-		p++;
-	    }
-	    break;
-	default:
-	    p++;
-	    break;
-	}
-    }
-
- errorResult:
-    Tcl_DecrRefCount(resultObj);
-    return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_SwitchObjCmd --
  *
  *	This object-based procedure is invoked to process the "switch" Tcl
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 4e5f617..44f6109 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.41 2003/03/06 23:17:09 kennykb Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.42 2003/03/13 02:48:52 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3140,7 +3140,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr)
 	TclEmitOpcode(INST_POP, envPtr);
 	envPtr->currStackDepth = savedStackDepth + 1;
 	code = TclCompileScript(interp, bodyTokenArray[i+1].start,
-		bodyTokenArray[i+1].size, /*nested*/ 0, envPtr);
+		bodyTokenArray[i+1].size, envPtr);
 	if (code != TCL_OK) {
 	    ckfree((char *)argv);
 	    ckfree((char *)bodyTokenArray);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 1465f69..480acfe 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.13 2003/02/16 01:36:32 msofer Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.14 2003/03/13 02:48:52 dgp 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*/ 0, envPtr);
+		    tokenPtr->size-2, envPtr);
 	    if (code != TCL_OK) {
 		goto done;
 	    }
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 704178b..c98348f 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.43 2003/02/19 14:33:39 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.44 2003/03/13 02:48:52 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -348,14 +348,16 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
     CompileHookProc *hookProc;	/* Procedure to invoke after compilation. */
     ClientData clientData;	/* Hook procedure private data. */
 {
+#ifdef TCL_COMPILE_DEBUG
     Interp *iPtr = (Interp *) interp;
+#endif /*TCL_COMPILE_DEBUG*/
     CompileEnv compEnv;		/* Compilation environment structure
 				 * allocated in frame. */
     LiteralTable *localTablePtr = &(compEnv.localLitTable);
     register AuxData *auxDataPtr;
     LiteralEntry *entryPtr;
     register int i;
-    int length, nested, result;
+    int length, result;
     char *string;
 
 #ifdef TCL_COMPILE_DEBUG
@@ -368,21 +370,15 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
     }
 #endif
 
-    if (iPtr->evalFlags & TCL_BRACKET_TERM) {
-	nested = 1;
-    } else {
-	nested = 0;
-    }
     string = Tcl_GetStringFromObj(objPtr, &length);
     TclInitCompileEnv(interp, &compEnv, string, length);
-    result = TclCompileScript(interp, string, length, nested, &compEnv);
+    result = TclCompileScript(interp, string, length, &compEnv);
 
     if (result == TCL_OK) {
 	/*
 	 * Successful compilation. Add a "done" instruction at the end.
 	 */
 
-	compEnv.numSrcBytes = iPtr->termOffset;
 	TclEmitOpcode(INST_DONE, &compEnv);
 
 	/*
@@ -786,10 +782,6 @@ TclFreeCompileEnv(envPtr)
  *	on failure. If TCL_ERROR is returned, then the interpreter's result
  *	contains an error message.
  *
- *	interp->termOffset is set to the offset of the character in the
- *	script just after the last one successfully processed; this will be
- *	the offset of the ']' if (flags & TCL_BRACKET_TERM).
- *
  * Side effects:
  *	Adds instructions to envPtr to evaluate the script at runtime.
  *
@@ -797,7 +789,7 @@ TclFreeCompileEnv(envPtr)
  */
 
 int
-TclCompileScript(interp, script, numBytes, nested, envPtr)
+TclCompileScript(interp, script, numBytes, envPtr)
     Tcl_Interp *interp;		/* Used for error and status reporting.
 				 * Also serves as context for finding and
 				 * compiling commands.  May not be NULL. */
@@ -805,10 +797,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
     int numBytes;		/* Number of bytes in script. If < 0, the
 				 * script consists of all bytes up to the
 				 * first null character. */
-    int nested;			/* Non-zero means this is a nested command:
-				 * close bracket ']' should be considered a
-				 * command terminator. If zero, close
-				 * bracket has no special meaning. */
     CompileEnv *envPtr;		/* Holds resulting instructions. */
 {
     Interp *iPtr = (Interp *) interp;
@@ -845,55 +833,11 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
     bytesLeft = numBytes;
     gotParse = 0;
     do {
-	if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
+	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &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
@@ -903,11 +847,8 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 
 	    if (!isFirstCmd) {
 		TclEmitOpcode(INST_POP, envPtr);
-		if (!nested) {
-		    envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
-			   (envPtr->codeNext - envPtr->codeStart)
-			   - startCodeOffset;
-		}
+		envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
+			(envPtr->codeNext - envPtr->codeStart) - startCodeOffset;
 	    }
 
 	    /*
@@ -931,8 +872,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
              * If tracing, print a line for each top level command compiled.
              */
 
-	    if ((tclTraceCompile >= 1)
-		    && !nested && (envPtr->procPtr == NULL)) {
+	    if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
 		fprintf(stdout, "  Compiling: ");
 		TclPrintSource(stdout, parse.commandStart,
 			TclMin(commandLength, 55));
@@ -946,9 +886,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 	    
 	    envPtr->numCommands++;
 	    currCmdIndex = (envPtr->numCommands - 1);
-	    if (!nested) {
-		lastTopLevelCmdIndex = currCmdIndex;
-	    }
+	    lastTopLevelCmdIndex = currCmdIndex;
 	    startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
 	    EnterCmdStartData(envPtr, currCmdIndex,
 	            (parse.commandStart - envPtr->source), startCodeOffset);
@@ -1071,16 +1009,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 	p = next;
 	Tcl_FreeParse(&parse);
 	gotParse = 0;
-	if (nested && (*parse.term == ']')) {
-	    /*
-	     * We get here in the special case where TCL_BRACKET_TERM was
-	     * 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);
 
     /*
@@ -1093,17 +1021,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
 	        envPtr);
     }
     
-    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);
-    }
+    envPtr->numSrcBytes = (p - script);
     Tcl_DStringFree(&ds);
     return TCL_OK;
 	
@@ -1132,7 +1050,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
     if (gotParse) {
 	Tcl_FreeParse(&parse);
     }
-    iPtr->termOffset = (p - script);
+    envPtr->numSrcBytes = (p - script);
     Tcl_DStringFree(&ds);
     return code;
 }
@@ -1207,7 +1125,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
 		}
 		
 		code = TclCompileScript(interp, tokenPtr->start+1,
-			tokenPtr->size-2, /*nested*/ 0,	envPtr);
+			tokenPtr->size-2, envPtr);
 		if (code != TCL_OK) {
 		    goto error;
 		}
@@ -1396,8 +1314,7 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
      */
     
     if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
-	code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
-	        /*nested*/ 0, envPtr);
+	code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
 	return code;
     }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 8d5e209..bdd9ecc 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -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: tclCompile.h,v 1.34 2003/03/05 22:31:23 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.35 2003/03/13 02:48:53 dgp Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -748,8 +748,7 @@ EXTERN int		TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int numWords,
 			    CompileEnv *envPtr));
 EXTERN int		TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *script, int numBytes, int nested,
-			    CompileEnv *envPtr));
+			    CONST char *script, int numBytes, CompileEnv *envPtr));
 EXTERN int		TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int count,
 			    CompileEnv *envPtr));
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 18bba5d..2496126 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.94 2003/02/19 14:33:39 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.95 2003/03/13 02:48:53 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -831,7 +831,6 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
 	 * and aux data items is given to the ByteCode object.
 	 */
 
-	compEnv.numSrcBytes = iPtr->termOffset;
 	TclEmitOpcode(INST_DONE, &compEnv);
 	TclInitByteCodeObj(objPtr, &compEnv);
 	TclFreeCompileEnv(&compEnv);
@@ -1037,16 +1036,7 @@ TclCompEvalObj(interp, objPtr)
 	}
     }
 
-    /*
-     * Set the interpreter's termOffset member to the offset of the
-     * character just after the last one executed. We approximate the offset
-     * of the last character executed by using the number of characters
-     * compiled. 
-     */
-
-    iPtr->termOffset = numSrcBytes;
     iPtr->flags &= ~ERR_ALREADY_LOGGED;
-
     return result;
 }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3bac4d9..cd68b14 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.119 2003/03/05 22:31:24 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.120 2003/03/13 02:48:53 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -1249,8 +1249,7 @@ typedef struct Interp {
 				 * Normally zero, but may be set before
 				 * calling Tcl_Eval.  See below for valid
 				 * values. */
-    int termOffset;		/* Offset of character just after last one
-				 * compiled or executed by Tcl_EvalObj. */
+    int unused1;		/* No longer used (was termOffset) */
     LiteralTable literalTable;	/* Contains LiteralEntry's describing all
 				 * Tcl objects holding literals of scripts
 				 * compiled by the interpreter. Indexed by
@@ -1320,14 +1319,11 @@ typedef struct Interp {
 /*
  * EvalFlag bits for Interp structures:
  *
- * TCL_BRACKET_TERM	1 means that the current script is terminated by
- *			a close bracket rather than the end of the string.
  * TCL_ALLOW_EXCEPTIONS	1 means it's OK for the script to terminate with
  *			a code other than TCL_OK or TCL_ERROR;	0 means
  *			codes other than these should be turned into errors.
  */
 
-#define TCL_BRACKET_TERM	  1
 #define TCL_ALLOW_EXCEPTIONS	  4
 
 /*
@@ -1802,7 +1798,10 @@ EXTERN void		TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex));
 EXTERN VOID             TclRememberJoinableThread _ANSI_ARGS_((Tcl_ThreadId id));
 EXTERN void		TclRememberMutex _ANSI_ARGS_((Tcl_Mutex *mutex));
 EXTERN VOID             TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id,
-			     int result));
+			    int result));
+EXTERN int		TclSubstTokens _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Token *tokenPtr, int count,
+			    int *tokensLeftPtr));
 EXTERN void		TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
 			    int result, Tcl_Interp *targetInterp));
 EXTERN Tcl_Obj*         TclpNativeToNormalized 
diff --git a/generic/tclParse.c b/generic/tclParse.c
index ec8c9f0..5a7bb92 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.25 2003/02/16 01:36:32 msofer Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.26 2003/03/13 02:48:53 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -179,7 +179,7 @@ static int		CommandComplete _ANSI_ARGS_((CONST char *script,
 static int		ParseComment _ANSI_ARGS_((CONST char *src, int numBytes,
 			    Tcl_Parse *parsePtr));
 static int		ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,
-			    int mask, Tcl_Parse *parsePtr));
+			    int mask, int flags, Tcl_Parse *parsePtr));
 
 /*
  *----------------------------------------------------------------------
@@ -343,7 +343,7 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
 	     */
 
 	    if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
-		    parsePtr) != TCL_OK) {
+		    TCL_SUBST_ALL, parsePtr) != TCL_OK) {
 		goto error;
 	    }
 	    src = parsePtr->term; numBytes = parsePtr->end - src;
@@ -785,9 +785,13 @@ ParseComment(src, numBytes, parsePtr)
  */
 
 static int
-ParseTokens(src, numBytes, mask, parsePtr)
+ParseTokens(src, numBytes, mask, flags, parsePtr)
     register CONST char *src;	/* First character to parse. */
     register int numBytes;	/* Max number of bytes to scan. */
+    int flags;			/* OR-ed bits indicating what substitutions
+				   to perform: TCL_SUBST_COMMANDS,
+				   TCL_SUBST_VARIABLES, and 
+				   TCL_SUBST_BACKSLASHES */
     int mask;			/* Specifies when to stop parsing.  The
 				 * parse stops at the first unquoted
 				 * character whose CHAR_TYPE contains
@@ -798,6 +802,9 @@ ParseTokens(src, numBytes, mask, parsePtr)
 {
     char type; 
     int originalTokens, varToken;
+    int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
+    int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
+    int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
     Tcl_Token *tokenPtr;
     Tcl_Parse nested;
 
@@ -831,6 +838,13 @@ ParseTokens(src, numBytes, mask, parsePtr)
 	    tokenPtr->size = src - tokenPtr->start;
 	    parsePtr->numTokens++;
 	} else if (*src == '$') {
+	    if (noSubstVars) {
+		tokenPtr->type = TCL_TOKEN_TEXT;
+		tokenPtr->size = 1;
+		parsePtr->numTokens++;
+		src++; numBytes--;
+		continue;
+	    }
 	    /*
 	     * This is a variable reference.  Call Tcl_ParseVarName to do
 	     * all the dirty work of parsing the name.
@@ -844,6 +858,13 @@ ParseTokens(src, numBytes, mask, parsePtr)
 	    src += parsePtr->tokenPtr[varToken].size;
 	    numBytes -= parsePtr->tokenPtr[varToken].size;
 	} else if (*src == '[') {
+	    if (noSubstCmds) {
+		tokenPtr->type = TCL_TOKEN_TEXT;
+		tokenPtr->size = 1;
+		parsePtr->numTokens++;
+		src++; numBytes--;
+		continue;
+	    }
 	    /*
 	     * Command substitution.  Call Tcl_ParseCommand recursively
 	     * (and repeatedly) to parse the nested command(s), then
@@ -896,6 +917,13 @@ ParseTokens(src, numBytes, mask, parsePtr)
 	    tokenPtr->size = src - tokenPtr->start;
 	    parsePtr->numTokens++;
 	} else if (*src == '\\') {
+	    if (noSubstBS) {
+		tokenPtr->type = TCL_TOKEN_TEXT;
+		tokenPtr->size = 1;
+		parsePtr->numTokens++;
+		src++; numBytes--;
+		continue;
+	    }
 	    /*
 	     * Backslash substitution.
 	     */
@@ -1210,8 +1238,8 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
 	     * since it could contain any number of substitutions.
 	     */
 
-	    if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
-		    != TCL_OK) {
+	    if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN,
+		    TCL_SUBST_ALL, parsePtr)) {
 		goto error;
 	    }
 	    if ((parsePtr->term == (src + numBytes)) 
@@ -1302,7 +1330,7 @@ Tcl_ParseVar(interp, string, termPtr)
 	return "$";
     }
 
-    code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);
+    code = TclSubstTokens(interp, parse.tokenPtr, parse.numTokens, NULL);
     if (code != TCL_OK) {
 	return NULL;
     }
@@ -1606,7 +1634,8 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
 	parsePtr->errorType = TCL_PARSE_SUCCESS;
     }
     
-    if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
+    if (TCL_OK != ParseTokens(string+1, numBytes-1, TYPE_QUOTE,
+	    TCL_SUBST_ALL, parsePtr)) {
 	goto error;
     }
     if (*parsePtr->term != '"') {
@@ -1631,6 +1660,420 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_SubstObj --
+ *
+ *      This function performs the substitutions specified on the
+ *      given string as described in the user documentation for the
+ *      "subst" Tcl command.       
+ *
+ * Results:
+ *      A Tcl_Obj* containing the substituted string, or NULL to
+ *      indicate that an error occurred.
+ *
+ * Side effects:
+ *      See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_SubstObj(interp, objPtr, flags)
+    Tcl_Interp *interp;	/* Interpreter in which substitution occurs */
+    Tcl_Obj *objPtr;	/* The value to be substituted */
+    int flags;		/* What substitutions to do */
+{
+    int length, tokensLeft, code;
+    Tcl_Parse parse;
+    Tcl_Token *endTokenPtr;
+    Tcl_Obj *result;
+    Tcl_Obj *errMsg = NULL;
+    CONST char *p = Tcl_GetStringFromObj(objPtr, &length);
+
+    parse.tokenPtr = parse.staticTokens;
+    parse.numTokens = 0;
+    parse.tokensAvailable = NUM_STATIC_TOKENS;
+    parse.string = p;
+    parse.end = p + length;
+    parse.term = parse.end;
+    parse.interp = interp;
+    parse.incomplete = 0;
+    parse.errorType = TCL_PARSE_SUCCESS;
+
+    /*
+     * First parse the string rep of objPtr, as if it were enclosed
+     * as a "-quoted word in a normal Tcl command.  Honor flags that
+     * selectively inhibit types of substitution.
+     */
+
+    if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, &parse)) {
+
+	/*
+	 * There was a parse error.  Save the error message for
+	 * possible reporting later.
+	 */
+
+	errMsg = Tcl_GetObjResult(interp);
+	Tcl_IncrRefCount(errMsg);
+
+	/*
+	 * We need to re-parse to get the portion of the string we can
+	 * [subst] before the parse error.  Sadly, all the Tcl_Token's
+	 * created by the first parse attempt are gone, freed according to the
+	 * public spec for the Tcl_Parse* routines.  The only clue we have
+	 * is parse.term, which points to either the unmatched opener, or
+	 * to characters that follow a close brace or close quote.
+	 *
+	 * Call ParseTokens again, working on the string up to parse.term.
+	 * Keep repeating until we get a good parse on a prefix.
+	 */
+
+	do {
+	    parse.numTokens = 0;
+	    parse.tokensAvailable = NUM_STATIC_TOKENS;
+	    parse.end = parse.term;
+	    parse.incomplete = 0;
+	    parse.errorType = TCL_PARSE_SUCCESS;
+	} while (TCL_OK != ParseTokens(p, parse.end - p, 0, flags, &parse));
+
+	/* The good parse will have to be followed by {, (, or [. */
+	switch (*parse.term) {
+	    case '{':
+		/*
+		 * Parse error was a missing } in a ${varname} variable
+		 * substitution at the toplevel.  We will subst everything
+		 * up to that broken variable substitution before reporting
+		 * the parse error.  Substituting the leftover '$' will
+		 * have no side-effects, so the current token stream is fine.
+		 */
+		break;
+	    case '(':
+		/*
+		 * Parse error was during the parsing of the index part of
+		 * an array variable substitution at the toplevel.  
+		 */
+		if (*(parse.term - 1) == '$') {
+		    /*
+		     * Special case where removing the array index left
+		     * us with just a dollar sign (array variable with
+		     * name the empty string as its name), instead of
+		     * with a scalar variable reference.  
+		     *
+		     * As in the previous case, existing token stream is OK.
+		     */
+		} else {
+		   /* The current parse includes a successful parse of a
+		    * scalar variable substitution where there should have
+		    * been an array variable substitution.  We remove that
+		    * mistaken part of the parse before moving on.  A scalar
+		    * variable substitution is two tokens.
+		    */
+		    Tcl_Token *varTokenPtr =
+			    parse.tokenPtr + parse.numTokens - 2;
+
+		    if (varTokenPtr->type != TCL_TOKEN_VARIABLE) {
+			Tcl_Panic("Tcl_SubstObj: programming error");
+		    }
+		    if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
+			Tcl_Panic("Tcl_SubstObj: programming error");
+		    }
+		    parse.numTokens -= 2;
+		}
+		break;
+	    case '[':
+		/*
+		 * Parse error occurred during parsing of a toplevel
+		 * command substitution.  
+		 */
+
+		parse.end = p + length;
+		p = parse.term + 1;
+		length = parse.end - p;
+		if (length == 0) {
+		    /*
+		     * No commands, just an unmatched [.  
+		     * As in previous cases, existing token stream is OK.
+		     */
+		} else {
+		    /* 
+		     * We want to add the parsing of as many commands as we
+		     * can within that substitution until we reach the
+		     * actual parse error.  We'll do additional parsing to
+		     * determine what length to claim for the final
+		     * TCL_TOKEN_COMMAND token.
+		     */
+		    Tcl_Token *tokenPtr;
+		    Tcl_Parse nested;
+		    CONST char *lastTerm = parse.term;
+
+		    while (TCL_OK == 
+			    Tcl_ParseCommand(NULL, p, length, 0, &nested)) {
+			Tcl_FreeParse(&nested);
+			p = nested.term + (nested.term < nested.end);
+			length = nested.end - p;
+			if (length == 0) {
+			    /*
+			     * If we run out of string, blame the missing
+			     * close bracket on the last command, and do
+			     * not evaluate it during substitution.
+			     */
+			    break;
+			}
+			lastTerm = nested.term;
+		    }
+
+		    if (lastTerm == parse.term) {
+			/*
+			 * Parse error in first command.  No commands
+			 * to subst, add no more tokens.
+			 */
+			break;
+		    }
+
+		    /*
+		     * Create a command substitution token for whatever
+		     * commands got parsed.
+		     */
+
+		    if (parse.numTokens == parse.tokensAvailable) {
+			TclExpandTokenArray(&parse);
+		    }
+		    tokenPtr = &parse.tokenPtr[parse.numTokens];
+		    tokenPtr->start = parse.term;
+		    tokenPtr->numComponents = 0;
+		    tokenPtr->type = TCL_TOKEN_COMMAND;
+		    tokenPtr->size = lastTerm - tokenPtr->start + 1;
+		    parse.numTokens++;
+		}
+		break;
+
+	    default:
+		Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]);
+	}
+    }
+
+    /* Next, substitute the parsed tokens just as in normal Tcl evaluation */
+    endTokenPtr = parse.tokenPtr + parse.numTokens;
+    tokensLeft = parse.numTokens;
+    code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
+	    &tokensLeft);
+    if (code == TCL_OK) {
+	Tcl_FreeParse(&parse);
+	if (errMsg != NULL) {
+	    Tcl_SetObjResult(interp, errMsg);
+	    Tcl_DecrRefCount(errMsg);
+	    return NULL;
+	}
+	return Tcl_GetObjResult(interp);
+    }
+    result = Tcl_NewObj();
+    while (1) {
+	switch (code) {
+	    case TCL_ERROR:
+		Tcl_FreeParse(&parse);
+		Tcl_DecrRefCount(result);
+		if (errMsg != NULL) {
+		    Tcl_DecrRefCount(errMsg);
+		}
+		return NULL;
+	    case TCL_BREAK:
+		tokensLeft = 0;		/* Halt substitution */
+	    default:
+		Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp));
+	}
+
+	if (tokensLeft == 0) {
+	    Tcl_FreeParse(&parse);
+	    if (errMsg != NULL) {
+		if (code != TCL_BREAK) {
+		    Tcl_SetObjResult(interp, errMsg);
+		    Tcl_DecrRefCount(errMsg);
+		    return NULL;
+		}
+		Tcl_DecrRefCount(errMsg);
+	    }
+	    return result;
+	}
+
+	code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
+		&tokensLeft);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSubstTokens --
+ *
+ *	Accepts an array of count Tcl_Token's, and creates a result
+ *	value in the interp from concatenating the results of 
+ *	performing Tcl substitution on each Tcl_Token.  Substitution
+ *	is interrupted if any non-TCL_OK completion code arises.
+ *
+ * Results:
+ * 	The return value is a standard Tcl completion code.  The
+ * 	result in interp is the substituted value, or an error message
+ * 	if TCL_ERROR is returned.  If tokensLeftPtr is not NULL, then
+ * 	it points to an int where the number of tokens remaining to
+ * 	be processed is written.
+ *
+ * Side effects:
+ * 	Can be anything, depending on the types of substitution done.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclSubstTokens(interp, tokenPtr, count, tokensLeftPtr)
+    Tcl_Interp *interp;         /* Interpreter in which to lookup
+                                 * variables, execute nested commands,
+                                 * and report errors. */
+    Tcl_Token *tokenPtr;        /* Pointer to first in an array of tokens
+                                 * to evaluate and concatenate. */
+    int count;                  /* Number of tokens to consider at tokenPtr.
+                                 * Must be at least 1. */
+    int *tokensLeftPtr;		/* If not NULL, points to memory where an
+				 * integer representing the number of tokens
+				 * left to be substituted will be written */
+{
+    Tcl_Obj *result;
+    int code = TCL_OK;
+
+    /*
+     * Each pass through this loop will substitute one token, and its
+     * components, if any.  The only thing tricky here is that we go to
+     * some effort to pass Tcl_Obj's through untouched, to avoid string
+     * copying and Tcl_Obj creation if possible, to aid performance and
+     * limit shimmering.
+     *
+     * Further optimization opportunities might be to check for the
+     * equivalent of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp))
+     * and omit them.
+     */
+
+    result = NULL;
+    for ( ; (count > 0) && (code == TCL_OK); count--, tokenPtr++) {
+	Tcl_Obj *appendObj = NULL;
+	CONST char *append = NULL;
+	int appendByteLength = 0;
+
+	switch (tokenPtr->type) {
+	    case TCL_TOKEN_TEXT:
+		append = tokenPtr->start;
+		appendByteLength = tokenPtr->size;
+		break;
+
+	    case TCL_TOKEN_BS: {
+		char utfCharBytes[TCL_UTF_MAX];
+		appendByteLength = Tcl_UtfBackslash(tokenPtr->start,
+			(int *) NULL, utfCharBytes);
+		append = utfCharBytes;
+		break;
+	    }
+
+	    case TCL_TOKEN_COMMAND:
+		code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
+			0);
+		appendObj = Tcl_GetObjResult(interp);
+		break;
+
+	    case TCL_TOKEN_VARIABLE: {
+		Tcl_Obj *arrayIndex = NULL;
+		Tcl_Obj *varName = NULL;
+		if (tokenPtr->numComponents > 1) {
+		    /* Subst the index part of an array variable reference */
+		    code = TclSubstTokens(interp, tokenPtr+2,
+			    tokenPtr->numComponents - 1, NULL);
+		    arrayIndex = Tcl_GetObjResult(interp);
+		    Tcl_IncrRefCount(arrayIndex);
+		}
+
+		if (code == TCL_OK) {
+		    varName = Tcl_NewStringObj(tokenPtr[1].start,
+			    tokenPtr[1].size);
+		    appendObj = Tcl_ObjGetVar2(interp, varName, arrayIndex,
+			    TCL_LEAVE_ERR_MSG);
+		    Tcl_DecrRefCount(varName);
+		    if (appendObj == NULL) {
+			code = TCL_ERROR;
+		    }
+		}
+
+		switch (code) {
+		    case TCL_OK:	/* Got value */
+		    case TCL_ERROR:	/* Already have error message */
+		    case TCL_BREAK:	/* Will not substitute anyway */
+		    case TCL_CONTINUE:	/* Will not substitute anyway */
+			break;
+		    default:
+			/* All other return codes, we will subst the
+			 * result from the code-throwing evaluation */
+			appendObj = Tcl_GetObjResult(interp);
+		}
+
+		if (arrayIndex != NULL) {
+		    Tcl_DecrRefCount(arrayIndex);
+		}
+		count -= tokenPtr->numComponents;
+		tokenPtr += tokenPtr->numComponents;
+		break;
+	    }
+
+	    default:
+		Tcl_Panic("unexpected token type in TclSubstTokens: %d",
+			tokenPtr->type);
+	}
+
+	if ((code == TCL_BREAK) || (code == TCL_CONTINUE)) {
+	    /* Inhibit substitution */
+	    continue;
+	}
+
+	if (result == NULL) {
+	    /* 
+	     * First pass through.  If we have a Tcl_Obj, just use it.
+	     * If not, create one from our string. 
+	     */
+
+	    if (appendObj != NULL) {
+		result = appendObj;
+	    } else {
+		result = Tcl_NewStringObj(append, appendByteLength);;
+	    }
+	    Tcl_IncrRefCount(result);
+	} else {
+	    /* Subsequent passes.  Append to result. */
+	    if (Tcl_IsShared(result)) {
+		Tcl_DecrRefCount(result);
+		result = Tcl_DuplicateObj(result);
+		Tcl_IncrRefCount(result);
+	    }
+	    if (appendObj != NULL) {
+		Tcl_AppendObjToObj(result, appendObj);
+	    } else {
+		Tcl_AppendToObj(result, append, appendByteLength);
+	    }
+	}
+    }
+
+    if (code != TCL_ERROR) {	/* Keep error message in result! */
+	if (result != NULL) {
+	    Tcl_SetObjResult(interp, result);
+	} else {
+	    Tcl_ResetResult(interp);
+	}
+    }
+    if (tokensLeftPtr != NULL) {
+	*tokensLeftPtr = count;
+    }
+    if (result != NULL) {
+	Tcl_DecrRefCount(result);
+    }
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * CommandComplete --
  *
  *	This procedure is shared by TclCommandComplete and
diff --git a/tests/subst.test b/tests/subst.test
index 0e46f02..0d3147a 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -11,10 +11,10 @@
 # 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.13 2003/02/16 01:36:32 msofer Exp $
+# RCS: @(#) $Id: subst.test,v 1.14 2003/03/13 02:48:54 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2.1
     namespace import -force ::tcltest::*
 }
 
@@ -34,6 +34,10 @@ test subst-2.2 {simple strings} {
 test subst-2.3 {simple strings} {
     subst abcdefg
 } abcdefg
+test subst-2.4 {simple strings} {
+    # Tcl Bug 685106
+    subst [bytestring bar\x00soom]
+} [bytestring bar\x00soom]
 
 test subst-3.1 {backslash substitutions} {
     subst {\x\$x\[foo bar]\\}
@@ -158,12 +162,12 @@ test subst-8.5 {return in a subst} {
 test subst-8.6 {return in a subst} {
     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} {
+test subst-8.7 {return in a subst, parse error} -body {
     subst {foo [return {x} ; set a {}" ; stuff] bar}
-} {foo xset a {}" ; stuff] bar}
-test subst-8.8 {return in a subst, parse error} {
+} -returnCodes error -result {extra characters after close-brace}
+test subst-8.8 {return in a subst, parse error} -body {
     subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
-} {foo xset bar baz ; set a {}" ; stuff] bar}
+} -returnCodes error -result {extra characters after close-brace}
 test subst-8.9 {return in a variable subst} {
     subst {foo $var([return {x}]) bar}
 } {foo x bar}
@@ -206,12 +210,12 @@ test subst-11.2 {continue in a subst} {
 test subst-11.3 {continue in a subst} {
     subst {foo [if 1 { continue; bogus code}] bar}
 } {foo  bar}
-test subst-11.4 {continue in a subst, parse error} {
+test subst-11.4 {continue in a subst, parse error} -body {
     subst {foo [continue ; set a {}{} ; stuff] bar}
-} {foo set a {}{} ; stuff] bar}
-test subst-11.5 {continue in a subst, parse error} {
+} -returnCodes error -result {extra characters after close-brace}
+test subst-11.5 {continue in a subst, parse error} -body {
     subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar}
-} {foo set bar baz ;set a {}{} ; stuff] bar}
+} -returnCodes error -result {extra characters after close-brace}
 test subst-11.6 {continue in a variable subst} {
     subst {foo $var([continue]) bar}
 } {foo  bar}
-- 
cgit v0.12