diff options
author | sebres <sebres@users.sourceforge.net> | 2017-07-03 13:25:52 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2017-07-03 13:25:52 (GMT) |
commit | b39f779d1efe91fb83782a84d75e0e6bc055a597 (patch) | |
tree | fc1c083878d2824e5138cd85338ba7b40d1203e2 | |
parent | 251c15c11767bc6e33809b3f13eabc1771a0ba85 (diff) | |
download | tcl-b39f779d1efe91fb83782a84d75e0e6bc055a597.zip tcl-b39f779d1efe91fb83782a84d75e0e6bc055a597.tar.gz tcl-b39f779d1efe91fb83782a84d75e0e6bc055a597.tar.bz2 |
after info, after cancel: compare interpreter of the timer-events by direct retrieving via internal representation (ignore foreign events), test cases extended.
-rw-r--r-- | generic/tclTimer.c | 4 | ||||
-rw-r--r-- | tests/timer.test | 26 |
2 files changed, 28 insertions, 2 deletions
diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 4d26742..df974ab 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -1273,7 +1273,7 @@ Tcl_AfterObjCmd( Tcl_DecrRefCount(commandPtr); } } - if (afterPtr != NULL) { + if (afterPtr != NULL && afterPtr->assocPtr->interp == interp) { TclDeleteTimerEntry(AfterInfo2TimerEntry(afterPtr)); } break; @@ -1338,7 +1338,7 @@ Tcl_AfterObjCmd( } afterPtr = GetAfterEvent(assocPtr, objv[2]); - if (afterPtr == NULL) { + if (afterPtr == NULL || afterPtr->assocPtr->interp != interp) { Tcl_AppendResult(interp, "event \"", TclGetString(objv[2]), "\" doesn't exist", NULL); return TCL_ERROR; diff --git a/tests/timer.test b/tests/timer.test index db508e5..d9679e1 100644 --- a/tests/timer.test +++ b/tests/timer.test @@ -326,15 +326,41 @@ set childEvent [x eval {after idle event in child}] test timer-6.19 {Tcl_AfterCmd, info option} { lsort [after info] } [lsort "$event1 $event2"] +test timer-6.19.1 {Tcl_AfterCmd, info option (all events in child)} { + x eval {after info} +} [list $childEvent] test timer-6.20 {Tcl_AfterCmd, info option} { list [catch {after info a b} msg] $msg } {1 {wrong # args: should be "after info ?id?"}} test timer-6.21 {Tcl_AfterCmd, info option} { list [catch {after info $childEvent} msg] $msg } "1 {event \"$childEvent\" doesn't exist}" +test timer-6.21.1 {Tcl_AfterCmd, info option (internal representation)} { + list [catch {x eval [list after info $childEvent]} msg] $msg +} {0 {{event in child} idle}} +test timer-6.21.1 {Tcl_AfterCmd, info option (internal representation)} { + list [catch {x eval [list after info $childEvent]} msg] $msg +} {0 {{event in child} idle}} +test timer-6.21.2 {Tcl_AfterCmd, info option (search using string representation)} { + list [catch {x eval [list after info [string trim " $childEvent "]]} msg] $msg +} {0 {{event in child} idle}} test timer-6.22 {Tcl_AfterCmd, info option} { list [after info $event1] [after info $event2] } {{{event 1} idle} {{event 2} timer}} +test timer-6.22.1 {Tcl_AfterCmd, cancel option (internal representation)} { + after cancel $childEvent; # foreign event - does nothing + # check still available: + list [catch {x eval [list after info $childEvent]} msg] $msg +} {0 {{event in child} idle}} +test timer-6.22.2 {Tcl_AfterCmd, cancel option (search using string representation)} { + after cancel [string trim " $childEvent "]; # foreign event - does nothing + # check still available: + set lst [list [catch {x eval [list after info $childEvent]} msg] $msg] + # cancel again but in child: + x eval [list after cancel [string trim " $childEvent "]] + # check it was canceled: + lappend lst {*}[list [catch {x eval [list after info $childEvent]} msg] $msg] +} [list 0 {{event in child} idle} 1 "event \"$childEvent\" doesn't exist"] after cancel $event1 after cancel $event2 |