Tcl Source Code

Artifact 5b8b906d2ebe5e4ebf48957012b670e9e87aa1b1a8cbbe658da43c2caad9d178:

#!/usr/bin/env tclsh
## -*- tcl -*-
# Example application demonstrating issue with zlib inflation
# Channel transform has trouble, result is incomplete by 3096 byte.
# Direct in-memory inflation is ok.
# Stream inflation state is unknown.

# # ## ### ##### ######## ############# ######################

proc main {} {
    inflate-direct    [deflated] [inflated direct]
    inflate-transform [deflated] [inflated transform]

    set d [file size [inflated direct]]
    set t [file size [inflated transform]]
    
    puts "[inflated direct]:    $d"
    puts "[inflated transform]: $t"

    if {$t < $d} {
	puts "Transform under by [expr {$d - $t}], vs direct"
    } elseif {$t > $d} {
	puts "Transform over by [expr {$t - $d}], vs direct"
    } else {
	puts Match
    }
}

proc deflated {}      { file join [file dirname [info script]] example.deflated }
proc inflated {label} { file join [file dirname [info script]] example.$label }

proc inflate-direct {a b} {
    set a [open $a rb]
    set b [open $b wb]

    puts -nonewline $b [zlib inflate [read $a]]

    close $b
    close $a
    return
}

proc inflate-transform {a b} {
    set a [open $a rb]
    set b [open $b wb]

    zlib push inflate $a
    fcopy $a $b

    close $a
    close $b
    return
}

# # ## ### ##### ######## ############# ######################
main
exit

# # ## ### ##### ######## ############# ######################
## scratch

proc __deflate {a b} {
    #puts [info patchlevel]:[info nameofexecutable]
    
    set a [open $a rb]
    set b [open $b wb]

    set ac [read $a] ; close $a
    set bc [zlib deflate $ac]
    puts -nonewline $b $bc
    close $b
    return
    
    #puts IN:\t[fconfigure $a]
    #puts OUT:\t[fconfigure $b]
    
    zlib push deflate $b
    fcopy $a $b
    flush $b
    chan pop $b

    close $a
    close $b
    return
}