Tcl Source Code

Artifact acd6d3db5d872f0604336b2a00bb69da8ba90d6b:

Attachment "testeof.tcl" to ticket [2953175fff] added by pspjuth 2010-02-17 06:48:14.

---

proc Response {ch} {
    puts $ch "x"
    puts $ch ""
    # Slow down the response to make the wait visible in the client
    after 100 [info coroutine] ; yield
    set zd [zlib compress [string repeat 10000 10000]]
    puts -nonewline $ch $zd
    close $ch
    puts "Server Closed after sending [string length $zd]"
}

proc Connect {ch addr port} {
    chan configure $ch -buffering none -translation binary
    puts "Server Connect"
    coroutine srv Response $ch
}

socket -server Connect 46739

proc Readable {ch} {
    set n [gets $ch line]
    puts "Read line length [string length $line]"

    if {[eof $ch]} {
        puts "EOF"
        set data [read $ch 4]
        if {$data ne ""} {
            puts "Data after EOF [string length $data]"
        }
        close $ch
        exit
    }
    if {$n == 0} {
        puts "Switch to zlib"
        zlib push decompress $ch
    }
}

set ch [socket localhost 46739]
chan configure $ch -translation binary
# Skip this wait to make it work
after 500 set forever 1 ; vwait forever
chan event $ch readable [list Readable $ch]
vwait forever