summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authorgriffin <briang42@easystreet.net>2022-08-29 18:05:03 (GMT)
committergriffin <briang42@easystreet.net>2022-08-29 18:05:03 (GMT)
commit603b76f9107442e86b4f3bfd8c506097ca661fa6 (patch)
tree633b228220695ce33446431e5891dc100fe89ccd /generic/tclTest.c
parent858a9e55021e040d64d6183b62ca8e8559f4538c (diff)
parent5e5b9a09942ea8a669f9652d4ede50a0afcc10b3 (diff)
downloadtcl-603b76f9107442e86b4f3bfd8c506097ca661fa6.zip
tcl-603b76f9107442e86b4f3bfd8c506097ca661fa6.tar.gz
tcl-603b76f9107442e86b4f3bfd8c506097ca661fa6.tar.bz2
sync with core-8-branch
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c47
1 files changed, 40 insertions, 7 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index ed5f34b..9284969 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -61,6 +61,21 @@ static Tcl_DString delString;
static Tcl_Interp *delInterp;
/*
+ * One of the following structures exists for each command created by the
+ * "testcmdtoken" command.
+ */
+
+typedef struct TestCommandTokenRef {
+ int id; /* Identifier for this reference. */
+ Tcl_Command token; /* Tcl's token for the command. */
+ struct TestCommandTokenRef *nextPtr;
+ /* Next in list of references. */
+} TestCommandTokenRef;
+
+static TestCommandTokenRef *firstCommandTokenRef = NULL;
+static int nextCommandTokenRefId = 1;
+
+/*
* One of the following structures exists for each asynchronous handler
* created by the "testasync" command".
*/
@@ -1196,9 +1211,9 @@ TestcmdtokenCmd(
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
- Tcl_Command token;
- int *l;
+ TestCommandTokenRef *refPtr;
char buf[30];
+ int id;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -1206,24 +1221,42 @@ TestcmdtokenCmd(
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
- token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
+ refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef));
+ refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
(void *) "original", NULL);
- sprintf(buf, "%p", (void *)token);
+ refPtr->id = nextCommandTokenRefId;
+ nextCommandTokenRefId++;
+ refPtr->nextPtr = firstCommandTokenRef;
+ firstCommandTokenRef = refPtr;
+ sprintf(buf, "%d", refPtr->id);
Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "name") == 0) {
Tcl_Obj *objPtr;
- if (sscanf(argv[2], "%p", &l) != 1) {
+ if (sscanf(argv[2], "%d", &id) != 1) {
+ Tcl_AppendResult(interp, "bad command token \"", argv[2],
+ "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ for (refPtr = firstCommandTokenRef; refPtr != NULL;
+ refPtr = refPtr->nextPtr) {
+ if (refPtr->id == id) {
+ break;
+ }
+ }
+
+ if (refPtr == NULL) {
Tcl_AppendResult(interp, "bad command token \"", argv[2],
"\"", NULL);
return TCL_ERROR;
}
objPtr = Tcl_NewObj();
- Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);
+ Tcl_GetCommandFullName(interp, refPtr->token, objPtr);
Tcl_AppendElement(interp,
- Tcl_GetCommandName(interp, (Tcl_Command) l));
+ Tcl_GetCommandName(interp, refPtr->token));
Tcl_AppendElement(interp, Tcl_GetString(objPtr));
Tcl_DecrRefCount(objPtr);
} else {