From 2bcd186571b8f37c820add859b48f7046260d261 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 8 Apr 2013 18:11:33 +0000
Subject: Revise TclNREvalObjv so that pre-resolution of the Command by a
 caller does not force suppression of exception handling.  Let those be
 separable demands.  Aim is to bring TclObjInvoke*() into the fold.

---
 generic/tclBasic.c    | 17 ++++++++++++-----
 generic/tclNamesp.c   |  2 +-
 generic/tclOOMethod.c |  2 +-
 3 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cde1cb9..22ec6b0 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4188,10 +4188,6 @@ TclNREvalObjv(
 	return result;
     }
 
-    if (cmdPtr) {
-	goto commandFound;
-    }
-
     /*
      * Push records for task to be done on return, in INVERSE order. First, if
      * needed, the exception handlers (as they should happen last).
@@ -4201,6 +4197,10 @@ TclNREvalObjv(
 	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
     }
 
+    if (cmdPtr) {
+	goto commandFound;
+    }
+
     /*
      * Configure evaluation context to match the requested flags.
      */
@@ -6620,9 +6620,11 @@ TclObjInvoke(
 	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
     }
 
+#if 1
     if (TclInterpReady(interp) == TCL_ERROR) {
 	return TCL_ERROR;
     }
+#endif
 
     cmdName = TclGetString(objv[0]);
     hTblPtr = iPtr->hiddenCmdTablePtr;
@@ -6638,6 +6640,7 @@ TclObjInvoke(
     }
     cmdPtr = Tcl_GetHashValue(hPtr);
 
+#if 1
     /*
      * Invoke the command function.
      */
@@ -6669,6 +6672,9 @@ TclObjInvoke(
 	iPtr->flags &= ~ERR_ALREADY_LOGGED;
     }
     return result;
+#else
+
+#endif
 }
 
 /*
@@ -8243,7 +8249,8 @@ Tcl_NRCmdSwap(
     Tcl_Obj *const objv[],
     int flags)
 {
-    return TclNREvalObjv(interp, objc, objv, flags, (Command *) cmd);
+    return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR,
+	    (Command *) cmd);
 }
 
 /*****************************************************************************
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index aed623a..bdd5386 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1942,7 +1942,7 @@ InvokeImportedNRCmd(
     Command *realCmdPtr = dataPtr->realCmdPtr;
 
     TclSkipTailcall(interp);
-    return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
+    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
 }
 
 static int
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 98b4078..bd2744a 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1429,7 +1429,7 @@ InvokeForwardMethod(
 		contextPtr->oPtr->namespacePtr, 0 /* normal lookup */);
     }
     Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
-    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, cmdPtr);
+    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, cmdPtr);
 }
 
 static int
-- 
cgit v0.12


From 2816004e58ac0da7bde02b0159b164e54c04ab6a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 11 Apr 2013 14:39:56 +0000
Subject: New internal routine TclNRInvoke() - NR-enabled path through the
 machinery behind invokehidden commands.

---
 generic/tclBasic.c  | 77 +++++++++++++++++++++--------------------------------
 generic/tclInt.h    |  1 +
 generic/tclInterp.c |  7 ++++-
 3 files changed, 37 insertions(+), 48 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 22ec6b0..82ce385 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -162,6 +162,7 @@ static Tcl_NRPostProc	TEOV_RestoreVarFrame;
 static Tcl_NRPostProc	TEOV_RunLeaveTraces;
 
 static Tcl_ObjCmdProc NRCoroInjectObjCmd;
+static Tcl_NRPostProc NRPostInvoke;
 
 MODULE_SCOPE const TclStubs tclStubs;
 
@@ -6599,32 +6600,32 @@ TclObjInvoke(
 				 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
 				 * or TCL_INVOKE_NO_TRACEBACK. */
 {
-    register Interp *iPtr = (Interp *) interp;
-    Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
-    const char *cmdName;	/* Name of the command from objv[0]. */
-    Tcl_HashEntry *hPtr = NULL;
-    Command *cmdPtr;
-    int result;
-
     if (interp == NULL) {
 	return TCL_ERROR;
     }
-
     if ((objc < 1) || (objv == NULL)) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                 "illegal argument vector", -1));
 	return TCL_ERROR;
     }
-
     if ((flags & TCL_INVOKE_HIDDEN) == 0) {
 	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
     }
+    return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv);
+}
 
-#if 1
-    if (TclInterpReady(interp) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-#endif
+int
+TclNRInvoke(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    register Interp *iPtr = (Interp *) interp;
+    Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
+    const char *cmdName;	/* Name of the command from objv[0]. */
+    Tcl_HashEntry *hPtr = NULL;
+    Command *cmdPtr;
 
     cmdName = TclGetString(objv[0]);
     hTblPtr = iPtr->hiddenCmdTablePtr;
@@ -6640,41 +6641,23 @@ TclObjInvoke(
     }
     cmdPtr = Tcl_GetHashValue(hPtr);
 
-#if 1
-    /*
-     * Invoke the command function.
-     */
-
-    iPtr->cmdCount++;
-    if (cmdPtr->objProc != NULL) {
-	result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
-    } else {
-	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
-		cmdPtr->objClientData, objc, objv);
-    }
-
-    /*
-     * If an error occurred, record information about what was being executed
-     * when the error occurred.
-     */
-
-    if ((result == TCL_ERROR)
-	    && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
-	    && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
-	int length;
-	Tcl_Obj *command = Tcl_NewListObj(objc, objv);
-	const char *cmdString;
+    /* Avoid the exception-handling brain damage when numLevels == 0 . */
+    iPtr->numLevels++;
+    Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);
+ 
+    /* TODO: how to get re-resolution right */
+    return TclNREvalObjv(interp, objc, objv, 0, cmdPtr);
+}
 
