*** tclBasic.c.orig Wed Feb 9 13:19:37 2005
--- tclBasic.c Wed Feb 9 13:44:00 2005
***************
*** 17,26 ****
--- 17,32 ----
*/
#include "tclInt.h"
#include "tclCompile.h"
+ /* Guard-check to ensure access to objv of a list has not changed. */
+ #define LIST_OBJV_VALID(listObj, objv, objc) \
+ ((listPtr == (Tcl_Obj*)NULL) ||\
+ ((listPtr->typePtr == &tclListType) && \
+ (((List *) listPtr->internalRep.twoPtrValue.ptr1)->elements == objv) && \
+ (((List *) listPtr->internalRep.twoPtrValue.ptr1)->elemCount == objc)))
/*
* Static procedures in this file:
*/
static char * CallCommandTraces _ANSI_ARGS_((Interp *iPtr,
***************
*** 2914,2924 ****
*
*----------------------------------------------------------------------
*/
int
! TclEvalObjvInternal(interp, objc, objv, command, length, flags)
Tcl_Interp *interp; /* Interpreter in which to evaluate the
* command. Also used for error
* reporting. */
int objc; /* Number of words in command. */
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
--- 2920,2930 ----
*
*----------------------------------------------------------------------
*/
int
! TclEvalObjvInternal(interp, objc, objv, command, length, flags, listPtr)
Tcl_Interp *interp; /* Interpreter in which to evaluate the
* command. Also used for error
* reporting. */
int objc; /* Number of words in command. */
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
***************
*** 2935,2944 ****
--- 2941,2951 ----
* used. */
int flags; /* Collection of OR-ed bits that control
* the evaluation of the script. Only
* TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
* currently supported. */
+ Tcl_Obj *CONST listPtr; /* List object for objv, if any. */
{
Command *cmdPtr;
Interp *iPtr = (Interp *) interp;
Tcl_Obj **newObjv;
***************
*** 2995,3005 ****
Tcl_AppendResult(interp, "invalid command name \"",
Tcl_GetString(objv[0]), "\"", (char *) NULL);
code = TCL_ERROR;
} else {
iPtr->numLevels++;
! code = TclEvalObjvInternal(interp, objc+1, newObjv, command, length, 0);
iPtr->numLevels--;
}
Tcl_DecrRefCount(newObjv[0]);
ckfree((char *) newObjv);
goto done;
--- 3002,3012 ----
Tcl_AppendResult(interp, "invalid command name \"",
Tcl_GetString(objv[0]), "\"", (char *) NULL);
code = TCL_ERROR;
} else {
iPtr->numLevels++;
! code = TclEvalObjvInternal(interp, objc+1, newObjv, command, length, 0, NULL);
iPtr->numLevels--;
}
Tcl_DecrRefCount(newObjv[0]);
ckfree((char *) newObjv);
goto done;
***************
*** 3038,3048 ****
/*
* Finally, invoke the command's Tcl_ObjCmdProc.
*/
cmdPtr->refCount++;
iPtr->cmdCount++;
! if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp)) {
savedVarFramePtr = iPtr->varFramePtr;
if (flags & TCL_EVAL_GLOBAL) {
iPtr->varFramePtr = NULL;
}
if (!(flags & TCL_EVAL_INVOKE) &&
--- 3045,3056 ----
/*
* Finally, invoke the command's Tcl_ObjCmdProc.
*/
cmdPtr->refCount++;
iPtr->cmdCount++;
! if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp) &&
! LIST_OBJV_VALID(listObj, objv, objc)) {
savedVarFramePtr = iPtr->varFramePtr;
if (flags & TCL_EVAL_GLOBAL) {
iPtr->varFramePtr = NULL;
}
if (!(flags & TCL_EVAL_INVOKE) &&
***************
*** 3102,3115 ****
}
/*
*----------------------------------------------------------------------
*
! * Tcl_EvalObjv --
*
* This procedure evaluates a Tcl command that has already been
* parsed into words, with one Tcl_Obj holding each word.
*
* Results:
* 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.
--- 3110,3124 ----
}
/*
*----------------------------------------------------------------------
*
! * TclEvalObjvList --
*
* This procedure evaluates a Tcl command that has already been
* parsed into words, with one Tcl_Obj holding each word.
+ * The listObj argument ensures objv isn't invalidated.
*
* Results:
* 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.
***************
*** 3118,3139 ****
* Depends on the command.
*
*----------------------------------------------------------------------
*/
! int
! Tcl_EvalObjv(interp, objc, objv, flags)
Tcl_Interp *interp; /* Interpreter in which to evaluate the
* command. Also used for error
* reporting. */
int objc; /* Number of words in command. */
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
* the words that make up the command. */
int flags; /* Collection of OR-ed bits that control
* the evaluation of the script. Only
* TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE
* are currently supported. */
{
Interp *iPtr = (Interp *)interp;
Trace *tracePtr;
Tcl_DString cmdBuf;
char *cmdString = ""; /* A command string is only necessary for
--- 3127,3149 ----
* Depends on the command.
*
*----------------------------------------------------------------------
*/
! static int
! TclEvalObjvList(interp, objc, objv, flags, objPtr, listPtr)
Tcl_Interp *interp; /* Interpreter in which to evaluate the
* command. Also used for error
* reporting. */
int objc; /* Number of words in command. */
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
* the words that make up the command. */
int flags; /* Collection of OR-ed bits that control
* the evaluation of the script. Only
* TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE
* are currently supported. */
+ Tcl_Obj *CONST listPtr; /* List object for objv, if any. */
{
Interp *iPtr = (Interp *)interp;
Trace *tracePtr;
Tcl_DString cmdBuf;
char *cmdString = ""; /* A command string is only necessary for
***************
*** 3162,3172 ****
break;
}
}
iPtr->numLevels++;
! code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
iPtr->numLevels--;
/*
* If we are again at the top level, process any unusual
* return code returned by the evaluated code.
--- 3172,3183 ----
break;
}
}
iPtr->numLevels++;
! code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags,
! listPtr);
iPtr->numLevels--;
/*
* If we are again at the top level, process any unusual
* return code returned by the evaluated code.
***************
*** 3188,3198 ****
/*
* If there was an error, a command string will be needed for the
* error log: generate it now if it was not done previously.
*/
! if (cmdLen == 0) {
Tcl_DStringInit(&cmdBuf);
for (i = 0; i < objc; i++) {
Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
}
cmdString = Tcl_DStringValue(&cmdBuf);
--- 3199,3209 ----
/*
* If there was an error, a command string will be needed for the
* error log: generate it now if it was not done previously.
*/
! if (cmdLen == 0 && LIST_OBJV_VALID(listObj, objv, objc)) {
Tcl_DStringInit(&cmdBuf);
for (i = 0; i < objc; i++) {
Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
}
cmdString = Tcl_DStringValue(&cmdBuf);
***************
*** 3208,3217 ****
--- 3219,3263 ----
}
/*
*----------------------------------------------------------------------
*
+ * Tcl_EvalObjv --
+ *
+ * This procedure evaluates a Tcl command that has already been
+ * parsed into words, with one Tcl_Obj holding each word.
+ *
+ * Results:
+ * 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:
+ * Depends on the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ int
+ Tcl_EvalObjv(interp, objc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate the
+ * command. Also used for error
+ * reporting. */
+ int objc; /* Number of words in command. */
+ Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
+ * the words that make up the command. */
+ int flags; /* Collection of OR-ed bits that control
+ * the evaluation of the script. Only
+ * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE
+ * are currently supported. */
+ {
+ return TclEvalObjvList( interp, objc, objv, flags, NULL);
+ }
+
+ /*
+ *----------------------------------------------------------------------
+ *
* Tcl_LogCommandInfo --
*
* This procedure is invoked after an error occurs in an interpreter.
* It adds information to iPtr->errorInfo field to describe the
* command that was being executed when the error occurred.
***************
*** 3533,3543 ****
* Execute the command and free the objects for its words.
*/
iPtr->numLevels++;
code = TclEvalObjvInternal(interp, objectsUsed, objv,
! parse.commandStart, parse.commandSize, 0);
iPtr->numLevels--;
if (code != TCL_OK) {
if (iPtr->numLevels == 0) {
if (code == TCL_RETURN) {
code = TclUpdateReturnInfo(iPtr);
--- 3579,3589 ----
* Execute the command and free the objects for its words.
*/
iPtr->numLevels++;
code = TclEvalObjvInternal(interp, objectsUsed, objv,
! parse.commandStart, parse.commandSize, 0, NULL);
iPtr->numLevels--;
if (code != TCL_OK) {
if (iPtr->numLevels == 0) {
if (code == TCL_RETURN) {
code = TclUpdateReturnInfo(iPtr);
*** tclCompile.h.orig Wed Feb 9 13:31:08 2005
--- tclCompile.h Wed Feb 9 13:24:54 2005
***************
*** 737,747 ****
*----------------------------------------------------------------
*/
MODULE_SCOPE int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[],
! CONST char *command, int length, int flags));
MODULE_SCOPE int TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));
/*
*----------------------------------------------------------------
--- 737,748 ----
*----------------------------------------------------------------
*/
MODULE_SCOPE int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[],
! CONST char *command, int length, int flags,
! Tcl_Obj *CONST listPtr));
MODULE_SCOPE int TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));
/*
*----------------------------------------------------------------
*** tclExecute.c.orig Wed Feb 9 13:31:40 2005
--- tclExecute.c Wed Feb 9 13:32:10 2005
***************
*** 1624,1634 ****
* Finally, let TclEvalObjvInternal handle the command.
*/
DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
! result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
CACHE_STACK_INFO();
/*
* If the old stack is going to be released, it is
* safe to do so now, since no references to objv are
--- 1624,1634 ----
* Finally, let TclEvalObjvInternal handle the command.
*/
DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
! result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0, NULL);
CACHE_STACK_INFO();
/*
* If the old stack is going to be released, it is
* safe to do so now, since no references to objv are
*** tclIOUtil.c.orig Wed Feb 9 13:16:47 2005
--- tclIOUtil.c Wed Feb 9 13:19:14 2005
***************
*** 1683,1701 ****
oldScriptFile = iPtr->scriptFile;
iPtr->scriptFile = pathPtr;
Tcl_IncrRefCount(iPtr->scriptFile);
string = Tcl_GetStringFromObj(objPtr, &length);
result = Tcl_EvalEx(interp, string, length, 0);
- /*
- * Now we have to be careful; the script may have changed the
- * iPtr->scriptFile value, so we must reset it without
- * assuming it still points to 'pathPtr'.
- */
- if (iPtr->scriptFile != NULL) {
- Tcl_DecrRefCount(iPtr->scriptFile);
- }
- iPtr->scriptFile = oldScriptFile;
if (result == TCL_RETURN) {
result = TclUpdateReturnInfo(iPtr);
} else if (result == TCL_ERROR) {
--- 1683,1692 ----
***************
*** 1714,1723 ****
--- 1705,1723 ----
Tcl_DecrRefCount(errorLine);
Tcl_AppendToObj(msg, ")", -1);
TclAppendObjToErrorInfo(interp, msg);
Tcl_DecrRefCount(msg);
}
+ /*
+ * Now we have to be careful; the script may have changed the
+ * iPtr->scriptFile value, so we must reset it without
+ * assuming it still points to 'pathPtr'.
+ */
+ if (iPtr->scriptFile != NULL) {
+ Tcl_DecrRefCount(iPtr->scriptFile);
+ }
+ iPtr->scriptFile = oldScriptFile;
end:
Tcl_DecrRefCount(objPtr);
return result;
}
