Index: modules/coroutine/ChangeLog ================================================================== --- modules/coroutine/ChangeLog +++ modules/coroutine/ChangeLog @@ -1,5 +1,18 @@ +2014-03-24 Trevor Davel + + * coroutine.tcl: Stopped 'read' closing the channel at EOF, which is + * coro_auto.tcl: not the behaviour's of Tcl's built-in read. Bumped + versions to 1.1.3. + * pkgIndex.tcl: Updated version numbers. + +2014-03-24 Andreas Kupries + + * coroutine.tcl: Fixed missing variable "result" in various ok code + * coro_auto.tcl: paths. Bumped versions to 1.1.1 and 1.1.2 + respectively + 2013-05-31 Andreas Kupries * coroutine.tcl: Added Colin Macleod and http://wiki/21555 * coro_auto.tcl: to the set of acknowledged contributors and references for the module. Index: modules/coroutine/coro_auto.tcl ================================================================== --- modules/coroutine/coro_auto.tcl +++ modules/coroutine/coro_auto.tcl @@ -1,10 +1,10 @@ ## -- Tcl Module -- -*- tcl -*- # # ## ### ##### ######## ############# # @@ Meta Begin -# Package coroutine::auto 1.1.2 +# Package coroutine::auto 1.1.3 # Meta platform tcl # Meta require {Tcl 8.6} # Meta require {coroutine 1.1} # Meta license BSD # Meta as::author {Andreas Kupries} @@ -224,11 +224,10 @@ } else { ::chan configure $chan -blocking $blocking append buf $result if {[::chan eof $chan]} { - ::chan close $chan break } } } } else { @@ -255,11 +254,10 @@ ::chan configure $chan -blocking $blocking append buf $result incr left -[string length $result] if {[::chan eof $chan]} { - ::chan close $chan break } elseif {!$left} { break } } @@ -308,7 +306,7 @@ } ::coroutine::auto} # # ## ### ##### ######## ############# ## Ready -package provide coroutine::auto 1.1.2 +package provide coroutine::auto 1.1.3 return Index: modules/coroutine/coroutine.tcl ================================================================== --- modules/coroutine/coroutine.tcl +++ modules/coroutine/coroutine.tcl @@ -1,10 +1,10 @@ ## -- Tcl Module -- -*- tcl -*- # # ## ### ##### ######## ############# # @@ Meta Begin -# Package coroutine 1.1.1 +# Package coroutine 1.1.3 # Meta platform tcl # Meta require {Tcl 8.6} # Meta license BSD # Meta as::author {Andreas Kupries} # Meta as::author {Colin Macleod} @@ -88,13 +88,13 @@ # bottom. Variables there are out of view of the main code, and # can be made visible in the entire coroutine underneath. set cmd [list upvar "#1"] foreach var $args { - lappend cmd $var $var + lappend cmd COROGLOBAL($var) $var } - tailcall $cmd + tailcall {*}$cmd } # - -- --- ----- -------- ------------- proc ::coroutine::util::after {delay} { @@ -261,11 +261,10 @@ } else { ::chan configure $chan -blocking $blocking append buf $result if {[::chan eof $chan]} { - ::chan close $chan break } } } } else { @@ -292,11 +291,10 @@ ::chan configure $chan -blocking $blocking append buf $result incr left -[string length $result] if {[::chan eof $chan]} { - ::chan close $chan break } elseif {!$left} { break } } @@ -371,7 +369,7 @@ variable counter 0 } # # ## ### ##### ######## ############# ## Ready -package provide coroutine 1.1.1 +package provide coroutine 1.1.3 return ADDED modules/coroutine/coroutine.test Index: modules/coroutine/coroutine.test ================================================================== --- /dev/null +++ modules/coroutine/coroutine.test @@ -0,0 +1,120 @@ +# coroutine.test +# +# Tests for the coroutine package +# +# Copyright (C) 2014 Trevor Davel +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- + +package require tcltest + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.6 +testsNeedTcltest 2.3 + +testing { + useLocal coroutine.tcl coroutine ::coroutine::util +} + + +# ----- Helpers ---------------------------------------------------------------- + + + # Resume a coroutine in a tight loop and collect its output as a list. When + # the coroutine terminates return the list. + proc Test_collect {coro} { + set coro [uplevel 1 [list namespace which -command $coro]] + set result {} + while { [info commands $coro] ne {} } { + lappend result [$coro] + } + set result + } + + +# ----- coroutine::util::create ------------------------------------------------ + + # coroutine::util::create should create a coroutine with a unique name + + test coroutine-1.1 {coroutine::util::create} -body { + set coroid [namespace eval ::coroutine::util { + create apply {{} { + yield [info coroutine] + yield "alpha" + return "beta" + }} + }] + Test_collect $coroid + } -result {alpha beta} + + +# ----- coroutine::util::global ------------------------------------------------ + + # coroutine::util::global should link to a coro-global variable, not an + # interp-global variable. It should work at all stack levels _including + # the first frame of the coroutine_, should not tramp on the first frame's + # local vars, and should be auto-created if necessary by commands like + # [incr]/[append] (from any stack level). [global] can be called with + # multiple variable names. + + proc ::coroutine::util::Test_global {} { + global myglobal + incr myglobal + yield $::myglobal + yield $myglobal + return [apply [list {} { + global strglobal myglobal + incr myglobal + yield $::myglobal + yield $myglobal + return [append strglobal "ghi"] + } [namespace current]]] + } + + test coroutine-2.1 {coroutine::util::global} -body { + set myglobal 10 + set strglobal "abc" + + set coroid [namespace eval ::coroutine::util { + create apply [list {} { + yield [info coroutine] + global myglobal + incr myglobal ;# Create coro-global that doesn't exist yet + yield $::myglobal ;# Dereference interp/real global + yield $myglobal ;# Dereference coro-global + return [apply [list {} { ;# Push another stack frame + global myglobal strglobal + incr myglobal + append strglobal "def" + yield $::myglobal + yield $myglobal + yield $::strglobal + yield $strglobal + return [Test_global] ;# And another two stack frames, one is named + } [namespace current]]] ;# All the coro's stack frames must have access + } [namespace current]] ;# to the overridden [global] command + }] + Test_collect $coroid + } -result {10 1 10 2 abc def 10 3 10 4 defghi} + + catch { unset myglobal } + + +# ----- coroutine::util::after ------------------------------------------------- + + + # Work in progress + # - coroutine::util::global functionality has been slightly modified in + # order to work correctly at frame #1. This may need to be reviewed. + # The new approach prevents tramping on frame #1's local variables. + # If trampling is intended then we may need a workaround to detect use of + # 'global' in frame #1 and make it a noop. + # - Run tests with: %TCLSH% sak.tcl test run coroutine + +testsuiteCleanup +return Index: modules/coroutine/pkgIndex.tcl ================================================================== --- modules/coroutine/pkgIndex.tcl +++ modules/coroutine/pkgIndex.tcl @@ -1,3 +1,3 @@ if {![package vsatisfies [package provide Tcl] 8.6]} {return} -package ifneeded coroutine 1.1 [list source [file join $dir coroutine.tcl]] -package ifneeded coroutine::auto 1.1.1 [list source [file join $dir coro_auto.tcl]] +package ifneeded coroutine 1.1.3 [list source [file join $dir coroutine.tcl]] +package ifneeded coroutine::auto 1.1.3 [list source [file join $dir coro_auto.tcl]]