diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclBasic.c | 194 | ||||
| -rw-r--r-- | generic/tclExecute.c | 20 | ||||
| -rw-r--r-- | tests/trace.test | 4 |
4 files changed, 127 insertions, 99 deletions
@@ -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 { |