Patch for [TIP 56], [Bug: 219384] and [Bug: 455151]: deprecate the use

of Tcl_EvalTokens, replaced by the new Tcl_EvalTokensStandard.

5 files changed, 117 insertions, 52 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 486c9e2..b53bdad 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tcl.decls,v 1.57 2001/09/12 16:32:21 msofer Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.58 2001/09/13 11:56:19 msofer Exp $
 
 library tcl
 
@@ -1682,9 +1682,9 @@ declare 480 generic {
     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)
+}
  
 ##############################################################################
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 2d1446b..108d931 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.43 2001/08/07 00:56:15 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.44 2001/09/13 11:56:19 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2371,7 +2371,7 @@ Tcl_SubstObj(interp, objPtr, flags)
 	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_SubstObj(interp, objPtr, flags)
 		    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++;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index ca2d0f1..9670564 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.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: tclDecls.h,v 1.57 2001/09/06 17:51:00 vincentdarley Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.58 2001/09/13 11:56:19 msofer Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1500,6 +1500,10 @@ EXTERN int		Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan));
 /* 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 @@ typedef struct TclStubs {
     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
@@ -4004,6 +4009,10 @@ extern TclStubs *tclStubsPtr;
 #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) */
 
diff --git a/generic/tclParse.c b/generic/tclParse.c
index de62df8..a6eaab3 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.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: tclParse.c,v 1.15 2001/05/03 21:14:57 msofer Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.16 2001/09/13 11:56:20 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1117,28 +1117,26 @@ Tcl_LogCommandInfo(interp, script, command, length)
 /*
  *----------------------------------------------------------------------
  *
- * 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 @@ Tcl_EvalTokens(interp, tokenPtr, count)
      * command's result object directly.
      */
 
+    code = TCL_OK;
     resultPtr = NULL;
+    Tcl_ResetResult(interp);
     for ( ; count > 0; count--, tokenPtr++) {
 	valuePtr = NULL;
 
@@ -1192,7 +1192,7 @@ Tcl_EvalTokens(interp, tokenPtr, count)
 		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 @@ Tcl_EvalTokens(interp, tokenPtr, count)
 	    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 @@ Tcl_EvalTokens(interp, tokenPtr, count)
 		}
 		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_EvalTokens(interp, tokenPtr, count)
 		    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_EvalTokens(interp, tokenPtr, count)
 	    Tcl_AppendToObj(resultPtr, p, length);
 	}
     }
-    return resultPtr;
-
-    error:
     if (resultPtr != NULL) {
+	Tcl_SetObjResult(interp, resultPtr);
 	Tcl_DecrRefCount(resultPtr);
+    } else {
+	code = TCL_ERROR;
+    }
+
+    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;
     }
-    return NULL;
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -1378,10 +1433,12 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	    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_ParseVar(interp, string, termPtr)
 {
     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 @@ Tcl_ParseVar(interp, string, termPtr)
 	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);
 }
 
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 900979a..2a1fbfb 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -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: tclStubInit.c,v 1.60 2001/09/10 17:17:41 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.61 2001/09/13 11:56:20 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -878,6 +878,7 @@ TclStubs tclStubs = {
     Tcl_FSGetPathType, /* 478 */
     Tcl_OutputBuffered, /* 479 */
     Tcl_FSMountsChanged, /* 480 */
+    Tcl_EvalTokensStandard, /* 481 */
 };
 
 /* !END!: Do not edit above this line. */