summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2007-06-21 17:45:39 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2007-06-21 17:45:39 (GMT)
commit1cf3fb4fff5a0437a76e658e7ed16ef5928cc974 (patch)
treebbe8f01fbeac79727c814740dfea18c88e61f6a9
parentfcd900918cdac647cc943dfa32196fda722d489d (diff)
downloadtcl-1cf3fb4fff5a0437a76e658e7ed16ef5928cc974.zip
tcl-1cf3fb4fff5a0437a76e658e7ed16ef5928cc974.tar.gz
tcl-1cf3fb4fff5a0437a76e658e7ed16ef5928cc974.tar.bz2
* generic/tclBasic.c (TEOvI): Made sure that leave
* generic/tclExecute.c (INST_INVOKE): traces that were created * tests/trace.test (trace-36.2): during execution of an originally untraced command do not fire [Bug 1740962], partial fix.
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclBasic.c194
-rw-r--r--generic/tclExecute.c20
-rw-r--r--tests/trace.test4
4 files changed, 127 insertions, 99 deletions
diff --git a/ChangeLog b/ChangeLog
index eda8394..f545158 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2007-06-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TEOvI): Made sure that leave
+ * generic/tclExecute.c (INST_INVOKE): traces that were created
+ * tests/trace.test (trace-36.2): during execution of an
+ originally untraced command do not fire [Bug 1740962], partial
+ fix.
+
2007-06-21 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* generic/tcl.h, generic/tclCompile.h, generic/tclCompile.c: Remove
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8b20630..fc474d0 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.254 2007/06/20 18:46:07 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.255 2007/06/21 17:45:39 msofer Exp $
*/
#include "tclInt.h"
@@ -3428,7 +3428,7 @@ TclEvalObjvInternal(
CallFrame *varFramePtr = iPtr->varFramePtr;
int code = TCL_OK;
int traceCode = TCL_OK;
- int checkTraces = 1;
+ int checkTraces = 1, traced;
Namespace *savedNsPtr = NULL;
Namespace *lookupNsPtr = iPtr->lookupNsPtr;
@@ -3478,99 +3478,26 @@ TclEvalObjvInternal(
*/
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if (cmdPtr == NULL) {
- Namespace *currNsPtr = NULL; /* Used to check for and invoke any
- * registered unknown command handler
- * for the current namespace
- * (TIP 181). */
- int newObjc, handlerObjc;
- Tcl_Obj **handlerObjv;
-
- currNsPtr = varFramePtr->nsPtr;
- if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
- currNsPtr = iPtr->globalNsPtr;
- if (currNsPtr == NULL) {
- Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
- }
- }
-
- /*
- * Check to see if the resolution namespace has lost its unknown
- * handler. If so, reset it to "::unknown".
- */
-
- if (currNsPtr->unknownHandlerPtr == NULL) {
- TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
- Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
- }
-
- /*
- * Get the list of words for the unknown handler and allocate enough
- * space to hold both the handler prefix and all words of the command
- * invokation itself.
- */
-
- Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
- &handlerObjc, &handlerObjv);
- newObjc = objc + handlerObjc;
- newObjv = (Tcl_Obj **) TclStackAlloc(interp,
- (int) sizeof(Tcl_Obj *) * newObjc);
-
- /*
- * Copy command prefix from unknown handler and add on the real
- * command's full argument list. Note that we only use memcpy() once
- * because we have to increment the reference count of all the handler
- * arguments anyway.
- */
-
- for (i = 0; i < handlerObjc; ++i) {
- newObjv[i] = handlerObjv[i];
- Tcl_IncrRefCount(newObjv[i]);
- }
- memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
-
- /*
- * Look up and invoke the handler (by recursive call to this
- * function). If there is no handler at all, instead of doing the
- * recursive call we just generate a generic error message; it would
- * be an infinite-recursion nightmare otherwise.
- */
-
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
- if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[0]), "\"", NULL);
- code = TCL_ERROR;
- } else {
- iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
- length, 0);
- iPtr->numLevels--;
- }
-
- /*
- * Release any resources we locked and allocated during the handler
- * call.
- */
-
- for (i = 0; i < handlerObjc; ++i) {
- Tcl_DecrRefCount(newObjv[i]);
- }
- TclStackFree(interp, newObjv);
- if (savedNsPtr) {
- varFramePtr->nsPtr = savedNsPtr;
- }
- goto done;
+ if (!cmdPtr) {
+ goto notFound;
}
+
if (savedNsPtr) {
varFramePtr->nsPtr = savedNsPtr;
+ } else if (iPtr->ensembleRewrite.sourceObjs) {
+ /*
+ * TCL_EVAL_INVOKE was not set: clear rewrite rules
+ */
+
+ iPtr->ensembleRewrite.sourceObjs = NULL;
}
/*
* Call trace functions if needed.
*/
- if (checkTraces && ((iPtr->tracePtr != NULL) || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
+ traced = (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES));
+ if (traced && checkTraces) {
int cmdEpoch = cmdPtr->cmdEpoch;
int newEpoch;
@@ -3581,7 +3508,7 @@ TclEvalObjvInternal(
*/
cmdPtr->refCount++;
- if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
+ if (iPtr->tracePtr && (traceCode == TCL_OK)) {
traceCode = TclCheckInterpTraces(interp, command, length,
cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
}
@@ -3613,10 +3540,6 @@ TclEvalObjvInternal(
cmdPtr->refCount++;
iPtr->cmdCount++;
if (code == TCL_OK && traceCode == TCL_OK && !TclLimitExceeded(iPtr->limit)) {
- if (!(flags & TCL_EVAL_INVOKE) &&
- (iPtr->ensembleRewrite.sourceObjs != NULL)) {
- iPtr->ensembleRewrite.sourceObjs = NULL;
- }
code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
}
if (Tcl_AsyncReady()) {
@@ -3630,7 +3553,7 @@ TclEvalObjvInternal(
* Call 'leave' command traces
*/
- if (((iPtr->tracePtr != NULL) || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
+ if (traced) {
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
traceCode = TclCheckExecutionTraces(interp, command, length,
@@ -3651,7 +3574,6 @@ TclEvalObjvInternal(
if (traceCode != TCL_OK) {
code = traceCode;
}
-
}
/*
@@ -3677,6 +3599,92 @@ TclEvalObjvInternal(
iPtr->varFramePtr = savedVarFramePtr;
}
return code;
+
+ notFound:
+ {
+ Namespace *currNsPtr = NULL; /* Used to check for and invoke any
+ * registered unknown command handler
+ * for the current namespace
+ * (TIP 181). */
+ int newObjc, handlerObjc;
+ Tcl_Obj **handlerObjv;
+
+ currNsPtr = varFramePtr->nsPtr;
+ if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
+ currNsPtr = iPtr->globalNsPtr;
+ if (currNsPtr == NULL) {
+ Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
+ }
+ }
+
+ /*
+ * Check to see if the resolution namespace has lost its unknown
+ * handler. If so, reset it to "::unknown".
+ */
+
+ if (currNsPtr->unknownHandlerPtr == NULL) {
+ TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
+ Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
+ }
+
+ /*
+ * Get the list of words for the unknown handler and allocate enough
+ * space to hold both the handler prefix and all words of the command
+ * invokation itself.
+ */
+
+ Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
+ &handlerObjc, &handlerObjv);
+ newObjc = objc + handlerObjc;
+ newObjv = (Tcl_Obj **) TclStackAlloc(interp,
+ (int) sizeof(Tcl_Obj *) * newObjc);
+
+ /*
+ * Copy command prefix from unknown handler and add on the real
+ * command's full argument list. Note that we only use memcpy() once
+ * because we have to increment the reference count of all the handler
+ * arguments anyway.
+ */
+
+ for (i = 0; i < handlerObjc; ++i) {
+ newObjv[i] = handlerObjv[i];
+ Tcl_IncrRefCount(newObjv[i]);
+ }
+ memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
+
+ /*
+ * Look up and invoke the handler (by recursive call to this
+ * function). If there is no handler at all, instead of doing the
+ * recursive call we just generate a generic error message; it would
+ * be an infinite-recursion nightmare otherwise.
+ */
+
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
+ if (cmdPtr == NULL) {
+ Tcl_AppendResult(interp, "invalid command name \"",
+ TclGetString(objv[0]), "\"", NULL);
+ code = TCL_ERROR;
+ } else {
+ iPtr->numLevels++;
+ code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
+ length, 0);
+ iPtr->numLevels--;
+ }
+
+ /*
+ * Release any resources we locked and allocated during the handler
+ * call.
+ */
+
+ for (i = 0; i < handlerObjc; ++i) {
+ Tcl_DecrRefCount(newObjv[i]);
+ }
+ TclStackFree(interp, newObjv);
+ if (savedNsPtr) {
+ varFramePtr->nsPtr = savedNsPtr;
+ }
+ goto done;
+ }
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 9e74fd3..21109cb 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -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: tclExecute.c,v 1.301 2007/06/20 18:46:12 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.302 2007/06/21 17:45:40 msofer Exp $
*/
#include "tclInt.h"
@@ -2000,9 +2000,21 @@ TclExecuteByteCode(
DECACHE_STACK_INFO();
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if (cmdPtr && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
- && iPtr->tracePtr == NULL) {
- result = TclEvalObjvInternal(interp, objc, objv, NULL, 0, 0);
+ if (cmdPtr
+ && !((cmdPtr->flags & CMD_HAS_EXEC_TRACES) || iPtr->tracePtr)
+ && !(checkInterp && (codePtr->compileEpoch != iPtr->compileEpoch))
+ ) {
+ cmdPtr->refCount++;
+ iPtr->cmdCount++;
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+
+ if (Tcl_AsyncReady()) {
+ result = Tcl_AsyncInvoke(interp, result);
+ }
+ if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
+ result = Tcl_LimitCheck(interp);
+ }
+ TclCleanupCommandMacro(cmdPtr);
} else {
/*
* If trace procedures will be called, we need a command
diff --git a/tests/trace.test b/tests/trace.test
index 212968a..47de94f 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -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: trace.test,v 1.54 2007/06/15 19:58:13 msofer Exp $
+# RCS: @(#) $Id: trace.test,v 1.55 2007/06/21 17:45:40 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -2494,7 +2494,7 @@ set base {
set ::tracevar
} -result {$r}
}
-runbase {- -* - -} $base
+runbase {- - - -} $base
set base {
test trace-37.$n {dynamic trace addition: $t} -setup {