Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.603
diff -u -r1.603 ChangeLog
--- ChangeLog	2001/09/12 16:32:21	1.603
+++ ChangeLog	2001/09/12 18:14:05
@@ -1,3 +1,17 @@
+2001-08-28  Miguel Sofer  <msofer@users.sourceforge.net>
+ 
+  	* doc/ParseCmd.3: 
+ 	* generic/tcl.decls:
+ 	* generic/tclCmdMZ.c (Tcl_SubstObjCmd):
+ 	* generic/tclDecls.h:
+ 	* generic/tclParse.c:
+ 	* generic/tclStubInit.c:
+ 	* tests/parse.test: Deprecate the use of Tcl_EvalTokens, replaced
+ 	by the new Tcl_EvalTokensStandard. The new function performs the
+ 	same duties but adheres to the standard return convention for Tcl
+ 	evaluations; the deprecated function could only return TCL_OK or
+ 	TCL_ERROR, which caused [Bug: 219384] and [Bug: 455151].
+ 
 2001-09-12  Miguel Sofer  <msofer@users.sourceforge.net>
 
 	* generic/tcl.decls: reserved stub #481 for the implementation of
Index: doc/ParseCmd.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/ParseCmd.3,v
retrieving revision 1.4
diff -u -r1.4 ParseCmd.3
--- doc/ParseCmd.3	2000/04/24 23:53:03	1.4
+++ doc/ParseCmd.3	2001/09/12 18:14:06
@@ -10,7 +10,9 @@
 .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens \- parse Tcl scripts and expressions
+Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces,
+Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse,
+Tcl_EvalTokens, BTcl_EvalTokensStandard \- parse Tcl scripts and expressions
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -37,13 +39,17 @@
 .sp
 Tcl_Obj *
 \fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR)
+.sp
+Tcl_Obj *
+\fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR)
 .SH ARGUMENTS
 .AS Tcl_Interp *usedParsePtr
 .AP Tcl_Interp *interp out
-For procedures other than \fBTcl_FreeParse\fR and \fBTcl_EvalTokens\fR,
-used only for error reporting;
+For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR
+and \fBTcl_EvalTokensStandard\fR, used only for error reporting;
 if NULL, then no error messages are left after errors.
-For \fBTcl_EvalTokens\fR, determines the context for evaluating the
+For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR,
+determines the context for evaluating the
 script and also is used for error reporting; must not be NULL.
 .AP char *string in
 Pointer to first character in string to parse.
@@ -178,18 +184,27 @@
 so if repeated calls are being made to any of them
 then \fBTcl_FreeParse\fR must be invoked once after each call.
 .PP
-\fBTcl_EvalTokens\fR evaluates a sequence of parse tokens from a Tcl_Parse
-structure.  The tokens typically consist
+\fBTcl_EvalTokensStandard\fR evaluates a sequence of parse tokens from
+a Tcl_Parse structure.  The tokens typically consist
 of all the tokens in a word or all the tokens that make up the index for
-a reference to an array variable.  \fBTcl_EvalTokens\fR performs the
-substitutions requested by the tokens, concatenates the
-resulting values, and returns the result in a new Tcl_Obj.  The
-reference count of the object returned as result has been
+a reference to an array variable.  \fBTcl_EvalTokensStandard\fR performs the
+substitutions requested by the tokens and concatenates the
+resulting values. 
+The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion
+code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR,
+\fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR.
+In addition, a result value or error message is left in \fIinterp\fR's
+result; it can be retrieved using \fBTcl_GetObjResult\fR.
+.PP
+\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in
+the return convention used: it returns the result in a new Tcl_Obj.
+The reference count of the object returned as result has been
 incremented, so the caller must
 invoke \fBTcl_DecrRefCount\fR when it is finished with the object.
-If an error occurs while evaluating the tokens (such as a reference to
-a non-existent variable) then the return value is NULL and an error
-message is left in \fIinterp\fR's result.
+If an error or other exception occurs while evaluating the tokens
+(such as a reference to a non-existent variable) then the return value
+is NULL and an error message is left in \fIinterp\fR's result. The use
+of \fBTcl_EvalTokens\fR is deprecated.
 
 .SH "TCL_PARSE STRUCTURE"
 .PP
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.57
diff -u -r1.57 tcl.decls
--- generic/tcl.decls	2001/09/12 16:32:21	1.57
+++ generic/tcl.decls	2001/09/12 18:14:08
@@ -1682,9 +1682,9 @@
     void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)
 }	  
 # New function due to TIP#56
