sl@0: # -*- tcl -*-
sl@0: # Commands covered:  transform, and stacking in general
sl@0: #
sl@0: # This file contains a collection of tests for Giot
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: # 
sl@0: # Copyright (c) 2000 Ajuba Solutions.
sl@0: # Copyright (c) 2000 Andreas Kupries.
sl@0: # All rights reserved.
sl@0: # 
sl@0: # RCS: @(#) $Id: iogt.test,v 1.7.2.1 2005/04/14 07:10:57 davygrvy Exp $
sl@0: 
sl@0: if {[catch {package require tcltest 2.1}]} {
sl@0:     puts stderr "Skipping tests in [info script].  tcltest 2.1 required."
sl@0:     return
sl@0: }
sl@0: namespace eval ::tcl::test::iogt {
sl@0: 
sl@0:     namespace import ::tcltest::cleanupTests
sl@0:     namespace import ::tcltest::makeFile
sl@0:     namespace import ::tcltest::removeFile
sl@0:     namespace import ::tcltest::test
sl@0:     namespace import ::tcltest::testConstraint
sl@0: 
sl@0:     testConstraint testchannel [llength [info commands testchannel]]
sl@0: 
sl@0: set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
sl@0: } dummy]
sl@0: 
sl@0: # " capture coloring of quotes
sl@0: 
sl@0: set path(dummyout) [makeFile {} dummyout]
sl@0: 
sl@0: set path(__echo_srv__.tcl) [makeFile {
sl@0: #!/usr/local/bin/tclsh
sl@0: # -*- tcl -*-
sl@0: # echo server
sl@0: #
sl@0: # arguments, options: port to listen on for connections.
sl@0: #                     delay till echo of first block
sl@0: #                     delay between blocks
sl@0: #                     blocksize ...
sl@0: 
sl@0: set port   [lindex $argv 0]
sl@0: set fdelay [lindex $argv 1]
sl@0: set idelay [lindex $argv 2]
sl@0: set bsizes [lrange $argv 3 end]
sl@0: set c      0
sl@0: 
sl@0: proc newconn {sock rhost rport} {
sl@0:     variable fdelay
sl@0:     variable c
sl@0:     incr   c
sl@0:     variable c$c
sl@0: 
sl@0:     #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout
sl@0: 
sl@0:     upvar 0 c$c conn
sl@0:     set conn(after) {}
sl@0:     set conn(state) 0
sl@0:     set conn(size)  0
sl@0:     set conn(data)  ""
sl@0:     set conn(delay) $fdelay
sl@0: 
sl@0:     fileevent  $sock readable [list echoGet $c $sock]
sl@0:     fconfigure $sock -translation binary -buffering none -blocking 0
sl@0: }
sl@0: 
sl@0: proc echoGet {c sock} {
sl@0:     variable fdelay
sl@0:     variable c$c
sl@0:     upvar 0 c$c conn
sl@0: 
sl@0:     if {[eof $sock]} {
sl@0: 	# one-shot echo
sl@0: 	exit
sl@0:     }
sl@0: 
sl@0:     append conn(data) [read $sock]
sl@0: 
sl@0:     #puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout
sl@0: 
sl@0:     if {$conn(after) == {}} {
sl@0: 	set conn(after) [after $conn(delay) [list echoPut $c $sock]]
sl@0:     }
sl@0: }
sl@0: 
sl@0: proc echoPut {c sock} {
sl@0:     variable idelay
sl@0:     variable fdelay
sl@0:     variable bsizes
sl@0:     variable c$c
sl@0:     upvar 0 c$c conn
sl@0: 
sl@0:     if {[string length $conn(data)] == 0} {
sl@0: 	#puts stdout "C $c $sock" ; flush stdout
sl@0: 	# auto terminate
sl@0: 	close $sock
sl@0: 	exit
sl@0: 	#set conn(delay) $fdelay
sl@0: 	return
sl@0:     }
sl@0: 
sl@0: 
sl@0:     set conn(delay) $idelay
sl@0: 
sl@0:     set n [lindex $bsizes $conn(size)]
sl@0: 
sl@0:     #puts stdout "P $c $sock $n >>" ; flush stdout
sl@0: 
sl@0:     #puts __________________________________________
sl@0:     #parray conn
sl@0:     #puts n=<$n>
sl@0: 
sl@0: 
sl@0:     if {[string length $conn(data)] >= $n} {
sl@0: 	puts -nonewline $sock [string range $conn(data) 0 $n]
sl@0: 	set conn(data) [string range $conn(data) [incr n] end]
sl@0:     }
sl@0: 
sl@0:     incr conn(size)
sl@0:     if {$conn(size) >= [llength $bsizes]} {
sl@0: 	set conn(size) [expr {[llength $bsizes]-1}]
sl@0:     }
sl@0: 
sl@0:     set conn(after) [after $conn(delay) [list echoPut $c $sock]]
sl@0: }
sl@0: 
sl@0: #fileevent stdin readable {exit ;#cut}
sl@0: 
sl@0: # main
sl@0: socket -server newconn $port
sl@0: vwait forever
sl@0: } __echo_srv__.tcl]
sl@0: 
sl@0: 
sl@0: ########################################################################
sl@0: 
sl@0: proc fevent {fdelay idelay blocks script data} {
sl@0:     # start and initialize an echo server, prepare data
sl@0:     # transmission, then hand over to the test script.
sl@0:     # this has to start real transmission via 'flush'.
sl@0:     # The server is stopped after completion of the test.
sl@0: 
sl@0:     # fixed port, not so good. lets hope for the best, for now.
sl@0:     set port 4000
sl@0: 
sl@0:     eval exec tclsh __echo_srv__.tcl \
sl@0: 	    $port $fdelay $idelay $blocks >@stdout &
sl@0: 
sl@0:     after 500
sl@0: 
sl@0:     #puts stdout "> $port" ; flush stdout
sl@0: 
sl@0:     set         sk [socket localhost $port]
sl@0:     fconfigure $sk           \
sl@0: 	    -blocking   0    \
sl@0: 	    -buffering  full \
sl@0: 	    -buffersize [expr {10+[llength $data]}]
sl@0: 
sl@0:     puts -nonewline $sk $data
sl@0: 
sl@0:     # The channel is prepared to go off.
sl@0: 
sl@0:     #puts stdout ">>>>>" ; flush stdout
sl@0: 
sl@0:     uplevel #0 set sock $sk
sl@0:     set res [uplevel #0 $script]
sl@0: 
sl@0:     catch {close $sk}
sl@0:     return $res
sl@0: }
sl@0: 
sl@0: # --------------------------------------------------------------
sl@0: # utility transformations ...
sl@0: 
sl@0: proc id {op data} {
sl@0:     switch -- $op {
sl@0: 	create/write -
sl@0: 	create/read  -
sl@0: 	delete/write -
sl@0: 	delete/read  -
sl@0: 	clear_read   {;#ignore}
sl@0: 	flush/write -
sl@0: 	flush/read  -
sl@0: 	write       -
sl@0: 	read        {
sl@0: 	    return $data
sl@0: 	}
sl@0: 	query/maxRead {return -1}
sl@0:     }
sl@0: }
sl@0: 
sl@0: proc id_optrail {var op data} {
sl@0:     variable $var
sl@0:     upvar 0 $var trail
sl@0: 
sl@0:     lappend trail $op
sl@0: 
sl@0:     switch -- $op {
sl@0: 	create/write	-	create/read	-
sl@0: 	delete/write	-	delete/read	-
sl@0: 	flush/read	-
sl@0: 	clear/read	{ #ignore }
sl@0: 	flush/write	-
sl@0: 	write		-
sl@0: 	read		{
sl@0: 	    return $data
sl@0: 	}
sl@0: 	query/maxRead	{
sl@0: 	    return -1
sl@0: 	}
sl@0: 	default		{
sl@0: 	    lappend trail "error $op"
sl@0: 	    error $op
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: 
sl@0: proc id_fulltrail {var op data} {
sl@0:     variable $var
sl@0:     upvar 0 $var trail
sl@0: 
sl@0:     #puts stdout ">> $var $op $data" ; flush stdout
sl@0: 
sl@0:     switch -- $op {
sl@0: 	create/write -	create/read  -
sl@0: 	delete/write -	delete/read  -
sl@0: 	clear_read   {
sl@0: 	    set res *ignored*
sl@0: 	}
sl@0: 	flush/write -	flush/read  -
sl@0: 	write       -
sl@0: 	read        {
sl@0: 	    set res $data
sl@0: 	}
sl@0: 	query/maxRead {
sl@0: 	    set res -1
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     #catch {puts stdout "\t>* $res" ; flush stdout}
sl@0:     #catch {puts stdout "x$res"} msg
sl@0: 
sl@0:     lappend trail [list $op $data $res]
sl@0:     return $res
sl@0: }
sl@0: 
sl@0: proc counter {var op data} {
sl@0:     variable $var
sl@0:     upvar 0 $var n
sl@0: 
sl@0:     switch -- $op {
sl@0: 	create/write -	create/read  -
sl@0: 	delete/write -	delete/read  -
sl@0: 	clear_read   {;#ignore}
sl@0: 	flush/write  -	flush/read   {return {}}
sl@0: 	write {
sl@0: 	    return $data
sl@0: 	}
sl@0: 	read  {
sl@0: 	    if {$n > 0} {
sl@0: 		incr n -[string length $data]
sl@0: 		if {$n < 0} {
sl@0: 		    set n 0
sl@0: 		}
sl@0: 	    }
sl@0: 	    return $data
sl@0: 	}
sl@0: 	query/maxRead {
sl@0: 	    return $n
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: 
sl@0: proc counter_audit {var vtrail op data} {
sl@0:     variable $var
sl@0:     variable $vtrail
sl@0:     upvar 0 $var n $vtrail trail
sl@0: 
sl@0:     switch -- $op {
sl@0: 	create/write -	create/read  -
sl@0: 	delete/write -	delete/read  -
sl@0: 	clear_read   {
sl@0: 	    set res {}
sl@0: 	}
sl@0: 	flush/write  -	flush/read   {
sl@0: 	    set res {}
sl@0: 	}
sl@0: 	write {
sl@0: 	    set res $data
sl@0: 	}
sl@0: 	read  {
sl@0: 	    if {$n > 0} {
sl@0: 		incr n -[string length $data]
sl@0: 		if {$n < 0} {
sl@0: 		    set n 0
sl@0: 		}
sl@0: 	    }
sl@0: 	    set res $data
sl@0: 	}
sl@0: 	query/maxRead {
sl@0: 	    set res $n
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     lappend trail [list counter:$op $data $res]
sl@0:     return $res
sl@0: }
sl@0: 
sl@0: 
sl@0: proc rblocks {var vtrail n op data} {
sl@0:     variable $var
sl@0:     variable $vtrail
sl@0:     upvar 0 $var buf $vtrail trail
sl@0: 
sl@0:     set res {}
sl@0: 
sl@0:     switch -- $op {
sl@0: 	create/write -	create/read  -
sl@0: 	delete/write -	delete/read  -
sl@0: 	clear_read   {
sl@0: 	    set buf {}
sl@0: 	}
sl@0: 	flush/write {
sl@0: 	}
sl@0: 	flush/read  {
sl@0: 	    set res $buf
sl@0: 	    set buf {}
sl@0: 	}
sl@0: 	write       {
sl@0: 	    set data
sl@0: 	}
sl@0: 	read        {
sl@0: 	    append buf $data
sl@0: 
sl@0: 	    set b [expr {$n * ([string length $buf] / $n)}]
sl@0: 
sl@0: 	    append op " $n [string length $buf] :- $b"
sl@0: 
sl@0: 	    set res [string range $buf 0 [incr b -1]]
sl@0: 	    set buf [string range $buf [incr b] end]
sl@0: 	    #return $res
sl@0: 	}
sl@0: 	query/maxRead {
sl@0: 	    set res -1
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     lappend trail [list rblock | $op $data $res | $buf]
sl@0:     return $res
sl@0: }
sl@0: 
sl@0: 
sl@0: # --------------------------------------------------------------
sl@0: # ... and convenience procedures to stack them
sl@0: 
sl@0: proc identity {-attach channel} {
sl@0:     testchannel transform $channel -command [namespace code id]
sl@0: }
sl@0: 
sl@0: proc audit_ops {var -attach channel} {
sl@0:     testchannel transform $channel -command [namespace code [list id_optrail $var]]
sl@0: }
sl@0: 
sl@0: proc audit_flow {var -attach channel} {
sl@0:     testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
sl@0: }
sl@0: 
sl@0: proc stopafter {var n -attach channel} {
sl@0:     variable $var
sl@0:     upvar 0 $var vn
sl@0:     set vn $n
sl@0:     testchannel transform $channel -command [namespace code [list counter $var]]
sl@0: }
sl@0: 
sl@0: proc stopafter_audit {var trail n -attach channel} {
sl@0:     variable $var
sl@0:     upvar 0 $var vn
sl@0:     set vn $n
sl@0:     testchannel transform $channel -command [namespace code [list counter_audit $var $trail]]
sl@0: }
sl@0: 
sl@0: proc rblocks_t {var trail n -attach channel} {
sl@0:     testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]]
sl@0: }
sl@0: 
sl@0: # --------------------------------------------------------------
sl@0: # serialize an array, with keys in sorted order.
sl@0: 
sl@0: proc array_sget {v} {
sl@0:     upvar $v a
sl@0: 
sl@0:     set res [list]
sl@0:     foreach n [lsort [array names a]] {
sl@0: 	lappend res $n $a($n)
sl@0:     }
sl@0:     set res
sl@0: }
sl@0: 
sl@0: proc asort {alist} {
sl@0:     # sort a list of key/value pairs by key, removes duplicates too.
sl@0: 
sl@0:     array set  a $alist
sl@0:     array_sget a
sl@0: }
sl@0: 
sl@0: ########################################################################
sl@0: 
sl@0: test iogt-1.1 {stack/unstack} testchannel {
sl@0:     set fh [open $path(dummy) r]
sl@0:     identity -attach $fh
sl@0:     testchannel unstack $fh
sl@0:     close   $fh
sl@0: } {}
sl@0: 
sl@0: test iogt-1.2 {stack/close} testchannel {
sl@0:     set fh [open $path(dummy) r]
sl@0:     identity -attach $fh
sl@0:     close   $fh
sl@0: } {}
sl@0: 
sl@0: test iogt-1.3 {stack/unstack, configuration, options} testchannel {
sl@0:     set fh [open $path(dummy) r]
sl@0:     set ca [asort [fconfigure $fh]]
sl@0:     identity -attach $fh
sl@0:     set cb [asort [fconfigure $fh]]
sl@0:     testchannel unstack $fh
sl@0:     set cc [asort [fconfigure $fh]]
sl@0:     close $fh
sl@0: 
sl@0:     # With this system none of the buffering, translation and
sl@0:     # encoding option may change their values with channels
sl@0:     # stacked upon each other or not.
sl@0: 
sl@0:     # cb == ca == cc
sl@0: 
sl@0:     list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
sl@0: } {1 1 1}
sl@0: 
sl@0: test iogt-1.4 {stack/unstack, configuration} testchannel {
sl@0:     set fh [open $path(dummy) r]
sl@0:     set ca [asort [fconfigure $fh]]
sl@0:     identity -attach $fh
sl@0:     fconfigure $fh \
sl@0: 	    -buffering   line \
sl@0: 	    -translation cr   \
sl@0: 	    -encoding    shiftjis
sl@0:     testchannel unstack $fh
sl@0:     set cc [asort [fconfigure $fh]]
sl@0: 
sl@0:     set res [list \
sl@0: 	    [string equal $ca $cc]   \
sl@0: 	    [fconfigure $fh -buffering]  \
sl@0: 	    [fconfigure $fh -translation] \
sl@0: 	    [fconfigure $fh -encoding]    \
sl@0: 	    ]
sl@0: 
sl@0:     close $fh
sl@0:     set res
sl@0: } {0 line cr shiftjis}
sl@0: 
sl@0: test iogt-2.0 {basic I/O going through transform} testchannel {
sl@0:     set fin  [open $path(dummy)    r]
sl@0:     set fout [open $path(dummyout) w]
sl@0: 
sl@0:     identity -attach $fin
sl@0:     identity -attach $fout
sl@0: 
sl@0:     fcopy $fin $fout
sl@0: 
sl@0:     close $fin
sl@0:     close $fout
sl@0: 
sl@0:     set fin  [open $path(dummy)    r]
sl@0:     set fout [open $path(dummyout) r]
sl@0: 
sl@0:     set res     [string equal [set in [read $fin]] [set out [read $fout]]]
sl@0:     lappend res [string length $in] [string length $out]
sl@0: 
sl@0:     close $fin
sl@0:     close $fout
sl@0: 
sl@0:     set res
sl@0: } {1 71 71}
sl@0: 
sl@0: 
sl@0: test iogt-2.1 {basic I/O, operation trail} {testchannel unixOnly} {
sl@0:     set fin  [open $path(dummy)    r]
sl@0:     set fout [open $path(dummyout) w]
sl@0: 
sl@0:     set ain [list] ; set aout [list]
sl@0:     audit_ops ain  -attach $fin
sl@0:     audit_ops aout -attach $fout
sl@0: 
sl@0:     fconfigure $fin  -buffersize 10
sl@0:     fconfigure $fout -buffersize 10
sl@0: 
sl@0:     fcopy $fin $fout
sl@0: 
sl@0:     close $fin
sl@0:     close $fout
sl@0: 
sl@0:     set res "[join $ain \n]\n--------\n[join $aout \n]"
sl@0: } {create/read
sl@0: query/maxRead
sl@0: read
sl@0: query/maxRead
sl@0: read
sl@0: query/maxRead
sl@0: read
sl@0: query/maxRead
sl@0: read
sl@0: query/maxRead
sl@0: read
sl@0: query/maxRead
sl@0: read
sl@0: query/maxRead
sl@0: read
sl@0: query/maxRead
sl@0: read
sl@0: query/maxRead
sl@0: flush/read
sl@0: delete/read
sl@0: --------
sl@0: create/write
sl@0: write
sl@0: write
sl@0: write
sl@0: write
sl@0: write
sl@0: write
sl@0: write
sl@0: write
sl@0: flush/write
sl@0: delete/write}
sl@0: 
sl@0: test iogt-2.2 {basic I/O, data trail} {testchannel unixOnly} {
sl@0:     set fin  [open $path(dummy)    r]
sl@0:     set fout [open $path(dummyout) w]
sl@0: 
sl@0:     set ain [list] ; set aout [list]
sl@0:     audit_flow ain  -attach $fin
sl@0:     audit_flow aout -attach $fout
sl@0: 
sl@0:     fconfigure $fin  -buffersize 10
sl@0:     fconfigure $fout -buffersize 10
sl@0: 
sl@0:     fcopy $fin $fout
sl@0: 
sl@0:     close $fin
sl@0:     close $fout
sl@0: 
sl@0:     set res "[join $ain \n]\n--------\n[join $aout \n]"
sl@0: } {create/read {} *ignored*
sl@0: query/maxRead {} -1
sl@0: read abcdefghij abcdefghij
sl@0: query/maxRead {} -1
sl@0: read klmnopqrst klmnopqrst
sl@0: query/maxRead {} -1
sl@0: read uvwxyz0123 uvwxyz0123
sl@0: query/maxRead {} -1
sl@0: read 456789,./? 456789,./?
sl@0: query/maxRead {} -1
sl@0: read {><;'\|":[]} {><;'\|":[]}
sl@0: query/maxRead {} -1
sl@0: read {\}\{`~!@#$} {\}\{`~!@#$}
sl@0: query/maxRead {} -1
sl@0: read %^&*()_+-= %^&*()_+-=
sl@0: query/maxRead {} -1
sl@0: read {
sl@0: } {
sl@0: }
sl@0: query/maxRead {} -1
sl@0: flush/read {} {}
sl@0: delete/read {} *ignored*
sl@0: --------
sl@0: create/write {} *ignored*
sl@0: write abcdefghij abcdefghij
sl@0: write klmnopqrst klmnopqrst
sl@0: write uvwxyz0123 uvwxyz0123
sl@0: write 456789,./? 456789,./?
sl@0: write {><;'\|":[]} {><;'\|":[]}
sl@0: write {\}\{`~!@#$} {\}\{`~!@#$}
sl@0: write %^&*()_+-= %^&*()_+-=
sl@0: write {
sl@0: } {
sl@0: }
sl@0: flush/write {} {}
sl@0: delete/write {} *ignored*}
sl@0: 
sl@0: 
sl@0: test iogt-2.3 {basic I/O, mixed trail} {testchannel unixOnly} {
sl@0:     set fin  [open $path(dummy)    r]
sl@0:     set fout [open $path(dummyout) w]
sl@0: 
sl@0:     set trail [list]
sl@0:     audit_flow trail -attach $fin
sl@0:     audit_flow trail -attach $fout
sl@0: 
sl@0:     fconfigure $fin  -buffersize 20
sl@0:     fconfigure $fout -buffersize 10
sl@0: 
sl@0:     fcopy $fin $fout
sl@0: 
sl@0:     close $fin
sl@0:     close $fout
sl@0: 
sl@0:     join $trail \n
sl@0: } {create/read {} *ignored*
sl@0: create/write {} *ignored*
sl@0: query/maxRead {} -1
sl@0: read abcdefghijklmnopqrst abcdefghijklmnopqrst
sl@0: write abcdefghij abcdefghij
sl@0: write klmnopqrst klmnopqrst
sl@0: query/maxRead {} -1
sl@0: read uvwxyz0123456789,./? uvwxyz0123456789,./?
sl@0: write uvwxyz0123 uvwxyz0123
sl@0: write 456789,./? 456789,./?
sl@0: query/maxRead {} -1
sl@0: read {><;'\|":[]\}\{`~!@#$} {><;'\|":[]\}\{`~!@#$}
sl@0: write {><;'\|":[]} {><;'\|":[]}
sl@0: write {\}\{`~!@#$} {\}\{`~!@#$}
sl@0: query/maxRead {} -1
sl@0: read {%^&*()_+-=
sl@0: } {%^&*()_+-=
sl@0: }
sl@0: query/maxRead {} -1
sl@0: flush/read {} {}
sl@0: write %^&*()_+-= %^&*()_+-=
sl@0: write {
sl@0: } {
sl@0: }
sl@0: delete/read {} *ignored*
sl@0: flush/write {} {}
sl@0: delete/write {} *ignored*}
sl@0: 
sl@0: 
sl@0: test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
sl@0: 	{testchannel unknownFailure} {
sl@0:     # This test to check the validity of aquired Tcl_Channel references is
sl@0:     # not possible because even a backgrounded fcopy will immediately start
sl@0:     # to copy data, without waiting for the event loop. This is done only in
sl@0:     # case of an underflow on the read size!. So stacking transforms after the
sl@0:     # fcopy will miss information, or are not used at all.
sl@0:     #
sl@0:     # I was able to circumvent this by using the echo.tcl server with a big
sl@0:     # delay, causing the fcopy to underflow immediately.
sl@0: 
sl@0:     proc DoneCopy {n {err {}}} {
sl@0: 	variable copy ; set copy 1
sl@0:     }
sl@0: 
sl@0:     set fin  [open $path(dummy) r]
sl@0: 
sl@0:     fevent 1000 500 {20 20 20 10 1 1} {
sl@0: 	close $fin
sl@0: 
sl@0: 	set          fout [open dummyout w]
sl@0: 
sl@0: 	flush $sock ; # now, or fcopy will error us out
sl@0: 	# But the 1 second delay should be enough to
sl@0: 	# initialize everything else here.
sl@0: 
sl@0: 	fcopy $sock $fout -command [namespace code DoneCopy]
sl@0: 
sl@0: 	# transform after fcopy got its handles !
sl@0: 	# They should be still valid for fcopy.
sl@0: 
sl@0: 	set trail [list]
sl@0: 	audit_ops trail -attach $fout
sl@0: 
sl@0: 	vwait [namespace which -variable copy]
sl@0:     } [read $fin] ; # {}
sl@0: 
sl@0:     close $fout
sl@0: 
sl@0:     rename DoneCopy {}
sl@0: 
sl@0:     # Check result of copy.
sl@0: 
sl@0:     set fin  [open $path(dummy)    r]
sl@0:     set fout [open $path(dummyout) r]
sl@0: 
sl@0:     set res [string equal [read $fin] [read $fout]]
sl@0: 
sl@0:     close $fin
sl@0:     close $fout
sl@0: 
sl@0:     list $res $trail
sl@0: } {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
sl@0: 
sl@0: 
sl@0: test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
sl@0:     set fin  [open $path(dummy) r]
sl@0:     set data [read $fin]
sl@0:     close $fin
sl@0: 
sl@0:     set trail [list]
sl@0:     set got   [list]
sl@0: 
sl@0:     proc Done {args} {
sl@0: 	variable stop
sl@0: 	set    stop 1
sl@0:     }
sl@0: 
sl@0:     proc Get {sock} {
sl@0: 	variable trail
sl@0: 	variable got
sl@0: 	if {[eof $sock]} {
sl@0: 	    Done
sl@0: 	    lappend trail "xxxxxxxxxxxxx"
sl@0: 	    close $sock
sl@0: 	    return
sl@0: 	}
sl@0: 	lappend trail "vvvvvvvvvvvvv"
sl@0: 	lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
sl@0: 	lappend trail "============="
sl@0: 	#puts stdout $__ ; flush stdout
sl@0: 	#read $sock
sl@0:     }
sl@0: 
sl@0:     fevent 1000 500 {20 20 20 10 1} {
sl@0: 	audit_flow trail   -attach $sock
sl@0: 	rblocks_t  rbuf trail 23 -attach $sock
sl@0: 
sl@0: 	fileevent $sock readable [list Get $sock]
sl@0: 
sl@0: 	flush $sock ; # now, or fcopy will error us out
sl@0: 	# But the 1 second delay should be enough to
sl@0: 	# initialize everything else here.
sl@0: 
sl@0: 	vwait [namespace which -variable stop]
sl@0:     } $data
sl@0: 
sl@0: 
sl@0:     rename Done {}
sl@0:     rename Get {}
sl@0: 
sl@0:     join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
sl@0: } {[[]]
sl@0: [[abcdefghijklmnopqrstuvw]]
sl@0: [[xyz0123456789,./?><;'\|]]
sl@0: [[]]
sl@0: [[]]
sl@0: [[":[]\}\{`~!@#$%^&*()]]
sl@0: [[]]
sl@0: ~~~~~~~~
sl@0: create/write {} *ignored*
sl@0: create/read {} *ignored*
sl@0: rblock | create/write {} {} | {}
sl@0: rblock | create/read {} {} | {}
sl@0: vvvvvvvvvvvvv
sl@0: rblock | query/maxRead {} -1 | {}
sl@0: query/maxRead {} -1
sl@0: read abcdefghijklmnopqrstu abcdefghijklmnopqrstu
sl@0: query/maxRead {} -1
sl@0: rblock | {read 23 21 :- 0} abcdefghijklmnopqrstu {} | abcdefghijklmnopqrstu
sl@0: rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
sl@0: query/maxRead {} -1
sl@0: 	got: {[[]]}
sl@0: =============
sl@0: vvvvvvvvvvvvv
sl@0: rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu
sl@0: query/maxRead {} -1
sl@0: read vwxyz0123456789,./?>< vwxyz0123456789,./?><
sl@0: query/maxRead {} -1
sl@0: rblock | {read 23 42 :- 23} vwxyz0123456789,./?>< abcdefghijklmnopqrstuvw | xyz0123456789,./?><
sl@0: rblock | query/maxRead {} -1 | xyz0123456789,./?><
sl@0: query/maxRead {} -1
sl@0: 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]}
sl@0: =============
sl@0: vvvvvvvvvvvvv
sl@0: rblock | query/maxRead {} -1 | xyz0123456789,./?><
sl@0: query/maxRead {} -1
sl@0: read {;'\|":[]\}\{`~!@#$%^&} {;'\|":[]\}\{`~!@#$%^&}
sl@0: query/maxRead {} -1
sl@0: rblock | {read 23 40 :- 23} {;'\|":[]\}\{`~!@#$%^&} {xyz0123456789,./?><;'\|} | {":[]\}\{`~!@#$%^&}
sl@0: rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
sl@0: query/maxRead {} -1
sl@0: 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]}
sl@0: =============
sl@0: vvvvvvvvvvvvv
sl@0: rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}
sl@0: query/maxRead {} -1
sl@0: read *( *(
sl@0: query/maxRead {} -1
sl@0: rblock | {read 23 19 :- 0} *( {} | {":[]\}\{`~!@#$%^&*(}
sl@0: rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
sl@0: query/maxRead {} -1
sl@0: 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]}
sl@0: =============
sl@0: vvvvvvvvvvvvv
sl@0: rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}
sl@0: query/maxRead {} -1
sl@0: read ) )
sl@0: query/maxRead {} -1
sl@0: rblock | {read 23 20 :- 0} ) {} | {":[]\}\{`~!@#$%^&*()}
sl@0: rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
sl@0: query/maxRead {} -1
sl@0: 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]}
sl@0: =============
sl@0: vvvvvvvvvvvvv
sl@0: rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}
sl@0: query/maxRead {} -1
sl@0: flush/read {} {}
sl@0: rblock | flush/read {} {":[]\}\{`~!@#$%^&*()} | {}
sl@0: rblock | query/maxRead {} -1 | {}
sl@0: query/maxRead {} -1
sl@0: 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]}
sl@0: =============
sl@0: vvvvvvvvvvvvv
sl@0: rblock | query/maxRead {} -1 | {}
sl@0: query/maxRead {} -1
sl@0: 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} {[[]]}
sl@0: xxxxxxxxxxxxx
sl@0: rblock | flush/write {} {} | {}
sl@0: rblock | delete/write {} {} | {}
sl@0: rblock | delete/read {} {} | {}
sl@0: flush/write {} {}
sl@0: delete/write {} *ignored*
sl@0: delete/read {} *ignored*}  ; # catch unescaped quote "
sl@0: 
sl@0: 
sl@0: test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
sl@0:     set fin  [open $path(dummy)    r]
sl@0:     set fout [open $path(dummyout) w]
sl@0: 
sl@0:     set trail [list]
sl@0: 
sl@0:     audit_flow trail -attach $fin
sl@0:     stopafter_audit d trail 20 -attach   $fin
sl@0:     audit_flow trail -attach $fout
sl@0: 
sl@0:     fconfigure $fin  -buffersize 20
sl@0:     fconfigure $fout -buffersize 10
sl@0: 
sl@0:     fcopy   $fin $fout
sl@0:     testchannel unstack $fin
sl@0: 
sl@0:     # now copy the rest in the channel
sl@0:     lappend trail {**after unstack**}
sl@0: 
sl@0:     fcopy $fin $fout
sl@0: 
sl@0:     close $fin
sl@0:     close $fout
sl@0: 
sl@0:     join $trail \n
sl@0: } {create/read {} *ignored*
sl@0: counter:create/read {} {}
sl@0: create/write {} *ignored*
sl@0: counter:query/maxRead {} 20
sl@0: query/maxRead {} -1
sl@0: read {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
sl@0: } {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
sl@0: }
sl@0: query/maxRead {} -1
sl@0: flush/read {} {}
sl@0: counter:read abcdefghijklmnopqrst abcdefghijklmnopqrst
sl@0: write abcdefghij abcdefghij
sl@0: write klmnopqrst klmnopqrst
sl@0: counter:query/maxRead {} 0
sl@0: counter:flush/read {} {}
sl@0: counter:delete/read {} {}
sl@0: **after unstack**
sl@0: query/maxRead {} -1
sl@0: write uvwxyz0123 uvwxyz0123
sl@0: write 456789,./? 456789,./?
sl@0: write {><;'\|":[]} {><;'\|":[]}
sl@0: write {\}\{`~!@#$} {\}\{`~!@#$}
sl@0: write %^&*()_+-= %^&*()_+-=
sl@0: write {
sl@0: } {
sl@0: }
sl@0: query/maxRead {} -1
sl@0: delete/read {} *ignored*
sl@0: flush/write {} {}
sl@0: delete/write {} *ignored*}
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: proc constX {op data} {
sl@0:     # replace anything coming in with a same-length string of x'es.
sl@0:     switch -- $op {
sl@0: 	create/write -	create/read  -
sl@0: 	delete/write -	delete/read  -
sl@0: 	clear_read   {;#ignore}
sl@0: 	flush/write -	flush/read  -
sl@0: 	write       -
sl@0: 	read        {
sl@0: 	    return [string repeat x [string length $data]]
sl@0: 	}
sl@0: 	query/maxRead {return -1}
sl@0:     }
sl@0: }
sl@0: 
sl@0: proc constx {-attach channel} {
sl@0:     testchannel transform $channel -command [namespace code constX]
sl@0: }
sl@0: 
sl@0: test iogt-6.0 {Push back} testchannel {
sl@0:     set f [open $path(dummy) r]
sl@0: 
sl@0:     # contents of dummy = "abcdefghi..."
sl@0:     read $f 3 ; # skip behind "abc"
sl@0: 
sl@0:     constx -attach $f
sl@0: 
sl@0:     # expect to get "xxx" from the transform because
sl@0:     # of unread "def" input to transform which returns "xxx".
sl@0:     #
sl@0:     # Actually the IO layer pre-read the whole file and will
sl@0:     # read "def" directly from the buffer without bothering
sl@0:     # to consult the newly stacked transformation. This is
sl@0:     # wrong.
sl@0: 
sl@0:     set res [read $f 3]
sl@0:     close $f
sl@0:     set res
sl@0: } {xxx}
sl@0: 
sl@0: test iogt-6.1 {Push back and up} {testchannel knownBug} {
sl@0:     set f [open $path(dummy) r]
sl@0: 
sl@0:     # contents of dummy = "abcdefghi..."
sl@0:     read $f 3 ; # skip behind "abc"
sl@0: 
sl@0:     constx -attach $f
sl@0:     set res [read $f 3]
sl@0: 
sl@0:     testchannel unstack $f
sl@0:     append res [read $f 3]
sl@0:     close $f
sl@0:     set res
sl@0: } {xxxghi}
sl@0: 
sl@0: 
sl@0: # cleanup
sl@0: foreach file [list dummy dummyout __echo_srv__.tcl] {
sl@0:     removeFile $file
sl@0: }
sl@0: cleanupTests
sl@0: }
sl@0: namespace delete ::tcl::test::iogt
sl@0: return