After a lively discussion with Tcl developers, fix the TclX

profile-code to use the official API-calls instead of modifying
Tcl's internal data-structures directly.

The profile command now works again. Will try to have the change
committed upstream.

3 files changed, 296 insertions, 4 deletions

diff --git a/lang/tclX/Makefile b/lang/tclX/Makefile
index 5ce81a4128c5..0d4f52622bf3 100644
--- a/lang/tclX/Makefile
+++ b/lang/tclX/Makefile
@@ -33,12 +33,13 @@ INSTALL_TARGET=	install-binaries install-libraries
 .if ${TCL_VER} > 8.4
 EXTRA_PATCHES+=	${FILESDIR}/tcl85-test-patch
 .endif
+.if ${TCL_VER} > 8.5
+EXTRA_PATCHES+=	${FILESDIR}/tcl86-test-patch
+.endif
 
 post-configure:
-.if ${TCL_VER} == 8.6
-	# Disabling the failing profile.test
-	${MV} ${WRKSRC}/tests/profile.test ${WRKSRC}/tests/profile.test.dis
-.endif
+	# Disabling the failing help.test
+	${MV} ${WRKSRC}/tests/help.test ${WRKSRC}/tests/help.test.dis
 
 post-install:
 	${INSTALL_DATA} ${WRKSRC}/doc/TclX.n ${STAGEDIR}${PREFIX}/man/mann
diff --git a/lang/tclX/files/patch-profile b/lang/tclX/files/patch-profile
index 395d1f7bd3d8..31abb3ce79ef 100644
--- a/lang/tclX/files/patch-profile
+++ b/lang/tclX/files/patch-profile
@@ -83,3 +83,280 @@ Getting it committed upstream...
 +#endif
  #ifndef CLK_TCK
  #    ifdef HZ
