diff options
| -rw-r--r-- | generic/tclTest.c | 56 | ||||
| -rw-r--r-- | tests/basic.test | 6 | ||||
| -rw-r--r-- | tests/cmdInfo.test | 6 |
3 files changed, 46 insertions, 22 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index fbd4774..5b57157 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -70,6 +70,7 @@ static Tcl_Interp *delInterp; typedef struct TestCommandTokenRef { int id; /* Identifier for this reference. */ Tcl_Command token; /* Tcl's token for the command. */ + const char *value; struct TestCommandTokenRef *nextPtr; /* Next in list of references. */ } TestCommandTokenRef; @@ -1179,6 +1180,18 @@ TestcmdinfoCmd( } static int +CmdProc0( + void *clientData, /* String to return. */ + Tcl_Interp *interp, /* Current interpreter. */ + TCL_UNUSED(int) /*argc*/, + TCL_UNUSED(const char **) /*argv*/) +{ + TestCommandTokenRef *refPtr = (TestCommandTokenRef *) clientData; + Tcl_AppendResult(interp, "CmdProc1 ", refPtr->value, NULL); + return TCL_OK; +} + +static int CmdProc1( void *clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ @@ -1189,6 +1202,7 @@ CmdProc1( return TCL_OK; } + static int CmdProc2( void *clientData, /* String to return. */ @@ -1201,6 +1215,28 @@ CmdProc2( } static void +CmdDelProc0( + void *clientData) /* String to save. */ +{ + TestCommandTokenRef *thisRefPtr, *prevRefPtr = NULL; + TestCommandTokenRef *refPtr = (TestCommandTokenRef *) clientData; + int id = refPtr->id; + for (thisRefPtr = firstCommandTokenRef; refPtr != NULL; + thisRefPtr = thisRefPtr->nextPtr) { + if (thisRefPtr->id == id) { + if (prevRefPtr != NULL) { + prevRefPtr->nextPtr = thisRefPtr->nextPtr; + } else { + firstCommandTokenRef = thisRefPtr->nextPtr; + } + break; + } + prevRefPtr = thisRefPtr; + } + ckfree(refPtr); +} + +static void CmdDelProc1( void *clientData) /* String to save. */ { @@ -1242,7 +1278,7 @@ TestcmdtokenCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - TestCommandTokenRef *refPtr, *prevRefPtr; + TestCommandTokenRef *refPtr; char buf[30]; int id; @@ -1253,9 +1289,10 @@ TestcmdtokenCmd( } if (strcmp(argv[1], "create") == 0) { refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef)); - refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc1, - (void *) "original", NULL); + refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc0, + refPtr, CmdDelProc0); refPtr->id = nextCommandTokenRefId; + refPtr->value = "original"; nextCommandTokenRefId++; refPtr->nextPtr = firstCommandTokenRef; firstCommandTokenRef = refPtr; @@ -1291,19 +1328,6 @@ TestcmdtokenCmd( Tcl_GetCommandName(interp, refPtr->token)); Tcl_AppendElement(interp, Tcl_GetString(objPtr)); Tcl_DecrRefCount(objPtr); - } else if (strcmp(argv[1], "free") == 0) { - prevRefPtr = NULL; - for (refPtr = firstCommandTokenRef; refPtr != NULL; - refPtr = refPtr->nextPtr) { - if (refPtr->id == id) { - if (prevRefPtr != NULL) { - prevRefPtr->nextPtr = refPtr->nextPtr; - } - ckfree(refPtr); - break; - } - prevRefPtr = refPtr; - } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, name, or free", NULL); diff --git a/tests/basic.test b/tests/basic.test index de986c7..c90d80e 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -336,19 +336,19 @@ test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespace }] list [testcmdtoken name $x] \ [rename ::p q] \ - [testcmdtoken name $x][testcmdtoken free $x] + [testcmdtoken name $x] } {{p ::p} {} {q ::q}} test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {testcmdtoken} { catch {rename q ""} set x [testcmdtoken create test_ns_basic::test_ns_basic2::p] list [testcmdtoken name $x] \ [rename test_ns_basic::test_ns_basic2::p q] \ - [testcmdtoken name $x][testcmdtoken free $x] + [testcmdtoken name $x] } {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}} test basic-20.3 {Tcl_GetCommandInfo, #-quoting} testcmdtoken { catch {rename \# ""} set x [testcmdtoken create \#] - return [testcmdtoken name $x][testcmdtoken free $x] + return [testcmdtoken name $x] } {{#} ::#} test basic-21.1 {Tcl_GetCommandName} {emptyTest} { diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test index ad564d7..37b8a0b 100644 --- a/tests/cmdInfo.test +++ b/tests/cmdInfo.test @@ -70,7 +70,7 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \ rename x1 newName set y [testcmdtoken name $x] rename newName x1 - lappend y {*}[testcmdtoken name $x][testcmdtoken free $x] + lappend y {*}[testcmdtoken name $x] } {newName ::newName x1 ::x1} catch {rename newTestCmd {}} @@ -87,7 +87,7 @@ test cmdinfo-5.1 {Names for commands created when inside namespaces} \ }] set y [testcmdtoken name $x] rename ::testCmd newTestCmd - lappend y {*}[testcmdtoken name $x][testcmdtoken free $x] + lappend y {*}[testcmdtoken name $x] } {testCmd ::testCmd newTestCmd ::newTestCmd} test cmdinfo-6.1 {Names for commands created when outside namespaces} \ @@ -95,7 +95,7 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} \ set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd] set y [testcmdtoken name $x] rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 - lappend y {*}[testcmdtoken name $x][testcmdtoken free $x] + lappend y {*}[testcmdtoken name $x] } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2} # cleanup |