-	Tcl_IncrRefCount(command);
-	cmdString = Tcl_GetStringFromObj(command, &length);
-	Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
-	Tcl_DecrRefCount(command);
-	iPtr->flags &= ~ERR_ALREADY_LOGGED;
-    }
+static int
+NRPostInvoke(
+    ClientData clientData[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *)interp;
+    iPtr->numLevels--;
     return result;
-#else
-
-#endif
 }
 
 /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1f939c0..70d6d02 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2739,6 +2739,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
 
 MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
 MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 1a4297b..ac51d9d 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -3052,7 +3052,12 @@ SlaveInvokeHidden(
     Tcl_AllowExceptions(slaveInterp);
 
     if (namespaceName == NULL) {
-	result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+	if (interp == slaveInterp) {
+	    Tcl_Release(slaveInterp);
+	    return TclNRInvoke(NULL, slaveInterp, objc, objv);
+	} else {
+	    result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+	}
     } else {
 	Namespace *nsPtr, *dummy1, *dummy2;
 	const char *tail;
-- 
cgit v0.12


From 87dc28ad0ec271d380acc051908672eb9a3adb43 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 11 Apr 2013 19:36:37 +0000
Subject: More revisions let multi-interp test case work, but at cost of panics
 and segfaults.  Pushing the NRE-envelope.

---
 generic/tclInterp.c | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index ac51d9d..e9ed790 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -279,6 +279,7 @@ static void		DeleteScriptLimitCallback(ClientData clientData);
 static void		RunLimitHandlers(LimitHandler *handlerPtr,
 			    Tcl_Interp *interp);
 static void		TimeLimitCallback(ClientData clientData);
+static Tcl_NRPostProc	NRPostInvokeHidden;
 
 /*
  *----------------------------------------------------------------------
@@ -3056,7 +3057,9 @@ SlaveInvokeHidden(
 	    Tcl_Release(slaveInterp);
 	    return TclNRInvoke(NULL, slaveInterp, objc, objv);
 	} else {
-	    result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+	    Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
+		    NULL, NULL, NULL);
+	    return TclNRInvoke(NULL, slaveInterp, objc, objv);
 	}
     } else {
 	Namespace *nsPtr, *dummy1, *dummy2;
@@ -3076,6 +3079,19 @@ SlaveInvokeHidden(
     Tcl_Release(slaveInterp);
     return result;
 }
+
+static int
+NRPostInvokeHidden(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0];
+
+    Tcl_TransferResult(slaveInterp, result, interp);
+    Tcl_Release(slaveInterp);
+    return result;
+}
 
 /*
  *----------------------------------------------------------------------
-- 
cgit v0.12


From f54af08a171ccb68fa91d72cead431736ff19908 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 11 Apr 2013 21:30:40 +0000
Subject: More progress.  NR-enable [interp] and [$slave], completely with
 invokehidden subcommand.  Test suite passes with no errors.

---
 generic/tclInterp.c | 51 +++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 39 insertions(+), 12 deletions(-)

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index e9ed790..0da5d47 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -279,7 +279,12 @@ static void		DeleteScriptLimitCallback(ClientData clientData);
 static void		RunLimitHandlers(LimitHandler *handlerPtr,
 			    Tcl_Interp *interp);
 static void		TimeLimitCallback(ClientData clientData);
+
+/* NRE enabling */
 static Tcl_NRPostProc	NRPostInvokeHidden;
+static Tcl_ObjCmdProc	NRInterpCmd;
+static Tcl_ObjCmdProc	NRSlaveCmd;
+
 
 /*
  *----------------------------------------------------------------------
@@ -482,7 +487,8 @@ TclInterpInit(
     slavePtr->interpCmd		= NULL;
     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
 
-    Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);
+    Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
+	    NULL, NULL);
 
     Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
     return TCL_OK;
@@ -591,6 +597,16 @@ Tcl_InterpObjCmd(
     int objc,				/* Number of arguments. */
     Tcl_Obj *const objv[])		/* Argument objects. */
 {
+    return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
+}
+
+static int
+NRInterpCmd(
+    ClientData clientData,		/* Unused. */
+    Tcl_Interp *interp,			/* Current interpreter. */
+    int objc,				/* Number of arguments. */
+    Tcl_Obj *const objv[])		/* Argument objects. */
+{
     Tcl_Interp *slaveInterp;
     int index;
     static const char *const options[] = {
@@ -2373,8 +2389,8 @@ SlaveCreate(
     slavePtr->masterInterp = masterInterp;
     slavePtr->slaveEntryPtr = hPtr;
     slavePtr->slaveInterp = slaveInterp;
-    slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
-	    SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc);
+    slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
+	    SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
     Tcl_SetHashValue(hPtr, slavePtr);
     Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
@@ -2463,6 +2479,16 @@ SlaveObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
+    return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
+}
+
+static int
+NRSlaveCmd(
+    ClientData clientData,	/* Slave interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
     Tcl_Interp *slaveInterp = clientData;
     int index;
     static const char *const options[] = {
@@ -3053,14 +3079,11 @@ SlaveInvokeHidden(
     Tcl_AllowExceptions(slaveInterp);
 
     if (namespaceName == NULL) {
-	if (interp == slaveInterp) {
-	    Tcl_Release(slaveInterp);
-	    return TclNRInvoke(NULL, slaveInterp, objc, objv);
-	} else {
-	    Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
-		    NULL, NULL, NULL);
-	    return TclNRInvoke(NULL, slaveInterp, objc, objv);
-	}
+	NRE_callback *rootPtr = TOP_CB(slaveInterp);
+
+	Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
+		rootPtr, NULL, NULL);
+	return TclNRInvoke(NULL, slaveInterp, objc, objv);
     } else {
 	Namespace *nsPtr, *dummy1, *dummy2;
 	const char *tail;
@@ -3087,8 +3110,12 @@ NRPostInvokeHidden(
     int result)
 {
     Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0];
+    NRE_callback *rootPtr = (NRE_callback *)data[1];
 
-    Tcl_TransferResult(slaveInterp, result, interp);
+    if (interp != slaveInterp) {
+	result = TclNRRunCallbacks(slaveInterp, result, rootPtr);
+	Tcl_TransferResult(slaveInterp, result, interp);
+    }
     Tcl_Release(slaveInterp);
     return result;
 }
-- 
cgit v0.12


From 4837b605c2c1f2aa65ba75d080a2cb5076303abd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 19 Aug 2013 16:34:10 +0000
Subject: Revise execution trace handling to take account of the new reality in
 Tcl 8.6 that callers can pre-resolve a cmdPtr for us.  In that case a
 re-resolution in the form of another command name lookup isn't the right
 thing.

---
 generic/tclBasic.c | 51 +++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 37 insertions(+), 14 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 64563ee..8ac5781 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -148,7 +148,8 @@ static int		TEOV_NotFound(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
 static int		TEOV_RunEnterTraces(Tcl_Interp *interp,
 			    Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
-			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
+			    Tcl_Obj *const objv[], Namespace *lookupNsPtr,
+			    int weLookUp);
 static Tcl_NRPostProc	RewindCoroutineCallback;
 static Tcl_NRPostProc	TailcallCleanup;
 static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
@@ -4098,6 +4099,7 @@ TclNREvalObjv(
     Namespace *lookupNsPtr = iPtr->lookupNsPtr;
     Command **cmdPtrPtr;
     NRE_callback *callbackPtr;
+    int weLookUp = (cmdPtr == NULL);
     
     iPtr->lookupNsPtr = NULL;
 
@@ -4136,7 +4138,7 @@ TclNREvalObjv(
 	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
     }
 
-    if (cmdPtr) {
+    if (!weLookUp) {
 	goto commandFound;
     }
 
@@ -4188,12 +4190,16 @@ TclNREvalObjv(
 
 	result = TEOV_RunEnterTraces(interp, &cmdPtr, TclGetSourceFromFrame(
 		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
-		objc, objv), objc, objv, lookupNsPtr);
+		objc, objv), objc, objv, lookupNsPtr, weLookUp);
 	if (result != TCL_OK) {
 	    return result;
 	}
-	if (!cmdPtr) {
-	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+	if (cmdPtr == NULL) {
+	    if (weLookUp) {
+		return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+	    }
+	    /* Is this right??? */
+	    return TCL_OK;
 	}
     }
 
@@ -4605,7 +4611,8 @@ TEOV_RunEnterTraces(
     Tcl_Obj *commandPtr,
     int objc,
     Tcl_Obj *const objv[],
-    Namespace *lookupNsPtr)
+    Namespace *lookupNsPtr,
+    int weLookUp)
 {
     Interp *iPtr = (Interp *) interp;
     Command *cmdPtr = *cmdPtrPtr;
@@ -4613,7 +4620,7 @@ TEOV_RunEnterTraces(
     int cmdEpoch = cmdPtr->cmdEpoch;
     int newEpoch;
     const char *command;
-    int length;
+    int length, deleted;
 
     Tcl_IncrRefCount(commandPtr);
     command = Tcl_GetStringFromObj(commandPtr, &length);
@@ -4635,16 +4642,32 @@ TEOV_RunEnterTraces(
 		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
     }
     newEpoch = cmdPtr->cmdEpoch;
+    deleted = cmdPtr->flags & CMD_IS_DELETED;
     TclCleanupCommandMacro(cmdPtr);
 
-    /*
-     * If the traces modified/deleted the command or any existing traces, they
-     * will update the command's epoch. We need to lookup again, but do not
-     * run enter traces on the newly found cmdPtr.
-     */
-
     if (cmdEpoch != newEpoch) {
-	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+
+	/*
+	 * The traces did something to the traced command.  How should
+	 * we respond?
+	 *
+	 * If we got the trace command by looking up a command name, we
+	 * should just look it up again.
+	 */
+	if (weLookUp) {
+	    cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+	} else {
+
+	    /*
+	     * If we did not look up a command name, we got the cmdPtr
+	     * from a caller.  If that cmdPtr has been deleted, we need
+	     * to avoid a crash.  Otherwise, press on.  We don't have
+	     * any foundation to claim a better answer.
+	     */
+	    if (deleted) {
+		cmdPtr = NULL;
+	    }
+	}
 	*cmdPtrPtr = cmdPtr;
     }
 
-- 
cgit v0.12


From 9150a7225d0e28174587948bb96b6a11f70493dc Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 27 Aug 2013 18:11:53 +0000
Subject: Add test for Bug 2486550.

---
 tests/coroutine.test | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/tests/coroutine.test b/tests/coroutine.test
index 8a7fdf3..03c63ad 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -633,6 +633,15 @@ test coroutine-7.6 {Early yield crashes} {
     rename foo {}
 } {}
 
+test coroutine-7.7 {Bug 2486550} -setup {
+    interp hide {} yield
+} -body {
+    coroutine demo interp invokehidden {} yield ok
+} -cleanup {
+    demo
+    interp expose {} yield
+} -result ok
+
 
 # cleanup
 unset lambda
-- 
cgit v0.12


From f300f251bd0a7b4aeb3ee2ad971c5b766629ed04 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 27 Aug 2013 20:03:57 +0000
Subject: Inline TEOV_RunEnterTraces() so its interface can be redesigned.

---
 generic/tclBasic.c | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 71 insertions(+), 3 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 82aa833..8407edb 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4197,9 +4197,77 @@ EvalObjvCore(
 	 * necessary.
 	 */
 
-	result = TEOV_RunEnterTraces(interp, &cmdPtr, TclGetSourceFromFrame(
-		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
-		objc, objv), objc, objv, lookupNsPtr, weLookUp);
+    int traceCode = TCL_OK;
+    int cmdEpoch = cmdPtr->cmdEpoch;
+    int newEpoch;
+    const char *command;
+    int length, deleted;
+
+    Tcl_Obj *commandPtr = TclGetSourceFromFrame(
+	    flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
+	    objc, objv);
+
+    Tcl_IncrRefCount(commandPtr);
+    command = Tcl_GetStringFromObj(commandPtr, &length);
+
+    /*
+     * Call trace functions.
+     * Execute any command or execution traces. Note that we bump up the
+     * command's reference count for the duration of the calling of the traces
+     * so that the structure doesn't go away underneath our feet.
+     */
+
+    cmdPtr->refCount++;
+    if (iPtr->tracePtr) {
+	traceCode = TclCheckInterpTraces(interp, command, length,
+		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
+    }
+    if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
+	traceCode = TclCheckExecutionTraces(interp, command, length,
+		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
+    }
+    newEpoch = cmdPtr->cmdEpoch;
+    deleted = cmdPtr->flags & CMD_IS_DELETED;
+    TclCleanupCommandMacro(cmdPtr);
+
+    if (cmdEpoch != newEpoch) {
+
+	/*
+	 * The traces did something to the traced command.  How should
+	 * we respond?
+	 *
+	 * If we got the trace command by looking up a command name, we
+	 * should just look it up again.
+	 */
+	if (weLookUp) {
+	    cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+	} else {
+
+	    /*
+	     * If we did not look up a command name, we got the cmdPtr
+	     * from a caller.  If that cmdPtr has been deleted, we need
+	     * to avoid a crash.  Otherwise, press on.  We don't have
+	     * any foundation to claim a better answer.
+	     */
+	    if (deleted) {
+		cmdPtr = NULL;
+	    }
+	}
+    }
+
+    if (cmdPtr && (traceCode == TCL_OK)) {
+	/*
+	 * Command was found: push a record to schedule the leave traces.
+	 */
+
+	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
+		commandPtr, cmdPtr, objv);
+	cmdPtr->refCount++;
+    } else {
+	Tcl_DecrRefCount(commandPtr);
+    }
+    result = traceCode;
+
 	if (result != TCL_OK) {
 	    return result;
 	}
-- 
cgit v0.12


From 7ddfa6aeb8f6eb66f66f4ae36b5ee59cc56524f6 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 27 Aug 2013 20:06:08 +0000
Subject: Exceptions raised from enter traces take priority over re-resolution
 games.

---
 generic/tclBasic.c | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8407edb..172c698 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4230,6 +4230,11 @@ EvalObjvCore(
     deleted = cmdPtr->flags & CMD_IS_DELETED;
     TclCleanupCommandMacro(cmdPtr);
 
+    if (traceCode != TCL_OK) {
+	Tcl_DecrRefCount(commandPtr);
+	return traceCode;
+    }
+
     if (cmdEpoch != newEpoch) {
 
 	/*
@@ -4255,7 +4260,7 @@ EvalObjvCore(
 	}
     }
 
-    if (cmdPtr && (traceCode == TCL_OK)) {
+    if (cmdPtr) {
 	/*
 	 * Command was found: push a record to schedule the leave traces.
 	 */
@@ -4266,11 +4271,6 @@ EvalObjvCore(
     } else {
 	Tcl_DecrRefCount(commandPtr);
     }
-    result = traceCode;
-
-	if (result != TCL_OK) {
-	    return result;
-	}
 	if (cmdPtr == NULL) {
 	    if (weLookUp) {
 		return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
-- 
cgit v0.12


From 9ba19b667f4232117cc4abd68576dead47e19c10 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 27 Aug 2013 20:25:15 +0000
Subject: Tidy up indenting for clarity in refactoring.

---
 generic/tclBasic.c | 123 +++++++++++++++++++++++++++--------------------------
 1 file changed, 62 insertions(+), 61 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 172c698..3f579d1 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4197,80 +4197,81 @@ EvalObjvCore(
 	 * necessary.
 	 */
 
-    int traceCode = TCL_OK;
-    int cmdEpoch = cmdPtr->cmdEpoch;
-    int newEpoch;
-    const char *command;
-    int length, deleted;
+	int traceCode = TCL_OK;
+	int cmdEpoch = cmdPtr->cmdEpoch;
+	int newEpoch;
+	const char *command;
+	int length, deleted;
 
-    Tcl_Obj *commandPtr = TclGetSourceFromFrame(
-	    flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
-	    objc, objv);
+	Tcl_Obj *commandPtr = TclGetSourceFromFrame(
+		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
+		objc, objv);
 
-    Tcl_IncrRefCount(commandPtr);
-    command = Tcl_GetStringFromObj(commandPtr, &length);
+	Tcl_IncrRefCount(commandPtr);
+	command = Tcl_GetStringFromObj(commandPtr, &length);
 
-    /*
-     * Call trace functions.
-     * Execute any command or execution traces. Note that we bump up the
-     * command's reference count for the duration of the calling of the traces
-     * so that the structure doesn't go away underneath our feet.
-     */
+	/*
+	 * Call trace functions.
+	 * Execute any command or execution traces. Note that we bump up the
+	 * command's reference count for the duration of the calling of the
+	 * traces so that the structure doesn't go away underneath our feet.
+	 */
 
-    cmdPtr->refCount++;
-    if (iPtr->tracePtr) {
-	traceCode = TclCheckInterpTraces(interp, command, length,
-		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
-    }
-    if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
-	traceCode = TclCheckExecutionTraces(interp, command, length,
-		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
-    }
-    newEpoch = cmdPtr->cmdEpoch;
-    deleted = cmdPtr->flags & CMD_IS_DELETED;
-    TclCleanupCommandMacro(cmdPtr);
+	cmdPtr->refCount++;
+	if (iPtr->tracePtr) {
+	    traceCode = TclCheckInterpTraces(interp, command, length,
+		    cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
+	}
+	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
+	    traceCode = TclCheckExecutionTraces(interp, command, length,
+		    cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
+	}
+	newEpoch = cmdPtr->cmdEpoch;
+	deleted = cmdPtr->flags & CMD_IS_DELETED;
+	TclCleanupCommandMacro(cmdPtr);
 
-    if (traceCode != TCL_OK) {
-	Tcl_DecrRefCount(commandPtr);
-	return traceCode;
-    }
+	if (traceCode != TCL_OK) {
+	    Tcl_DecrRefCount(commandPtr);
+	    return traceCode;
+	}
 
-    if (cmdEpoch != newEpoch) {
-
-	/*
-	 * The traces did something to the traced command.  How should
-	 * we respond?
-	 *
-	 * If we got the trace command by looking up a command name, we
-	 * should just look it up again.
-	 */
-	if (weLookUp) {
-	    cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
-	} else {
+	if (cmdEpoch != newEpoch) {
 
 	    /*
-	     * If we did not look up a command name, we got the cmdPtr
-	     * from a caller.  If that cmdPtr has been deleted, we need
-	     * to avoid a crash.  Otherwise, press on.  We don't have
-	     * any foundation to claim a better answer.
+	     * The traces did something to the traced command.  How should
+	     * we respond?
+	     *
+	     * If we got the trace command by looking up a command name, we
+	     * should just look it up again.
 	     */
-	    if (deleted) {
-		cmdPtr = NULL;
+	    if (weLookUp) {
+		cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+	    } else {
+
+		/*
+		 * If we did not look up a command name, we got the cmdPtr
+		 * from a caller.  If that cmdPtr has been deleted, we need
+		 * to avoid a crash.  Otherwise, press on.  We don't have
+		 * any foundation to claim a better answer.
+		 */
+		if (deleted) {
+		    cmdPtr = NULL;
+		}
 	    }
 	}
-    }
 
-    if (cmdPtr) {
-	/*
-	 * Command was found: push a record to schedule the leave traces.
-	 */
+	if (cmdPtr) {
+	    /*
+	     * Command was found: push a record to schedule the leave traces.
+	     */
+
+	    TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
+		    commandPtr, cmdPtr, objv);
+	    cmdPtr->refCount++;
+	} else {
+	    Tcl_DecrRefCount(commandPtr);
+	}
 
-	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
-		commandPtr, cmdPtr, objv);
-	cmdPtr->refCount++;
-    } else {
-	Tcl_DecrRefCount(commandPtr);
-    }
 	if (cmdPtr == NULL) {
 	    if (weLookUp) {
 		return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
-- 
cgit v0.12


From 3aa655bce1d9e291450cc8bdfe5890058dcf1700 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 28 Aug 2013 02:44:50 +0000
Subject: Clarfy and prettify influence of flag settings and command lookups.

---
 generic/tclBasic.c | 77 ++++++++++++++++++++++++++++--------------------------
 1 file changed, 40 insertions(+), 37 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3f579d1..af747cd 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4121,13 +4121,21 @@ EvalObjvCore(
     Tcl_Interp *interp,
     int result)
 {
-    Command *cmdPtr = data[0];
+    Command *cmdPtr = NULL, *preCmdPtr = data[0];
     int flags = PTR2INT(data[1]);
     int objc = PTR2INT(data[2]);
     Tcl_Obj **objv = data[3];
     Interp *iPtr = (Interp *) interp;
+
+    /*
+     * Capture the namespace we should do command name resolution in, as
+     * instructed by our caller sneaking it in to us in a private interp
+     * field.  Clear that field right away so we cannot possibly have its
+     * use leak where it should not.  The sneaky message pass is done.
+     */
+
     Namespace *lookupNsPtr = iPtr->lookupNsPtr;
-    int weLookUp = (cmdPtr == NULL);
+    iPtr->lookupNsPtr = NULL;
     
     if (TCL_OK != TclInterpReady(interp)) {
 	return TCL_ERROR;
@@ -4141,8 +4149,6 @@ EvalObjvCore(
 	return TCL_ERROR;
     }
 
-    iPtr->lookupNsPtr = NULL;
-
     /*
      * Push records for task to be done on return, in INVERSE order. First, if
      * needed, the exception handlers (as they should happen last).
@@ -4152,45 +4158,43 @@ EvalObjvCore(
 	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
     }
 
-    if (!weLookUp) {
-	goto commandFound;
-    }
-
-    /*
-     * Configure evaluation context to match the requested flags.
-     */
-
-    if ((flags & TCL_EVAL_INVOKE) || lookupNsPtr) {
-	if (!lookupNsPtr) {
-	    lookupNsPtr = iPtr->globalNsPtr;
-	}
+    if (preCmdPtr) {
+	cmdPtr = preCmdPtr;
     } else {
-	if (flags & TCL_EVAL_GLOBAL) {
-	    TEOV_SwitchVarFrame(interp);
-	    lookupNsPtr = iPtr->globalNsPtr;
-	}
 
 	/*
-	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
+	 * Configure evaluation context to match the requested flags.
 	 */
 
-	iPtr->ensembleRewrite.sourceObjs = NULL;
-    }
+	if (lookupNsPtr) {
+	    /*
+	     * Do nothing.  Caller gave us the lookup namespace.  Use it.
+	     * Overrides TCL_EVAL_GLOBAL.  For both lookup and eval.
+	     */
+	} else if (flags & TCL_EVAL_INVOKE) {
+	    lookupNsPtr = iPtr->globalNsPtr;
+	} else {
 
-    /*
-     * Lookup the command
-     */
+	    /*
+	     * TCL_EVAL_INVOKE was not set: clear rewrite rules
+	     */
 
-    cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
-    if (!cmdPtr) {
-	return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
-    }
+	    iPtr->ensembleRewrite.sourceObjs = NULL;
 
-    /*
-     * Found a command! The real work begins now ...
-     */
+	    if (flags & TCL_EVAL_GLOBAL) {
+		/* TODO: Check we do this whenever needed. */
+		TEOV_SwitchVarFrame(interp);
+		lookupNsPtr = iPtr->globalNsPtr;
+	    }
+	}
+
+	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+	if (!cmdPtr) {
+	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+	}
+
+    }
 
-  commandFound:
     if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
 	/*
 	 * Call enter traces. They will schedule a call to the leave traces if
@@ -4244,7 +4248,7 @@ EvalObjvCore(
 	     * If we got the trace command by looking up a command name, we
 	     * should just look it up again.
 	     */
-	    if (weLookUp) {
+	    if (preCmdPtr == NULL) {
 		cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
 	    } else {
 
@@ -4273,7 +4277,7 @@ EvalObjvCore(
 	}
 
 	if (cmdPtr == NULL) {
-	    if (weLookUp) {
+	    if (preCmdPtr == NULL) {
 		return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
 	    }
 	    /* Is this right??? */
@@ -4798,7 +4802,6 @@ TEOV_LookupCmdFromObj(
 
     if (lookupNsPtr) {
 	iPtr->varFramePtr->nsPtr = lookupNsPtr;
-	iPtr->lookupNsPtr = NULL;
     }
     cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
     iPtr->varFramePtr->nsPtr = savedNsPtr;
-- 
cgit v0.12


From 09922916778d4f09686dbdb94e6e4716ab9b8f59 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 28 Aug 2013 18:05:07 +0000
Subject: Rework the re-resolution after enter traces machinery with cleaner
 separations and neater interfaces.

---
 generic/tclBasic.c | 214 +++++++++++++++++------------------------------------
 1 file changed, 69 insertions(+), 145 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index af747cd..bafb4c2 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -147,8 +147,7 @@ static int		TEOV_NotFound(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
 static int		TEOV_RunEnterTraces(Tcl_Interp *interp,
 			    Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
-			    Tcl_Obj *const objv[], Namespace *lookupNsPtr,
-			    int weLookUp);
+			    Tcl_Obj *const objv[]);
 static Tcl_NRPostProc	RewindCoroutineCallback;
 static Tcl_NRPostProc	TailcallCleanup;
 static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
@@ -4126,6 +4125,7 @@ EvalObjvCore(
     int objc = PTR2INT(data[2]);
     Tcl_Obj **objv = data[3];
     Interp *iPtr = (Interp *) interp;
+    int enterTracesDone = 0;
 
     /*
      * Capture the namespace we should do command name resolution in, as
@@ -4152,137 +4152,100 @@ EvalObjvCore(
     /*
      * Push records for task to be done on return, in INVERSE order. First, if
      * needed, the exception handlers (as they should happen last).
+     * TODO: Consider moving this up.
      */
 
     if (!(flags & TCL_EVAL_NOERR)) {
 	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
     }
 
-    if (preCmdPtr) {
-	cmdPtr = preCmdPtr;
-    } else {
+    /*
+     * Configure evaluation context to match the requested flags.
+     */
 
+    if (lookupNsPtr) {
 	/*
-	 * Configure evaluation context to match the requested flags.
+	 * Do nothing.  Caller gave us the lookup namespace.  Use it.
+	 * Overrides TCL_EVAL_GLOBAL.  For both lookup and eval.
+	 * TODO: Is that a bug?
 	 */
+    } else if (flags & TCL_EVAL_INVOKE) {
+	lookupNsPtr = iPtr->globalNsPtr;
+    } else {
 
-	if (lookupNsPtr) {
-	    /*
-	     * Do nothing.  Caller gave us the lookup namespace.  Use it.
-	     * Overrides TCL_EVAL_GLOBAL.  For both lookup and eval.
-	     */
-	} else if (flags & TCL_EVAL_INVOKE) {
-	    lookupNsPtr = iPtr->globalNsPtr;
-	} else {
-
-	    /*
-	     * TCL_EVAL_INVOKE was not set: clear rewrite rules
-	     */
+	/*
+	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
+	 */
 
-	    iPtr->ensembleRewrite.sourceObjs = NULL;
+	iPtr->ensembleRewrite.sourceObjs = NULL;
 
-	    if (flags & TCL_EVAL_GLOBAL) {
-		/* TODO: Check we do this whenever needed. */
-		TEOV_SwitchVarFrame(interp);
-		lookupNsPtr = iPtr->globalNsPtr;
-	    }
+	if (flags & TCL_EVAL_GLOBAL) {
+	    TEOV_SwitchVarFrame(interp);
+	    lookupNsPtr = iPtr->globalNsPtr;
 	}
+    }
 
+    reresolve:
+    if (preCmdPtr) {
+	if (preCmdPtr->flags & CMD_IS_DELETED) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "attempt to invoke a deleted command"));
+	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
+	    return TCL_ERROR;
+	}
+	cmdPtr = preCmdPtr;
+    } else {
 	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
 	if (!cmdPtr) {
 	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
 	}
-
     }
 
-    if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
-	/*
-	 * Call enter traces. They will schedule a call to the leave traces if
-	 * necessary.
-	 */
-
-	int traceCode = TCL_OK;
-	int cmdEpoch = cmdPtr->cmdEpoch;
-	int newEpoch;
-	const char *command;
-	int length, deleted;
+    if (enterTracesDone || iPtr->tracePtr
+	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
 
 	Tcl_Obj *commandPtr = TclGetSourceFromFrame(
 		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
 		objc, objv);
-
 	Tcl_IncrRefCount(commandPtr);
-	command = Tcl_GetStringFromObj(commandPtr, &length);
 
-	/*
-	 * Call trace functions.
-	 * Execute any command or execution traces. Note that we bump up the
-	 * command's reference count for the duration of the calling of the
-	 * traces so that the structure doesn't go away underneath our feet.
-	 */
+	if (!enterTracesDone) {
 
-	cmdPtr->refCount++;
-	if (iPtr->tracePtr) {
-	    traceCode = TclCheckInterpTraces(interp, command, length,
-		    cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
-	}
-	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
-	    traceCode = TclCheckExecutionTraces(interp, command, length,
-		    cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
-	}
-	newEpoch = cmdPtr->cmdEpoch;
-	deleted = cmdPtr->flags & CMD_IS_DELETED;
-	TclCleanupCommandMacro(cmdPtr);
-
-	if (traceCode != TCL_OK) {
-	    Tcl_DecrRefCount(commandPtr);
-	    return traceCode;
-	}
-
-	if (cmdEpoch != newEpoch) {
+	    int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
+		    objc, objv);
 
 	    /*
-	     * The traces did something to the traced command.  How should
-	     * we respond?
-	     *
-	     * If we got the trace command by looking up a command name, we
-	     * should just look it up again.
+	     * Send any exception from enter traces back as an exception
+	     * raised by the traced command.
 	     */
-	    if (preCmdPtr == NULL) {
-		cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
-	    } else {
 
-		/*
-		 * If we did not look up a command name, we got the cmdPtr
-		 * from a caller.  If that cmdPtr has been deleted, we need
-		 * to avoid a crash.  Otherwise, press on.  We don't have
-		 * any foundation to claim a better answer.
-		 */
-		if (deleted) {
-		    cmdPtr = NULL;
-		}
+	    if (code != TCL_OK) {
+		Tcl_DecrRefCount(commandPtr);
+		return code;
 	    }
-	}
 
-	if (cmdPtr) {
 	    /*
-	     * Command was found: push a record to schedule the leave traces.
+	     * If the enter traces made the resolved cmdPtr unusable, go
+	     * back and resolve again, but next time don't run enter
+	     * traces again.
 	     */
 
-	    TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
-		    commandPtr, cmdPtr, objv);
-	    cmdPtr->refCount++;
-	} else {
-	    Tcl_DecrRefCount(commandPtr);
-	}
-
-	if (cmdPtr == NULL) {
-	    if (preCmdPtr == NULL) {
-		return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+	    if (cmdPtr == NULL) {
+		enterTracesDone = 1;
+		Tcl_DecrRefCount(commandPtr);
+		goto reresolve;
 	    }
-	    /* Is this right??? */
-	    return TCL_OK;
 	}
+
+	/* 
+	 * Schedule leave traces.  Raise the refCount on the resolved
+	 * cmdPtr, so that when it passes to the leave traces we know
+	 * it's still valid.
+	 */
+
+	cmdPtr->refCount++;
+	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
+		    commandPtr, cmdPtr, objv);
     }
 
     TclNRAddCallback(interp, Dispatch,
@@ -4672,26 +4635,19 @@ TEOV_RunEnterTraces(
     Command **cmdPtrPtr,
     Tcl_Obj *commandPtr,
     int objc,
-    Tcl_Obj *const objv[],
-    Namespace *lookupNsPtr,
-    int weLookUp)
+    Tcl_Obj *const objv[])
 {
     Interp *iPtr = (Interp *) interp;
     Command *cmdPtr = *cmdPtrPtr;
-    int traceCode = TCL_OK;
-    int cmdEpoch = cmdPtr->cmdEpoch;
-    int newEpoch;
-    const char *command;
-    int length, deleted;
-
-    Tcl_IncrRefCount(commandPtr);
-    command = Tcl_GetStringFromObj(commandPtr, &length);
+    int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+    int length, traceCode = TCL_OK;
+    const char *command = Tcl_GetStringFromObj(commandPtr, &length);
 
     /*
      * Call trace functions.
      * Execute any command or execution traces. Note that we bump up the
-     * command's reference count for the duration of the calling of the traces
-     * so that the structure doesn't go away underneath our feet.
+     * command's reference count for the duration of the calling of the
+     * traces so that the structure doesn't go away underneath our feet.
      */
 
     cmdPtr->refCount++;
@@ -4704,47 +4660,15 @@ TEOV_RunEnterTraces(
 		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
     }
     newEpoch = cmdPtr->cmdEpoch;
-    deleted = cmdPtr->flags & CMD_IS_DELETED;
     TclCleanupCommandMacro(cmdPtr);
 
-    if (cmdEpoch != newEpoch) {
-
-	/*
-	 * The traces did something to the traced command.  How should
-	 * we respond?
-	 *
-	 * If we got the trace command by looking up a command name, we
-	 * should just look it up again.
-	 */
-	if (weLookUp) {
-	    cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
-	} else {
-
-	    /*
-	     * If we did not look up a command name, we got the cmdPtr
-	     * from a caller.  If that cmdPtr has been deleted, we need
-	     * to avoid a crash.  Otherwise, press on.  We don't have
-	     * any foundation to claim a better answer.
-	     */
-	    if (deleted) {
-		cmdPtr = NULL;
-	    }
-	}
-	*cmdPtrPtr = cmdPtr;
+    if (traceCode != TCL_OK) {
+	return traceCode;
     }
-
-    if (cmdPtr && (traceCode == TCL_OK)) {
-	/*
-	 * Command was found: push a record to schedule the leave traces.
-	 */
-
-	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
-		commandPtr, cmdPtr, objv);
-	cmdPtr->refCount++;
-    } else {
-	Tcl_DecrRefCount(commandPtr);
+    if (cmdEpoch != newEpoch) {
+	*cmdPtrPtr = NULL;
     }
-    return traceCode;
+    return TCL_OK;
 }
 
 static int
-- 
cgit v0.12


From 012f63b012e81a2c53f6fef7a69cf7672d630a94 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 29 Aug 2013 17:59:36 +0000
Subject: New internal eval flag value so that all TclNREvalObjv() callers that
 pre-resolve command names can choose whether or not TclNREvalObjv() should
 attempt to re-do the resolution from objv[0] when something goes wrong.

---
 generic/tclBasic.c | 75 ++++++++++++++++++++++++++++++++++--------------------
 generic/tclInt.h   |  1 +
 2 files changed, 49 insertions(+), 27 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index bafb4c2..884b5cc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4125,18 +4125,18 @@ EvalObjvCore(
     int objc = PTR2INT(data[2]);
     Tcl_Obj **objv = data[3];
     Interp *iPtr = (Interp *) interp;
+    Namespace *lookupNsPtr = NULL;
     int enterTracesDone = 0;
-
+    
     /*
-     * Capture the namespace we should do command name resolution in, as
-     * instructed by our caller sneaking it in to us in a private interp
-     * field.  Clear that field right away so we cannot possibly have its
-     * use leak where it should not.  The sneaky message pass is done.
+     * Push records for task to be done on return, in INVERSE order. First, if
+     * needed, the exception handlers (as they should happen last).
      */
 
-    Namespace *lookupNsPtr = iPtr->lookupNsPtr;
-    iPtr->lookupNsPtr = NULL;
-    
+    if (!(flags & TCL_EVAL_NOERR)) {
+	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
+    }
+
     if (TCL_OK != TclInterpReady(interp)) {
 	return TCL_ERROR;
     }
@@ -4150,25 +4150,23 @@ EvalObjvCore(
     }
 
     /*
-     * Push records for task to be done on return, in INVERSE order. First, if
-     * needed, the exception handlers (as they should happen last).
-     * TODO: Consider moving this up.
-     */
-
-    if (!(flags & TCL_EVAL_NOERR)) {
-	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
-    }
-
-    /*
      * Configure evaluation context to match the requested flags.
      */
 
-    if (lookupNsPtr) {
+    if (iPtr->lookupNsPtr) {
+
 	/*
-	 * Do nothing.  Caller gave us the lookup namespace.  Use it.
-	 * Overrides TCL_EVAL_GLOBAL.  For both lookup and eval.
+	 * Capture the namespace we should do command name resolution in, as
+	 * instructed by our caller sneaking it in to us in a private interp
+	 * field.  Clear that field right away so we cannot possibly have its
+	 * use leak where it should not.  The sneaky message pass is done.
+	 *
+	 * Use of this mechanism overrides the TCL_EVAL_GLOBAL flag.
 	 * TODO: Is that a bug?
 	 */
+
+	lookupNsPtr = iPtr->lookupNsPtr;
+	iPtr->lookupNsPtr = NULL;
     } else if (flags & TCL_EVAL_INVOKE) {
 	lookupNsPtr = iPtr->globalNsPtr;
     } else {
@@ -4185,16 +4183,29 @@ EvalObjvCore(
 	}
     }
 
+    /*
+     * Lookup the Command to dispatch.
+     */
+
     reresolve:
+    assert(cmdPtr == NULL);
     if (preCmdPtr) {
-	if (preCmdPtr->flags & CMD_IS_DELETED) {
+	/* Caller gave it to us */
+	if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
+	    /* So long as it exists, use it. */
+	    cmdPtr = preCmdPtr;
+	} else if (flags & TCL_EVAL_NORESOLVE) {
+	    /*
+	     * When it's been deleted, and we're told not to attempt
+	     * resolving it ourselves, all we can do is raise an error.
+	     */
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "attempt to invoke a deleted command"));
 	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
 	    return TCL_ERROR;
 	}
-	cmdPtr = preCmdPtr;
-    } else {
+    }
+    if (cmdPtr == NULL) {
 	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
 	if (!cmdPtr) {
 	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
@@ -4217,6 +4228,11 @@ EvalObjvCore(
 	    /*
 	     * Send any exception from enter traces back as an exception
 	     * raised by the traced command.
+	     * TODO: Is this a bug?  Letting an execution trace BREAK or
+	     * CONTINUE or RETURN in the place of the traced command?
+	     * Would either converting all exceptions to TCL_ERROR, or
+	     * just swallowing them be better?  (Swallowing them has the
+	     * problem of permanently hiding program errors.)
 	     */
 
 	    if (code != TCL_OK) {
@@ -6524,9 +6540,14 @@ TclNRInvoke(
     /* Avoid the exception-handling brain damage when numLevels == 0 . */
     iPtr->numLevels++;
     Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);
- 
-    /* TODO: how to get re-resolution right */
-    return TclNREvalObjv(interp, objc, objv, 0, cmdPtr);
+
+    /*
+     * Normal command resolution of objv[0] isn't going to find cmdPtr.
+     * That's the whole point of **hidden** commands.  So tell the
+     * Eval core machinery not to even try (and risk finding something wrong).
+     */
+
+    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
 }
 
 static int
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e0e694f..380284f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2201,6 +2201,7 @@ typedef struct Interp {
 #define TCL_ALLOW_EXCEPTIONS		0x04
 #define TCL_EVAL_FILE			0x02
 #define TCL_EVAL_SOURCE_IN_FRAME	0x10
+#define TCL_EVAL_NORESOLVE		0x20
 
 /*
  * Flag bits for Interp structures:
-- 
cgit v0.12