+
+See:
+
+http://core.tcl.tk/tcl/tktview?name=cd82cec7ce46a55af099b32b798398a78a505ef4
+
+for background of this patch.
+
+	-mi
+
+--- generic/tclXprofile.c	2012-11-06 18:00:07.000000000 -0500
++++ generic/tclXprofile.c	2014-08-01 20:10:11.000000000 -0400
+@@ -68,9 +68,6 @@
+     int             commandMode;           /* Prof all commands?             */
+     int             evalMode;              /* Use eval stack.                */
+-    Command        *currentCmdPtr;         /* Current command table entry.   */
+-    Tcl_CmdProc    *savedStrCmdProc;       /* Saved string command function  */
+-    ClientData      savedStrCmdClientData; /* and clientData.                */
+-    Tcl_ObjCmdProc *savedObjCmdProc;       /* Saved object command function  */
+-    ClientData      savedObjCmdClientData; /* and clientData.                */
++    Tcl_Command     currentCmd;            /* Current command table entry.   */
++    Tcl_CmdInfo     savedCmdInfo;          /* Details about the current cmd. */
+     int             evalLevel;             /* Eval level when invoked.       */
+     clock_t         realTime;              /* Current real and CPU time.     */
+@@ -89,5 +86,5 @@
+  * Argument to panic on logic errors.  Takes an id number.
+  */
+-static char *PROF_PANIC = "TclX profile bug id = %d\n";
++static const char *PROF_PANIC = "TclX profile bug id = %d\n";
+ 
+ /*
+@@ -96,5 +93,5 @@
+ static void
+ PushEntry _ANSI_ARGS_((profInfo_t *infoPtr,
+-                       char       *cmdName,
++                       const char *cmdName,
+                        int         isProc,
+                        int         procLevel,
+@@ -112,5 +109,5 @@
+ UpdateTOSTimes _ANSI_ARGS_((profInfo_t *infoPtr));
+ 
+-static Command *
++static void
+ ProfCommandEvalSetup _ANSI_ARGS_((profInfo_t *infoPtr,
+                                   int        *isProcPtr));
+@@ -132,13 +129,5 @@
+                                 Tcl_Obj      *CONST objv[]));
+ 
+-static void
+-ProfTraceRoutine _ANSI_ARGS_((ClientData    clientData,
+-                              Tcl_Interp   *interp,
+-                              int           evalLevel,
+-                              char         *command,
+-                              Tcl_CmdProc  *cmdProc,
+-                              ClientData    cmdClientData,
+-                              int           argc,
+-                              char        **argv));
++static Tcl_CmdObjTraceProc ProfTraceRoutine;
+ 
+ static void
+@@ -194,5 +183,5 @@
+ PushEntry (infoPtr, cmdName, isProc, procLevel, scopeLevel, evalLevel)
+     profInfo_t *infoPtr;
+-    char       *cmdName;
++    const char *cmdName;
+     int         isProc;
+     int         procLevel;
+@@ -396,5 +385,5 @@
+  *-----------------------------------------------------------------------------
+  */
+-static Command *
++static void
+ ProfCommandEvalSetup (infoPtr, isProcPtr)
+     profInfo_t *infoPtr;
+@@ -402,31 +391,33 @@
+ {
+     Interp *iPtr = (Interp *) infoPtr->interp;
+-    Command *currentCmdPtr;
++    Tcl_CmdInfo cmdInfo;
+     CallFrame *framePtr;
+     int procLevel, scopeLevel, isProc;
+     Tcl_Obj *fullCmdNamePtr;
+-    char *fullCmdName;
++    const char *fullCmdName;
+ 
++    Tcl_GetCommandInfoFromToken(infoPtr->currentCmd, &cmdInfo);
+     /*
+      * Restore the command table entry.  If the command has modified it, don't
+      * mess with it.
+      */
+-    currentCmdPtr = infoPtr->currentCmdPtr;
+-    if (currentCmdPtr->proc == ProfStrCommandEval)
+-        currentCmdPtr->proc = infoPtr->savedStrCmdProc;
+-    if (currentCmdPtr->clientData == (ClientData) infoPtr)
+-        currentCmdPtr->clientData = infoPtr->savedStrCmdClientData;
+-    if (currentCmdPtr->objProc == ProfObjCommandEval)
+-        currentCmdPtr->objProc = infoPtr->savedObjCmdProc;
+-    if (currentCmdPtr->objClientData == (ClientData) infoPtr)
+-        currentCmdPtr->objClientData = infoPtr->savedObjCmdClientData;
+-    infoPtr->currentCmdPtr = NULL;
+-    infoPtr->savedStrCmdProc = NULL;
+-    infoPtr->savedStrCmdClientData = NULL;
+-    infoPtr->savedObjCmdProc = NULL;
+-    infoPtr->savedObjCmdClientData = NULL;
++    if (cmdInfo.proc == ProfStrCommandEval)
++        cmdInfo.proc = infoPtr->savedCmdInfo.proc;
++    if (cmdInfo.clientData == (ClientData) infoPtr)
++        cmdInfo.clientData = infoPtr->savedCmdInfo.clientData;
++    if (cmdInfo.objProc == ProfObjCommandEval)
++        cmdInfo.objProc = infoPtr->savedCmdInfo.objProc;
++    if (cmdInfo.objClientData == (ClientData) infoPtr)
++        cmdInfo.objClientData = infoPtr->savedCmdInfo.objClientData;
++    if (cmdInfo.deleteProc == NULL)
++        cmdInfo.deleteProc = infoPtr->savedCmdInfo.deleteProc;
++    if (cmdInfo.deleteData == NULL)
++        cmdInfo.deleteData = infoPtr->savedCmdInfo.deleteData;
++    cmdInfo.isNativeObjectProc = infoPtr->savedCmdInfo.isNativeObjectProc;
++
++    Tcl_SetCommandInfoFromToken(infoPtr->currentCmd, &cmdInfo);
+ 
+     fullCmdNamePtr = Tcl_NewObj ();
+-    Tcl_GetCommandFullName (infoPtr->interp, (Tcl_Command) currentCmdPtr, 
++    Tcl_GetCommandFullName (infoPtr->interp, infoPtr->currentCmd, 
+                             fullCmdNamePtr);
+     fullCmdName = Tcl_GetStringFromObj (fullCmdNamePtr, NULL);
+@@ -447,10 +438,11 @@
+      * on the stack before we started.  Pop those entries.
+      */
+-    if (infoPtr->stackPtr->procLevel > procLevel)
++    if (infoPtr->stackPtr->procLevel > procLevel) {
+         UpdateTOSTimes (infoPtr);
+-    while (infoPtr->stackPtr->procLevel > procLevel) {
+-        if (infoPtr->stackPtr->evalLevel != UNKNOWN_LEVEL) 
+-            panic (PROF_PANIC, 2);  /* Not an initial entry */
+-        PopEntry (infoPtr);
++        do {
++            if (infoPtr->stackPtr->evalLevel != UNKNOWN_LEVEL) 
++                panic (PROF_PANIC, 2);  /* Not an initial entry */
++            PopEntry (infoPtr);
++        } while (infoPtr->stackPtr->procLevel > procLevel);
+     }
+ 
+@@ -479,5 +471,4 @@
+ 
+     Tcl_DecrRefCount (fullCmdNamePtr);
+-    return currentCmdPtr;
+ }
+ 
+@@ -528,10 +519,9 @@
+ {
+     profInfo_t *infoPtr = (profInfo_t *) clientData;
+-    Command *currentCmdPtr;
+     int isProc, result;
+ 
+-    currentCmdPtr = ProfCommandEvalSetup (infoPtr, &isProc);
++    ProfCommandEvalSetup (infoPtr, &isProc);
+ 
+-    result = (*currentCmdPtr->proc) (currentCmdPtr->clientData, interp,
++    result = (*infoPtr->savedCmdInfo.proc)(infoPtr->savedCmdInfo.clientData, interp,
+                                      argc, argv);
+ 
+@@ -560,11 +550,9 @@
+ {
+     profInfo_t *infoPtr = (profInfo_t *) clientData;
+-    Command *currentCmdPtr;
+     int isProc, result;
+ 
+-    currentCmdPtr = ProfCommandEvalSetup (infoPtr,
+-                                          &isProc);
++    ProfCommandEvalSetup (infoPtr, &isProc);
+ 
+-    result = (*currentCmdPtr->objProc) (currentCmdPtr->objClientData, interp,
++    result = (*infoPtr->savedCmdInfo.objProc)(infoPtr->savedCmdInfo.objClientData, interp,
+                                         objc, objv);
+ 
+@@ -579,54 +567,41 @@
+  *-----------------------------------------------------------------------------
+  */
+-static void
+-ProfTraceRoutine (clientData, interp, evalLevel, command, cmdProc,
+-                  cmdClientData, argc, argv)
++static int
++ProfTraceRoutine (clientData, interp, evalLevel, command, cmd,
++                  objc, objv)
+     ClientData    clientData;
+     Tcl_Interp   *interp;
+     int           evalLevel;
+-    char         *command;
+-    Tcl_CmdProc  *cmdProc;
+-    ClientData    cmdClientData;
+-    int           argc;
+-    char        **argv;
++    const char   *command;
++    Tcl_Command   cmd;
++    int           objc;
++    struct Tcl_Obj * const *objv;
+ {
+     profInfo_t *infoPtr = (profInfo_t *) clientData;
+-    Command *cmdPtr;
+-    Tcl_Command cmd;
+-
+-    if (infoPtr->currentCmdPtr != NULL)
+-        panic (PROF_PANIC, 3);
++    Tcl_CmdInfo cmdInfo;
+ 
+-    cmd = Tcl_FindCommand (interp, argv [0], NULL, 0);
+     if (cmd == NULL)
+         panic (PROF_PANIC, 4);
+-    cmdPtr = (Command *) cmd;
+-
+-    if ((cmdPtr->proc != cmdProc) || (cmdPtr->clientData != cmdClientData))
+-        panic (PROF_PANIC, 5);
+-
+-    /*
+-     * If command is to be compiled, we can't profile it.
+-     */
+-    if (cmdPtr->compileProc != NULL)
+-        return;
+ 
+     /*
+      * Save current state information.
+      */
+-    infoPtr->currentCmdPtr = cmdPtr;
+-    infoPtr->savedStrCmdProc = cmdPtr->proc;
+-    infoPtr->savedStrCmdClientData = cmdPtr->clientData;
+-    infoPtr->savedObjCmdProc = cmdPtr->objProc;
+-    infoPtr->savedObjCmdClientData = cmdPtr->objClientData;
++    Tcl_GetCommandInfoFromToken(cmd, &(infoPtr->savedCmdInfo));
+     infoPtr->evalLevel = evalLevel;
++    infoPtr->currentCmd = cmd;
+ 
+     /*
+      * Force our routines to be called.
+      */
+-    cmdPtr->proc = ProfStrCommandEval;
+-    cmdPtr->clientData = (ClientData) infoPtr;
+-    cmdPtr->objProc = ProfObjCommandEval;
+-    cmdPtr->objClientData = (ClientData) infoPtr;
++    cmdInfo.proc = ProfStrCommandEval;
++    cmdInfo.clientData = (ClientData) infoPtr;
++    cmdInfo.objProc = ProfObjCommandEval;
++    cmdInfo.objClientData = (ClientData) infoPtr;
++    cmdInfo.isNativeObjectProc = infoPtr->savedCmdInfo.isNativeObjectProc;
++    cmdInfo.deleteProc = NULL;
++    cmdInfo.deleteData = NULL;
++    Tcl_SetCommandInfoFromToken(cmd, &cmdInfo);
++
++    return TCL_OK;
+ }
+ 
+@@ -712,7 +687,7 @@
+ 
+     infoPtr->traceHandle =
+-        Tcl_CreateTrace (infoPtr->interp, MAXINT,
+-                         (Tcl_CmdTraceProc *) ProfTraceRoutine,
+-                         (ClientData) infoPtr);
++        Tcl_CreateObjTrace (infoPtr->interp, 0,
++                         TCL_ALLOW_INLINE_COMPILATION, ProfTraceRoutine,
++                         (ClientData) infoPtr, NULL);
+     infoPtr->commandMode = commandMode;
+     infoPtr->evalMode = evalMode;
+@@ -974,9 +949,5 @@
+     infoPtr->commandMode = FALSE;
+     infoPtr->evalMode = FALSE;
+-    infoPtr->currentCmdPtr = NULL;
+-    infoPtr->savedStrCmdProc = NULL;
+-    infoPtr->savedStrCmdClientData = NULL;
+-    infoPtr->savedObjCmdProc = NULL;
+-    infoPtr->savedObjCmdClientData = NULL;
++    infoPtr->currentCmd = NULL;
+     infoPtr->evalLevel = UNKNOWN_LEVEL;
+     infoPtr->realTime = 0;
+@@ -998,5 +969,2 @@
+ 			  (Tcl_CmdDeleteProc*) NULL);
+ }
+-
+-
+-
diff --git a/lang/tclX/files/tcl86-test-patch b/lang/tclX/files/tcl86-test-patch
new file mode 100644
index 000000000000..7812ad31fb35
--- /dev/null
+++ b/lang/tclX/files/tcl86-test-patch
@@ -0,0 +1,14 @@
+--- tests/profile.test	2012-11-06 18:00:07.000000000 -0500
++++ tests/profile.test	2014-08-01 20:23:17.000000000 -0400
+@@ -310,5 +310,4 @@
+ 	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
+ 	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1} \
+-	{{::error ::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
+ 	{{::profile <global>} 1}]
+ 
+@@ -336,5 +335,4 @@
+ 	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
+ 	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1} \
+-	{{::error ::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
+ 	{{::profile <global>} 1}]
+