Tcl Source Code

Artifact 2df4b4aa0f7e45d55221957cf159ac4f9415fe86:

Attachment "transchan-bug.tcl" to ticket [6141c15186] added by sbron 2015-12-27 11:04:45. (unpublished)

---

#!/usr/bin/env tclsh

# Very minimal transchan implementation
namespace eval trans {
    namespace ensemble create -map {
	initialize init finalize exit write data read data
    }

    proc init {fd mode} {
	return {initialize finalize write read}
    }

    proc exit {fd} {}

    proc data {fd data} {return $data}
}

# Minimal TCP server
proc server {fd host port} {
    puts $fd [string repeat "hello" 5]
    close $fd w
}

set fd [socket -server server 0]
set port [lindex [fconfigure $fd -sock] 2]

# Client reading 5-byte chunks and responding
proc main {port} {
    set fd [socket localhost $port]
    chan push $fd trans
    fconfigure $fd -blocking 0 -buffering none
    fileevent $fd readable [info coroutine]
    while {![eof $fd]} {
	yield
	puts [read $fd 5]
	puts $fd Hi!
    }
    close $fd
    exit
}

coroutine bug main $port

vwait forever