Posted to tcl by patthoyts at Mon Feb 22 23:07:39 GMT 2010view pretty

test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
    zlib
} -setup {
    proc bgerror {s} {set ::total [list error $s]}
    proc zlibRead {c} {
        if {[gets $c line] < 0} {
            close $c
            set ::total [list error -1]
        } elseif {[eof $c]} {
            chan event $c readable {}
            close $c
            set ::total [list eof [string length $d]]
        }
    }
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none
        zlib push inflate $c
        chan event $c readable [list zlibRead $c]
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    chan configure $s -translation binary -buffering none
    zlib push gzip $s
    chan event $s readable [list zlibRead $s]
    after idle [list apply {{s} {
        puts $s test
        chan close $s
        after 100 {set ::total done}
    }} $s]
    vwait ::total
    set ::total
} -cleanup {
    close $srv
    rename bgerror {}
    rename zlibRead {}
} -result {error {invalid block type}}