diff options
| -rw-r--r-- | generic/tclTest.c | 44 | ||||
| -rw-r--r-- | tests/basic.test | 6 | ||||
| -rw-r--r-- | tests/cmdInfo.test | 6 |
3 files changed, 36 insertions, 20 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index b6c7f77..72eca6c 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1206,7 +1206,7 @@ TestcmdtokenCmd( int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - TestCommandTokenRef *refPtr; + TestCommandTokenRef *refPtr, *prevRefPtr; char buf[30]; int id; @@ -1225,9 +1225,7 @@ TestcmdtokenCmd( firstCommandTokenRef = refPtr; sprintf(buf, "%d", refPtr->id); Tcl_AppendResult(interp, buf, NULL); - } else if (strcmp(argv[1], "name") == 0) { - Tcl_Obj *objPtr; - + } else { if (sscanf(argv[2], "%d", &id) != 1) { Tcl_AppendResult(interp, "bad command token \"", argv[2], "\"", NULL); @@ -1247,18 +1245,36 @@ TestcmdtokenCmd( return TCL_ERROR; } - objPtr = Tcl_NewObj(); - Tcl_GetCommandFullName(interp, refPtr->token, objPtr); + if (strcmp(argv[1], "name") == 0) { + Tcl_Obj *objPtr; - Tcl_AppendElement(interp, - Tcl_GetCommandName(interp, refPtr->token)); - Tcl_AppendElement(interp, Tcl_GetString(objPtr)); - Tcl_DecrRefCount(objPtr); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create or name", NULL); - return TCL_ERROR; + objPtr = Tcl_NewObj(); + Tcl_GetCommandFullName(interp, refPtr->token, objPtr); + + Tcl_AppendElement(interp, + 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); + return TCL_ERROR; + } } + return TCL_OK; } diff --git a/tests/basic.test b/tests/basic.test index f4c57fe..de986c7 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 name $x][testcmdtoken free $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 name $x][testcmdtoken free $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 \#] - testcmdtoken name $x + return [testcmdtoken name $x][testcmdtoken free $x] } {{#} ::#} test basic-21.1 {Tcl_GetCommandName} {emptyTest} { diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test index 37b8a0b..ad564d7 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] + lappend y {*}[testcmdtoken name $x][testcmdtoken free $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] + lappend y {*}[testcmdtoken name $x][testcmdtoken free $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] + lappend y {*}[testcmdtoken name $x][testcmdtoken free $x] } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2} # cleanup |