-#declare 481 generic {
-#    int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count)
-#}
+declare 481 generic {
+    int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count)
+}
  
 ##############################################################################
 
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.43
diff -u -r1.43 tclCmdMZ.c
--- generic/tclCmdMZ.c	2001/08/07 00:56:15	1.43
+++ generic/tclCmdMZ.c	2001/09/12 18:14:10
@@ -2371,7 +2371,7 @@
 	case '$':
 	    if (flags & TCL_SUBST_VARIABLES) {
 		Tcl_Parse parse;
-		Tcl_Obj *tempObj;
+		int code;
 
 		/*
 		 * Code is simpler overall if we (effectively) inline
@@ -2398,13 +2398,13 @@
 		    Tcl_AppendToObj(resultObj, old, p-old);
 		}
 		p += parse.tokenPtr->size;
-		tempObj = Tcl_EvalTokens(interp, parse.tokenPtr,
-					 parse.numTokens);
-		if (tempObj == NULL) {
+		code = Tcl_EvalTokensStandard(interp, parse.tokenPtr,
+		        parse.numTokens);
+		if (code != TCL_OK) {
 		    goto errorResult;
 		}
-		Tcl_AppendObjToObj(resultObj, tempObj);
-		Tcl_DecrRefCount(tempObj);
+		Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
+		Tcl_ResetResult(interp);
 		old = p;
 	    } else {
 		p++;
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.57
diff -u -r1.57 tclDecls.h
--- generic/tclDecls.h	2001/09/06 17:51:00	1.57
+++ generic/tclDecls.h	2001/09/12 18:14:14
@@ -1500,6 +1500,10 @@
 /* 480 */
 EXTERN void		Tcl_FSMountsChanged _ANSI_ARGS_((
 				Tcl_Filesystem * fsPtr));
+/* 481 */
+EXTERN int		Tcl_EvalTokensStandard _ANSI_ARGS_((
+				Tcl_Interp * interp, Tcl_Token * tokenPtr, 
+				int count));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -2040,6 +2044,7 @@
     Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); /* 478 */
     int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */
     void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 480 */
+    int (*tcl_EvalTokensStandard) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 481 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -4003,6 +4008,10 @@
 #ifndef Tcl_FSMountsChanged
 #define Tcl_FSMountsChanged \
 	(tclStubsPtr->tcl_FSMountsChanged) /* 480 */
+#endif
+#ifndef Tcl_EvalTokensStandard
+#define Tcl_EvalTokensStandard \
+	(tclStubsPtr->tcl_EvalTokensStandard) /* 481 */
 #endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclParse.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclParse.c,v
retrieving revision 1.15
diff -u -r1.15 tclParse.c
--- generic/tclParse.c	2001/05/03 21:14:57	1.15
+++ generic/tclParse.c	2001/09/12 18:14:16
@@ -1117,28 +1117,26 @@
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalTokens --
+ * Tcl_EvalTokensStandard --
  *
  *	Given an array of tokens parsed from a Tcl command (e.g., the
  *	tokens that make up a word or the index for an array variable)
  *	this procedure evaluates the tokens and concatenates their
  *	values to form a single result value.
- *
+ * 
  * Results:
- *	The return value is a pointer to a newly allocated Tcl_Obj
- *	containing the value of the array of tokens.  The reference
- *	count of the returned object has been incremented.  If an error
- *	occurs in evaluating the tokens then a NULL value is returned
- *	and an error message is left in interp's result.
+ *	The return value is a standard Tcl completion code such as
+ *	TCL_OK or TCL_ERROR.  A result or error message is left in
+ *	interp's result.
  *
  * Side effects:
- *	A new object is allocated to hold the result.
- *
+ *	Depends on the array of tokens being evaled.
+  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-Tcl_EvalTokens(interp, tokenPtr, count)
+int
+Tcl_EvalTokensStandard(interp, tokenPtr, count)
     Tcl_Interp *interp;		/* Interpreter in which to lookup
 				 * variables, execute nested commands,
 				 * and report errors. */
@@ -1166,7 +1164,9 @@
      * command's result object directly.
      */
 
+    code = TCL_OK;
     resultPtr = NULL;
+    Tcl_ResetResult(interp);
     for ( ; count > 0; count--, tokenPtr++) {
 	valuePtr = NULL;
 
@@ -1192,7 +1192,7 @@
 		code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
 			0);
 		if (code != TCL_OK) {
-		    goto error;
+		    goto done;
 		}
 		valuePtr = Tcl_GetObjResult(interp);
 		break;
