archie/tcl-dp/tests/plugin2.test

# filters.test
#
#	This file tests the correct functioning of the in-built filter functions.
#	The code for plug-in channels is assumed to work correctly.
#

if {[string compare test [info procs test]] == 1} then {source ../tests/defs}

# set VERBOSE 1

test filters-1.1.1 {create test files and strings} {
    list [catch {

	set x "abcdefghijklmnopqrstuvxyzABCDEFG"
	set y "ABCDEFGHIJKLMNOPQRSTUVXYZABCDEFG"

	for {set i 0} {[expr $i < 10]} {incr i} {
	    set x $x$x
	    set y $y$y
	}

	set f [open ___1 {WRONLY CREAT TRUNC}]
	puts -nonewline $f $x
	close $f

    } msg] $msg 
} {0 {}}


test filters-1.2.1 {xor plugin filter setup} {
    list [catch {

	set cin  [open ___1 {RDONLY}]
	set xin  [dp_connect plugfilter -channel $cin  -infilter xor]
	set xxin [dp_connect plugfilter -channel $xin  -infilter xor]

	expr [string match plugfilter* $xin] * [string match plugfilter* $xxin]

    } msg] $msg 
} {0 1}


test filters-1.2.2 {xor plugin internal parameter setup} {
    list [catch {

	fconfigure $xin  -inset  "a random string that is not too short"
	fconfigure $xin  -translation binary
	fconfigure $xxin -inset "a random string that is not too short"
	fconfigure $xxin -translation binary

    } msg] $msg 
} {0 {}}

test filters-1.2.3 {xor plugin internal parameter setup} {
    list [catch {

	fconfigure $xin -inset "this will not succeed"

    } msg] $msg 
} {1 {can't set option this will not succeed for input filter}}


test filters-1.2.4 {xor plugin filters used and checked} {
    list [catch {

	set x1 [ read $xxin 100000 ]

	close $cin
	close $xin
	close $xxin

	string compare $x $x1

    } msg] $msg 
} {0 0}


test filters-1.3.1 {xor and uuencode composite filter setup} {
    list [catch {

	set cin  [open ___1 {RDONLY}]
	fconfigure $cin -translation binary
	set xin  [dp_connect plugfilter -channel $cin  -infilter xor]
	fconfigure $xin -translation binary -inset "any string"
	set xxin [dp_connect plugfilter -channel $xin  -infilter uuencode]
	fconfigure $xxin -translation binary

	expr [string match plugfilter* $xin] *[string match plugfilter* $xxin]

    } msg] $msg 
} {0 1}

test filters-1.3.2 {xor and uudecode composite filter setup} {
    list [catch {

	set cout  [open ___1x {WRONLY CREAT TRUNC}]
	fconfigure $cout -translation binary
	set xout  [dp_connect plugfilter -channel $cout  -outfilter xor]
	fconfigure $xout -translation binary -outset "any string"
	set xxout [dp_connect plugfilter -channel $xout  -outfilter uudecode]
	fconfigure $xxout -translation binary

	expr [string match plugfilter* $xout] * [string match plugfilter* $xxout]

    } msg] $msg 
} {0 1}

test filters-1.3.3 {xor/uuencode and uudecode/xor filters used and checked } {
    list [catch {

	dp_copy $xxin $xxout

	close $cin
	close $xin
	close $xxin
	close $xxout
	close $xout
	close $cout

	set cin [open ___1x {RDONLY}]
	set rx [read $cin 100000]
	close $cin

	string compare $rx $x

    } msg] $msg 
} {0 0}

test filters-1.4.1 {packon plugin filter setup} {
    list [catch {

	set cin  [open ___1 {RDONLY}]
	set cout [open ___1x {WRONLY CREAT TRUNC}]

	set xout [dp_connect plugfilter -channel $cout -outfilter packon]

	string match plugfilter* $xout

    } msg] $msg 
} {0 1}

test filters-1.4.2 {packon filter used} {
    list [catch {

	for {set r [read $cin 500]} {[string length $r] != 0} {set r [read $cin 500]} {
	    puts -nonewline $xout $r
	    flush $xout
	    flush $cout
	}

    } msg] $msg 
} {0 {}}

close $cin
close $xout
close $cout

test filters-1.4.3 {packoff filter setup} {
    list [catch {

		set cin [open ___1x {RDONLY}]
		set xin [dp_connect packoff -channel $cin]
		fconfigure $xin -blocking no

		string match packoff* $xin

    } msg] $msg 
} {0 0}


test filters-1.4.4 {check correct behavior of packon and packoff} {
    list [catch {
	
	set xr ""

	for {set r [read $xin 100]} {[expr [string length $r] != 0]} {set r [read $xin 100 ]} {
	    if {[string length $r] <= 100 } {
			set xr $xr$r
	    } else {
			error "String length > 100"
	    }
	}
	string compare $xr $x
    } msg] $msg 
} {0 0}

close $cin
close $xin

proc MyTclCode {s mode} {

    switch -exact $mode {

	normal -
	eof    -
	flush  {set s [string toupper $s]}
	close  {set s ""}
	default error

    }

    return $s

}

test filters-1.5.1 {tclfilter setup } {
    list [catch {

		set cin [open ___1 {RDONLY}]
		set xin [dp_connect plugfilter -channel $cin -infilter tclfilter]
		string match plugfilter* $xin

    } msg] $msg 
} {0 1}


test filters-1.5.2 {tclfilter configuration} {
    list [catch {
		fconfigure $xin -inset MyTclCode
    } msg] $msg 
} {0 {}}


test filters-1.5.3 {tclfilter configuration} {
    list [catch {
		fconfigure $xin -inset ThisWillFail
    } msg] $msg 
} {1 {can't set option ThisWillFail for input filter}}


test filters-1.5.4 {} {
    list [catch {

	set yr [read $xin 100000]

	close $cin
	close $xin

	string compare $yr $y

    } msg] $msg 
} {0 0}


test filters-1.6.1 {cleanup} {
    list [catch {

	file delete ___1
	file delete ___1x

    } msg] $msg 
} {0 {}}