sync/ports
1
0
Fork 0
mirror of https://git.freebsd.org/ports.git synced 2025-07-17 17:29:23 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

After a lively discussion with Tcl developers, fix the TclX

Browse source 
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.
This commit is contained in:
Mikhail Teterin 2014-08-02 00:39:42 +00:00
parent e73be9fa3e
commit a4d1570b48
Notes: svn2git 2021-03-31 03:12:20 +00:00 
svn path=/head/; revision=363773
3 changed files with 296 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
lang/tclX/Makefile
View file

@ -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

277
lang/tclX/files/patch-profile
View file

@ -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);
}
-
-
-

14
lang/tclX/files/tcl86-test-patch Normal file
View file

@ -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}]