You can't generally cancel a running coroutine easily. You can of course do
rename runningCoro ""
But then:
::chan event $chan readable [list [info coroutine]]
just like say coroutine::util gets does, then that event will produce an error. Unfortunately I found no way to handle coroutine cancellation without resorting to callbacks. The goods news is tcl allows you to trace command deletion like:
proc cleanup {args} {...}
proc coro {} {
...
trace add command [info coroutine] delete [list cleanup $arg1 $arg2]
...
}Which will allow it to e.g. unsubscribe from fileevent. Quite awkward: another proc has to be created and it also has to accept mostly useless args that trace passes to it in addition to any useful args we may pass from inside the coro.
A better solution is trace not just command deletion, but leaving the current command's scope, i.e. Deferred evaluation, especially since the same cleanup often is done upon normal exit.
To sum up, here's one particular solution I could come up with for cancellable io with coroutines:
namespace eval cio {}
proc cio::defer {args} {
if {[llength $args]==1} {set args [lindex $args 0]} ;# flatten if 1 elem
uplevel {set _defer_var {}}
uplevel [list trace add variable _defer_var unset [list apply [list args $args]]]
}
proc cio::gets {{chan stdin} args} {
::chan configure $chan -blocking 0
defer fileevent $chan readable {}
while {[set res [uplevel gets $chan {*}$args]] eq ""} {
fileevent $chan readable [info coroutine]
yield
}
set res
}
proc cio::puts {args} {
switch -- [llength $args] {
1 {set chan stdin}
2 {set chan [lindex $args 0]}
3 {set chan [lindex $args 1]}
default {tailcall ::chan puts {*}$args; #calling original with bogus args
}
}
::chan configure $chan -blocking 0
defer fileevent $chan writable {}
fileevent $chan readable [info coroutine]
yield
uplevel gets $chan {*}$args
}
proc cio::after {} {
set id [::after $delay [list [info coroutine]]]
defer after cancel $id
yield
}
proc ::cio::read {args} {
set chop no ; # !-nonewline
set total "" ;# "" = until eof
# parse args
if {[set chan [lindex $args 0]] eq "-nonewline"} {
set chop yes
set chan [lindex $args 1]
} else {
set total [lindex $args 1]
}
::chan configure $chan -blocking 0
# run loop
set buf {}
::chan event $chan readable [info coroutine]
defer ::chan even $chan readable {}
if {$total eq ""} {; # Loop until eof
while {![::chan eof $chan]} {
yield
append buf [::chan read $chan]
}
} else {
# Loop til eof or $total chars read
while {$total >0 && ![::chan eof $chan]} {
set chunk [::chan read $chan $total]
append buf $chunk
incr total -[string length $chunk]
}
}
if {$chop && [string index $buf end] eq "\n"} {
set buf [string range $buf 0 end-1]
}
return $buf
}None of these will not cause background errors should its caller be destroyed during the call unlike coroutine::util. They may of course cause numerous other errors as this is hardly tested!
It's still sub-optimal: no error is raised in the caller, and if the callers wants to do some of its own cleanup, it's going to have to defer too. Less straightforward than something like
proc coro {} {
if {[catch {imaginary_cancellable_gets $chan} err]} {
if {$err eq "cancelled"} {
<cleanup>
}
}
}would be. But that's not possible to do with the current tcl coro mechanism, is it?
PYK 2022-03-22
This entire page is an XY problem. Cancellation of this sort is at the very least a code smell. A coroutine is best viewed as a "separate program", complete with its own control flow. Since a coroutines share the same larger environment and can have arbitrary effects, it is rather futile to attempt the sort of general external approach to resource cleanup described on this page. Coroutines are designed to execute in a collaborative fashion, and a coroutine itself is in the best position to know how to clean up whatever resources it has engaged. Each coroutine should be a good citizien and leave the shared environment in a better place than it found it in. The documentation for any coroutine available for use by third parties should describe the things that are normally described for an individual program: What it does, how to use it, what to pass to it, what it produces, and what its effects are.
Since coroutines do not execute concurrently, it isn't running at the moment rename might be used to delete, so there is always a chance to issue a command to the coroutine instead. This means that a coroutine can develop an interface that it can use to distinguish callbacks it has scheduled for itself from commands issued to it by a third party. A termination and cleanup routine can be a documented part of that interface. This keeps any complexity associated with cleanup neatly encapsulated within the coroutine itself. The script below provides and example of this idea, where the interface handles both channel event callbacks and termination requests:
#! /usr/bin/env tclsh
package require coroutine
proc {on timeout} chan {
puts [list {got a timeout} $chan]
}
proc main_coro {chan timeout} {
variable status
yield [info coroutine]
chan event $chan readable [list [info coroutine] chan $chan]
set timer {}
while 1 {
after cancel $timer
set timer [after 1500 [list [info coroutine] timeout] $chan]
set event [yieldto return -level 0]
lassign $event type
switch $type {
bye {
close $chan
set status 0
break
}
chan {
set chan [lindex $event 1]
set chars [gets $chan line]
if {$chars >= 0} {
puts [list chan $chan line $line]
}
}
timeout {
{*}$timeout [lindex $event 1]
}
default {
error [list {unknown command} $event]
}
}
}
puts [list {coroutine finished}]
}
chan configure stdin -blocking 0
set coro1 [coroutine main main_coro stdin [list [namespace which {on timeout}]]]
after 0 [list $coro1]
after 10000 [list $coro1 bye]
vwait [namespace current]::status
if {$status} {
error {something went wrong}
}Another note: To avoid double substitution, the line,
uplevel gets $chan {*}$args]should instead be
uplevel [list gets $chan {*}$args]