tip230 testing

proc K {a b} {set a}

proc identity {cmd args} {
    puts stderr "$cmd"
    switch -exact -- $cmd {
        initialize { return [list initialize finalize read write] }
        finalize   { return }
        write      { return [lindex $args 1] }
        read       { return [lindex $args 1] }
        default    { return -code error "method \"$cmd\" not impl" }
    }
}

proc identity-buffered {cmd args} {
    if {$cmd ni {read drain}} { puts stderr "$cmd" }
    switch -exact -- $cmd {
        initialize {
            foreach {handle} $args break
            variable $handle {}
            return [list initialize finalize read write drain clear]
        }
        finalize   {
            foreach {handle} $args break
            variable $handle
            unset $handle
            return 
        }
        write      { return [lindex $args 1] }
        read       {
            foreach {handle data} $args break
            upvar #0 [namespace which -variable $handle] state
            set len [string length $data]
            append state $data
            set res [string range $state 0 1023]
            set state [string range $state 1024 end]
            incr ::Count [string length $res]
            puts stderr "read data:[string length $data]\
                result:[string length $res]\
                state:[string length $state]"
            return $res
        }
        drain {
            foreach {handle} $args break
            upvar #0 [namespace which -variable $handle] state
            set res $state
            #set state ""
            puts stderr "drain ($args) result:[string length $res]\
                ::Data:[string length $::Data]\
                state:[string length $state]"
            #K $state [set state ""]
            return $res
        }
        clear { return }
        default    { return -code error "method \"$cmd\" not impl" }
    }
}


proc Test {filename {chunk 4096} {transform ::identity-buffered}} {
    variable Data ""; variable Count 0
    set f [open $filename r]
    chan push $f $transform
    set Data [read $f]
    close $f
    puts "orig:[file size $filename] read:[string length $Data] count:$Count"
}

if {!$tcl_interactive} {
    set r [catch [linsert $argv 0 Test] err]
    if {$r} {puts $::errorInfo} elseif {[string length $err]>0} {puts $err}
    exit $r
}