summaryrefslogtreecommitdiffstats
path: root/generic/tclParse.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2001-09-13 11:56:19 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2001-09-13 11:56:19 (GMT)
commitd819427fc86d39d465f72f010f19054c74c625ca (patch)
tree312894adaa8a1fb3ac1306ff74033406cbf3f8fd /generic/tclParse.c
parent8fb82585043253ad71e5623478fda7d8a67b1c23 (diff)
downloadtcl-d819427fc86d39d465f72f010f19054c74c625ca.zip
tcl-d819427fc86d39d465f72f010f19054c74c625ca.tar.gz
tcl-d819427fc86d39d465f72f010f19054c74c625ca.tar.bz2
Patch for [TIP 56], [Bug: 219384] and [Bug: 455151]: deprecate the use
of Tcl_EvalTokens, replaced by the new Tcl_EvalTokensStandard.
Diffstat (limited to 'generic/tclParse.c')
-rw-r--r--generic/tclParse.c133
1 files changed, 94 insertions, 39 deletions
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);
}