@@ -1200,12 +1200,16 @@
 	    case TCL_TOKEN_VARIABLE:
 		if (tokenPtr->numComponents == 1) {
 		    indexPtr = NULL;
+		    index = NULL;
 		} else {
-		    indexPtr = Tcl_EvalTokens(interp, tokenPtr+2,
+		    code = Tcl_EvalTokensStandard(interp, tokenPtr+2,
 			    tokenPtr->numComponents - 1);
-		    if (indexPtr == NULL) {
-			goto error;
+		    if (code != TCL_OK) {
+			goto done;
 		    }
+		    indexPtr = Tcl_GetObjResult(interp);
+		    Tcl_IncrRefCount(indexPtr);
+		    index = Tcl_GetString(indexPtr);
 		}
 
 		/*
@@ -1223,11 +1227,6 @@
 		}
 		strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
 		varName[tokenPtr[1].size] = 0;
-		if (indexPtr != NULL) {
-		    index = TclGetString(indexPtr);
-		} else {
-		    index = NULL;
-		}
 		valuePtr = Tcl_GetVar2Ex(interp, varName, index,
 			TCL_LEAVE_ERR_MSG);
 		if (varName != nameBuffer) {
@@ -1237,14 +1236,15 @@
 		    Tcl_DecrRefCount(indexPtr);
 		}
 		if (valuePtr == NULL) {
-		    goto error;
+		    code = TCL_ERROR;
+		    goto done;
 		}
 		count -= tokenPtr->numComponents;
 		tokenPtr += tokenPtr->numComponents;
 		break;
 
 	    default:
-		panic("unexpected token type in Tcl_EvalTokens");
+		panic("unexpected token type in Tcl_EvalTokensStandard");
 	}
 
 	/*
@@ -1272,14 +1272,69 @@
 	    Tcl_AppendToObj(resultPtr, p, length);
 	}
     }
-    return resultPtr;
-
-    error:
     if (resultPtr != NULL) {
+	Tcl_SetObjResult(interp, resultPtr);
 	Tcl_DecrRefCount(resultPtr);
+    } else {
+	code = TCL_ERROR;
     }
-    return NULL;
+
+    done:
+    return code;
 }
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalTokens --
+ *
+ *	Given an array of tokens parsed from a Tcl command (e.g., the
+ *	tokens that make up a word or the index for an array variable)
+ *	this procedure evaluates the tokens and concatenates their
+ *	values to form a single result value.
+ *
+ * Results:
+ *	The return value is a pointer to a newly allocated Tcl_Obj
+ *	containing the value of the array of tokens.  The reference
+ *	count of the returned object has been incremented.  If an error
+ *	occurs in evaluating the tokens then a NULL value is returned
+ *	and an error message is left in interp's result.
+ *
+ * Side effects:
+ *	A new object is allocated to hold the result.
+ *
+ *----------------------------------------------------------------------
+ *
+ * This uses a non-standard return convention; its use is now deprecated.
+ * It is a wrapper for the new function Tcl_EvalTokensStandard, and is not 
+ * used in the core any longer. It is only kept for backward compatibility.
+ */
+
+Tcl_Obj *
+Tcl_EvalTokens(interp, tokenPtr, count)
+    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 code;
+    Tcl_Obj *resPtr;
+    
+    code = Tcl_EvalTokensStandard(interp, tokenPtr, count);
+    if (code == TCL_OK) {
+	resPtr = Tcl_GetObjResult(interp);
+	Tcl_IncrRefCount(resPtr);
+	Tcl_ResetResult(interp);
+	return resPtr;
+    } else {
+	return NULL;
+    }
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -1378,10 +1433,12 @@
 	    for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
 		    objectsUsed < parse.numWords;
 		    objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
-		objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1,
-			tokenPtr->numComponents);
-		if (objv[objectsUsed] == NULL) {
-		    code = TCL_ERROR;
+		code = Tcl_EvalTokensStandard(interp, tokenPtr+1, 
+		            tokenPtr->numComponents);
+		if (code == TCL_OK) {
+		    objv[objectsUsed] = Tcl_GetObjResult(interp);
+		    Tcl_IncrRefCount(objv[objectsUsed]);
+		} else {
 		    goto error;
 		}
 	    }
@@ -1841,6 +1898,7 @@
 {
     Tcl_Parse parse;
     register Tcl_Obj *objPtr;
+    int code;
 
     if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
 	return NULL;
@@ -1857,22 +1915,19 @@
 	return "$";
     }
 
-    objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens);
-    if (objPtr == NULL) {
+    code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);
+    if (code != TCL_OK) {
 	return NULL;
     }
+    objPtr = Tcl_GetObjResult(interp);
 
     /*
      * At this point we should have an object containing the value of
      * a variable.  Just return the string from that object.
      */
 
-#ifdef TCL_COMPILE_DEBUG
-    if (objPtr->refCount < 2) {
-	panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens");
-    }
-#endif /*TCL_COMPILE_DEBUG*/    
-    TclDecrRefCount(objPtr);
+    Tcl_IncrRefCount(objPtr);
+    Tcl_ResetResult(interp);
     return TclGetString(objPtr);
 }
 
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.60
diff -u -r1.60 tclStubInit.c
--- generic/tclStubInit.c	2001/09/10 17:17:41	1.60
+++ generic/tclStubInit.c	2001/09/12 18:14:17
@@ -878,6 +878,7 @@
     Tcl_FSGetPathType, /* 478 */
     Tcl_OutputBuffered, /* 479 */
     Tcl_FSMountsChanged, /* 480 */
+    Tcl_EvalTokensStandard, /* 481 */
 };
 
 /* !END!: Do not edit above this line. */
Index: tests/parse.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/parse.test,v
retrieving revision 1.7
diff -u -r1.7 parse.test
--- tests/parse.test	2000/04/10 17:19:02	1.7
+++ tests/parse.test	2001/09/12 18:14:17
@@ -732,6 +732,10 @@
     subst {[eval {return foo}]bar}
 } foobar
 
+test parse-17.1 {Correct return codes from errors during substitution} {
+    catch {eval {w[continue]}}
+} 4
+
 # cleanup
 catch {unset a}
 ::tcltest::cleanupTests
