# -*- tcl -*-

 # Commands covered:  transform, and stacking in general

 #

 # This file contains a collection of tests for Giot

 #

 # See the file "license.terms" for information on usage and redistribution

 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 # 

 # Copyright (c) 2000 Ajuba Solutions.

 # Copyright (c) 2000 Andreas Kupries.

 # All rights reserved.

 # 

 # RCS: @(#) $Id: iogt.test,v 1.7.2.1 2005/04/14 07:10:57 davygrvy Exp $

 if {[catch {package require tcltest 2.1}]} {

     puts stderr "Skipping tests in [info script].  tcltest 2.1 required."

     return

 }

 namespace eval ::tcl::test::iogt {

     namespace import ::tcltest::cleanupTests

     namespace import ::tcltest::makeFile

     namespace import ::tcltest::removeFile

     namespace import ::tcltest::test

     namespace import ::tcltest::testConstraint

     testConstraint testchannel [llength [info commands testchannel]]

 set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=

 } dummy]

 # " capture coloring of quotes

 set path(dummyout) [makeFile {} dummyout]

 set path(__echo_srv__.tcl) [makeFile {

 #!/usr/local/bin/tclsh

 # -*- tcl -*-

 # echo server

 #

 # arguments, options: port to listen on for connections.

 #                     delay till echo of first block

 #                     delay between blocks

 #                     blocksize ...

 set port   [lindex $argv 0]

 set fdelay [lindex $argv 1]

 set idelay [lindex $argv 2]

 set bsizes [lrange $argv 3 end]

 set c      0

 proc newconn {sock rhost rport} {

     variable fdelay

     variable c

     incr   c

     variable c$c

     #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout

     upvar 0 c$c conn

     set conn(after) {}

     set conn(state) 0

     set conn(size)  0

     set conn(data)  ""

     set conn(delay) $fdelay

     fileevent  $sock readable [list echoGet $c $sock]

     fconfigure $sock -translation binary -buffering none -blocking 0

 }

 proc echoGet {c sock} {

     variable fdelay

     variable c$c

     upvar 0 c$c conn

     if {[eof $sock]} {

 	# one-shot echo

 	exit

     }

     append conn(data) [read $sock]

     #puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout

     if {$conn(after) == {}} {

 	set conn(after) [after $conn(delay) [list echoPut $c $sock]]

     }

 }

 proc echoPut {c sock} {

     variable idelay

     variable fdelay

     variable bsizes

     variable c$c

     upvar 0 c$c conn

     if {[string length $conn(data)] == 0} {

 	#puts stdout "C $c $sock" ; flush stdout

 	# auto terminate

 	close $sock

 	exit

 	#set conn(delay) $fdelay

 	return

     }

     set conn(delay) $idelay

     set n [lindex $bsizes $conn(size)]

     #puts stdout "P $c $sock $n >>" ; flush stdout

     #puts __________________________________________

     #parray conn

     #puts n=<$n>

     if {[string length $conn(data)] >= $n} {

 	puts -nonewline $sock [string range $conn(data) 0 $n]

 	set conn(data) [string range $conn(data) [incr n] end]

     }

     incr conn(size)

     if {$conn(size) >= [llength $bsizes]} {

 	set conn(size) [expr {[llength $bsizes]-1}]

     }

     set conn(after) [after $conn(delay) [list echoPut $c $sock]]

 }

 #fileevent stdin readable {exit ;#cut}

 # main

 socket -server newconn $port

 vwait forever

 } __echo_srv__.tcl]

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

 proc fevent {fdelay idelay blocks script data} {

     # start and initialize an echo server, prepare data

     # transmission, then hand over to the test script.

     # this has to start real transmission via 'flush'.

     # The server is stopped after completion of the test.

     # fixed port, not so good. lets hope for the best, for now.

     set port 4000

     eval exec tclsh __echo_srv__.tcl \

 	    $port $fdelay $idelay $blocks >@stdout &

     after 500

     #puts stdout "> $port" ; flush stdout

     set         sk [socket localhost $port]

     fconfigure $sk           \

 	    -blocking   0    \

 	    -buffering  full \

 	    -buffersize [expr {10+[llength $data]}]

     puts -nonewline $sk $data

     # The channel is prepared to go off.

     #puts stdout ">>>>>" ; flush stdout

     uplevel #0 set sock $sk

     set res [uplevel #0 $script]

     catch {close $sk}

     return $res

 }

 # --------------------------------------------------------------

 # utility transformations ...

 proc id {op data} {

     switch -- $op {

 	create/write -

 	create/read  -

 	delete/write -

 	delete/read  -

 	clear_read   {;#ignore}

 	flush/write -

 	flush/read  -

 	write       -

 	read        {

 	    return $data

 	}

 	query/maxRead {return -1}

     }

 }

 proc id_optrail {var op data} {

     variable $var

     upvar 0 $var trail

     lappend trail $op

     switch -- $op {

 	create/write	-	create/read	-

 	delete/write	-	delete/read	-

 	flush/read	-

 	clear/read	{ #ignore }

 	flush/write	-

 	write		-

 	read		{

 	    return $data

 	}

 	query/maxRead	{

 	    return -1

 	}

 	default		{

 	    lappend trail "error $op"

 	    error $op

 	}

     }

 }

 proc id_fulltrail {var op data} {

     variable $var

     upvar 0 $var trail

     #puts stdout ">> $var $op $data" ; flush stdout

     switch -- $op {

 	create/write -	create/read  -

 	delete/write -	delete/read  -

 	clear_read   {

 	    set res *ignored*

 	}

 	flush/write -	flush/read  -

 	write       -

 	read        {

 	    set res $data

 	}

 	query/maxRead {

 	    set res -1

 	}

     }

     #catch {puts stdout "\t>* $res" ; flush stdout}

     #catch {puts stdout "x$res"} msg

     lappend trail [list $op $data $res]

     return $res

 }

 proc counter {var op data} {

     variable $var

     upvar 0 $var n

     switch -- $op {

 	create/write -	create/read  -

 	delete/write -	delete/read  -

 	clear_read   {;#ignore}

 	flush/write  -	flush/read   {return {}}

 	write {

 	    return $data

 	}

 	read  {

 	    if {$n > 0} {

 		incr n -[string length $data]

 		if {$n < 0} {

 		    set n 0

 		}

 	    }

 	    return $data

 	}

 	query/maxRead {

 	    return $n

 	}

     }

 }

 proc counter_audit {var vtrail op data} {

     variable $var

     variable $vtrail

     upvar 0 $var n $vtrail trail

     switch -- $op {

 	create/write -	create/read  -

 	delete/write -	delete/read  -

 	clear_read   {

 	    set res {}

 	}

 	flush/write  -	flush/read   {

 	    set res {}

 	}

 	write {

 	    set res $data

 	}

 	read  {

 	    if {$n > 0} {

 		incr n -[string length $data]

 		if {$n < 0} {

 		    set n 0

 		}

 	    }

 	    set res $data

 	}

 	query/maxRead {

 	    set res $n

 	}

     }

     lappend trail [list counter:$op $data $res]

     return $res

 }

 proc rblocks {var vtrail n op data} {

     variable $var

     variable $vtrail

     upvar 0 $var buf $vtrail trail

     set res {}

     switch -- $op {

 	create/write -	create/read  -

 	delete/write -	delete/read  -

 	clear_read   {

 	    set buf {}

 	}

 	flush/write {

 	}

 	flush/read  {

 	    set res $buf

 	    set buf {}

 	}

 	write       {

 	    set data

 	}

 	read        {

 	    append buf $data

 	    set b [expr {$n * ([string length $buf] / $n)}]

 	    append op " $n [string length $buf] :- $b"

 	    set res [string range $buf 0 [incr b -1]]

 	    set buf [string range $buf [incr b] end]

 	    #return $res

 	}

 	query/maxRead {

 	    set res -1

 	}

     }

     lappend trail [list rblock | $op $data $res | $buf]

     return $res

 }

 # --------------------------------------------------------------

 # ... and convenience procedures to stack them

 proc identity {-attach channel} {

     testchannel transform $channel -command [namespace code id]

 }

 proc audit_ops {var -attach channel} {

     testchannel transform $channel -command [namespace code [list id_optrail $var]]

 }

 proc audit_flow {var -attach channel} {

     testchannel transform $channel -command [namespace code [list id_fulltrail $var]]

 }

 proc stopafter {var n -attach channel} {

     variable $var

     upvar 0 $var vn

     set vn $n

     testchannel transform $channel -command [namespace code [list counter $var]]

 }

 proc stopafter_audit {var trail n -attach channel} {

     variable $var

     upvar 0 $var vn

     set vn $n

     testchannel transform $channel -command [namespace code [list counter_audit $var $trail]]

 }

 proc rblocks_t {var trail n -attach channel} {

     testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]]

 }

 # --------------------------------------------------------------

 # serialize an array, with keys in sorted order.

 proc array_sget {v} {

     upvar $v a

     set res [list]

     foreach n [lsort [array names a]] {

 	lappend res $n $a($n)

     }

     set res

 }

 proc asort {alist} {

     # sort a list of key/value pairs by key, removes duplicates too.

     array set  a $alist

     array_sget a

 }

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

 test iogt-1.1 {stack/unstack} testchannel {

     set fh [open $path(dummy) r]

     identity -attach $fh

     testchannel unstack $fh

     close   $fh

 } {}

 test iogt-1.2 {stack/close} testchannel {

     set fh [open $path(dummy) r]

     identity -attach $fh

     close   $fh

 } {}

 test iogt-1.3 {stack/unstack, configuration, options} testchannel {

     set fh [open $path(dummy) r]

     set ca [asort [fconfigure $fh]]

     identity -attach $fh

     set cb [asort [fconfigure $fh]]

     testchannel unstack $fh

     set cc [asort [fconfigure $fh]]

     close $fh

     # With this system none of the buffering, translation and

     # encoding option may change their values with channels

     # stacked upon each other or not.

     # cb == ca == cc

     list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]

 } {1 1 1}

 test iogt-1.4 {stack/unstack, configuration} testchannel {

     set fh [open $path(dummy) r]

     set ca [asort [fconfigure $fh]]

     identity -attach $fh

     fconfigure $fh \

 	    -buffering   line \

 	    -translation cr   \

 	    -encoding    shiftjis

     testchannel unstack $fh

     set cc [asort [fconfigure $fh]]

     set res [list \

 	    [string equal $ca $cc]   \

 	    [fconfigure $fh -buffering]  \

 	    [fconfigure $fh -translation] \

 	    [fconfigure $fh -encoding]    \

 	    ]

     close $fh

     set res

 } {0 line cr shiftjis}

 test iogt-2.0 {basic I/O going through transform} testchannel {

     set fin  [open $path(dummy)    r]

     set fout [open $path(dummyout) w]

     identity -attach $fin

     identity -attach $fout

     fcopy $fin $fout

     close $fin

     close $fout

     set fin  [open $path(dummy)    r]

     set fout [open $path(dummyout) r]

     set res     [string equal [set in [read $fin]] [set out [read $fout]]]

     lappend res [string length $in] [string length $out]

     close $fin

     close $fout

     set res

 } {1 71 71}

 test iogt-2.1 {basic I/O, operation trail} {testchannel unixOnly} {

     set fin  [open $path(dummy)    r]

     set fout [open $path(dummyout) w]

     set ain [list] ; set aout [list]

     audit_ops ain  -attach $fin

     audit_ops aout -attach $fout

     fconfigure $fin  -buffersize 10

     fconfigure $fout -buffersize 10

     fcopy $fin $fout

     close $fin

     close $fout

     set res "[join $ain \n]\n--------\n[join $aout \n]"

 } {create/read

 query/maxRead

 read

 query/maxRead

 read

 query/maxRead

 read

 query/maxRead

 read

 query/maxRead

 read

 query/maxRead

 read

 query/maxRead

 read

 query/maxRead

 read

 query/maxRead

 flush/read

 delete/read

 --------

 create/write

 write

 write

 write

 write

 write

 write

 write

 write

 flush/write

 delete/write}

 test iogt-2.2 {basic I/O, data trail} {testchannel unixOnly} {

     set fin  [open $path(dummy)    r]

     set fout [open $path(dummyout) w]

     set ain [list] ; set aout [list]

     audit_flow ain  -attach $fin

     audit_flow aout -attach $fout

     fconfigure $fin  -buffersize 10

     fconfigure $fout -buffersize 10

     fcopy $fin $fout

     close $fin

     close $fout

     set res "[join $ain \n]\n--------\n[join $aout \n]"

 } {create/read {} *ignored*

 query/maxRead {} -1

 read abcdefghij abcdefghij

 query/maxRead {} -1

 read klmnopqrst klmnopqrst

 query/maxRead {} -1

 read uvwxyz0123 uvwxyz0123

 query/maxRead {} -1

 read 456789,./? 456789,./?

 query/maxRead {} -1

 read {><;'\|":[]} {><;'\|":[]}

 query/maxRead {} -1

 read {\}\{`~!@#$} {\}\{`~!@#$}

 query/maxRead {} -1

 read %^&*()_+-= %^&*()_+-=

 query/maxRead {} -1

 read {

 } {

 }

 query/maxRead {} -1

 flush/read {} {}

 delete/read {} *ignored*

 --------

 create/write {} *ignored*

 write abcdefghij abcdefghij

 write klmnopqrst klmnopqrst

 write uvwxyz0123 uvwxyz0123

 write 456789,./? 456789,./?

 write {><;'\|":[]} {><;'\|":[]}

 write {\}\{`~!@#$} {\}\{`~!@#$}

 write %^&*()_+-= %^&*()_+-=

 write {

 } {

 }

 flush/write {} {}

 delete/write {} *ignored*}

 test iogt-2.3 {basic I/O, mixed trail} {testchannel unixOnly} {

     set fin  [open $path(dummy)    r]

     set fout [open $path(dummyout) w]

     set trail [list]

     audit_flow trail -attach $fin

     audit_flow trail -attach $fout

     fconfigure $fin  -buffersize 20

     fconfigure $fout -buffersize 10

     fcopy $fin $fout

     close $fin

     close $fout

     join $trail \n

 } {create/read {} *ignored*

 create/write {} *ignored*

 query/maxRead {} -1

 read abcdefghijklmnopqrst abcdefghijklmnopqrst

 write abcdefghij abcdefghij

 write klmnopqrst klmnopqrst

 query/maxRead {} -1

 read uvwxyz0123456789,./? uvwxyz0123456789,./?

 write uvwxyz0123 uvwxyz0123

 write 456789,./? 456789,./?

 query/maxRead {} -1

 read {><;'\|":[]\}\{`~!@#$} {><;'\|":[]\}\{`~!@#$}

 write {><;'\|":[]} {><;'\|":[]}

 write {\}\{`~!@#$} {\}\{`~!@#$}

 query/maxRead {} -1

 read {%^&*()_+-=

 } {%^&*()_+-=

 }

 query/maxRead {} -1

 flush/read {} {}

 write %^&*()_+-= %^&*()_+-=

 write {

 } {

 }

 delete/read {} *ignored*

 flush/write {} {}

 delete/write {} *ignored*}

 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \

 	{testchannel unknownFailure} {

     # This test to check the validity of aquired Tcl_Channel references is

     # not possible because even a backgrounded fcopy will immediately start

     # to copy data, without waiting for the event loop. This is done only in

     # case of an underflow on the read size!. So stacking transforms after the

     # fcopy will miss information, or are not used at all.

     #

     # I was able to circumvent this by using the echo.tcl server with a big

     # delay, causing the fcopy to underflow immediately.

     proc DoneCopy {n {err {}}} {

 	variable copy ; set copy 1

     }

     set fin  [open $path(dummy) r]

     fevent 1000 500 {20 20 20 10 1 1} {

 	close $fin

 	set          fout [open dummyout w]

 	flush $sock ; # now, or fcopy will error us out

 	# But the 1 second delay should be enough to

 	# initialize everything else here.

 	fcopy $sock $fout -command [namespace code DoneCopy]

 	# transform after fcopy got its handles !

 	# They should be still valid for fcopy.

 	set trail [list]

 	audit_ops trail -attach $fout

 	vwait [namespace which -variable copy]

     } [read $fin] ; # {}

     close $fout

     rename DoneCopy {}

     # Check result of copy.

     set fin  [open $path(dummy)    r]

     set fout [open $path(dummyout) r]

     set res [string equal [read $fin] [read $fout]]

     close $fin

     close $fout

     list $res $trail

 } {1 {create/write create/read write flush/write flush/read delete/write delete/read}}

 test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {

     set fin  [open $path(dummy) r]

     set data [read $fin]

     close $fin

     set trail [list]

     set got   [list]

     proc Done {args} {

 	variable stop

 	set    stop 1

     }

     proc Get {sock} {

 	variable trail

 	variable got

 	if {[eof $sock]} {

 	    Done

 	    lappend trail "xxxxxxxxxxxxx"

 	    close $sock

 	    return

 	}

 	lappend trail "vvvvvvvvvvvvv"

 	lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"

 	lappend trail "============="

 	#puts stdout $__ ; flush stdout

 	#read $sock

     }

     fevent 1000 500 {20 20 20 10 1} {

 	audit_flow trail   -attach $sock

 	rblocks_t  rbuf trail 23 -attach $sock

 	fileevent $sock readable [list Get $sock]

 	flush $sock ; # now, or fcopy will error us out

 	# But the 1 second delay should be enough to

 	# initialize everything else here.

 	vwait [namespace which -variable stop]

     } $data

     rename Done {}

     rename Get {}

     join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n

 } {[[]]

 [[abcdefghijklmnopqrstuvw]]

 [[xyz0123456789,./?><;'\|]]

 [[]]

 [[]]

 [[":[]\}\{`~!@#$%^&*()]]

 [[]]

 ~~~~~~~~

 create/write {} *ignored*

 create/read {} *ignored*

 rblock | create/write {} {} | {}

 rblock | create/read {} {} | {}

 vvvvvvvvvvvvv

 rblock | query/maxRead {} -1 | {}

 query/maxRead {} -1

 read abcdefghijklmnopqrstu abcdefghijklmnopqrstu

 query/maxRead {} -1

 rblock | {read 23 21 :- 0} abcdefghijklmnopqrstu {} | abcdefghijklmnopqrstu

 rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu

 query/maxRead {} -1

 	got: {[[]]}

 =============

 vvvvvvvvvvvvv

 rblock | query/maxRead {} -1 | abcdefghijklmnopqrstu

 query/maxRead {} -1

 read vwxyz0123456789,./?>< vwxyz0123456789,./?><

 query/maxRead {} -1

 rblock | {read 23 42 :- 23} vwxyz0123456789,./?>< abcdefghijklmnopqrstuvw | xyz0123456789,./?><

 rblock | query/maxRead {} -1 | xyz0123456789,./?><

 query/maxRead {} -1

 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]}

 =============

 vvvvvvvvvvvvv

 rblock | query/maxRead {} -1 | xyz0123456789,./?><

 query/maxRead {} -1

 read {;'\|":[]\}\{`~!@#$%^&} {;'\|":[]\}\{`~!@#$%^&}

 query/maxRead {} -1

 rblock | {read 23 40 :- 23} {;'\|":[]\}\{`~!@#$%^&} {xyz0123456789,./?><;'\|} | {":[]\}\{`~!@#$%^&}

 rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}

 query/maxRead {} -1

 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]}

 =============

 vvvvvvvvvvvvv

 rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&}

 query/maxRead {} -1

 read *( *(

 query/maxRead {} -1

 rblock | {read 23 19 :- 0} *( {} | {":[]\}\{`~!@#$%^&*(}

 rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}

 query/maxRead {} -1

 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]}

 =============

 vvvvvvvvvvvvv

 rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*(}

 query/maxRead {} -1

 read ) )

 query/maxRead {} -1

 rblock | {read 23 20 :- 0} ) {} | {":[]\}\{`~!@#$%^&*()}

 rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}

 query/maxRead {} -1

 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]}

 =============

 vvvvvvvvvvvvv

 rblock | query/maxRead {} -1 | {":[]\}\{`~!@#$%^&*()}

 query/maxRead {} -1

 flush/read {} {}

 rblock | flush/read {} {":[]\}\{`~!@#$%^&*()} | {}

 rblock | query/maxRead {} -1 | {}

 query/maxRead {} -1

 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]}

 =============

 vvvvvvvvvvvvv

 rblock | query/maxRead {} -1 | {}

 query/maxRead {} -1

 	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} {[[]]}

 xxxxxxxxxxxxx

 rblock | flush/write {} {} | {}

 rblock | delete/write {} {} | {}

 rblock | delete/read {} {} | {}

 flush/write {} {}

 delete/write {} *ignored*

 delete/read {} *ignored*}  ; # catch unescaped quote "

 test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {

     set fin  [open $path(dummy)    r]

     set fout [open $path(dummyout) w]

     set trail [list]

     audit_flow trail -attach $fin

     stopafter_audit d trail 20 -attach   $fin

     audit_flow trail -attach $fout

     fconfigure $fin  -buffersize 20

     fconfigure $fout -buffersize 10

     fcopy   $fin $fout

     testchannel unstack $fin

     # now copy the rest in the channel

     lappend trail {**after unstack**}

     fcopy $fin $fout

     close $fin

     close $fout

     join $trail \n

 } {create/read {} *ignored*

 counter:create/read {} {}

 create/write {} *ignored*

 counter:query/maxRead {} 20

 query/maxRead {} -1

 read {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=

 } {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=

 }

 query/maxRead {} -1

 flush/read {} {}

 counter:read abcdefghijklmnopqrst abcdefghijklmnopqrst

 write abcdefghij abcdefghij

 write klmnopqrst klmnopqrst

 counter:query/maxRead {} 0

 counter:flush/read {} {}

 counter:delete/read {} {}

 **after unstack**

 query/maxRead {} -1

 write uvwxyz0123 uvwxyz0123

 write 456789,./? 456789,./?

 write {><;'\|":[]} {><;'\|":[]}

 write {\}\{`~!@#$} {\}\{`~!@#$}

 write %^&*()_+-= %^&*()_+-=

 write {

 } {

 }

 query/maxRead {} -1

 delete/read {} *ignored*

 flush/write {} {}

 delete/write {} *ignored*}

 proc constX {op data} {

     # replace anything coming in with a same-length string of x'es.

     switch -- $op {

 	create/write -	create/read  -

 	delete/write -	delete/read  -

 	clear_read   {;#ignore}

 	flush/write -	flush/read  -

 	write       -

 	read        {

 	    return [string repeat x [string length $data]]

 	}

 	query/maxRead {return -1}

     }

 }

 proc constx {-attach channel} {

     testchannel transform $channel -command [namespace code constX]

 }

 test iogt-6.0 {Push back} testchannel {

     set f [open $path(dummy) r]

     # contents of dummy = "abcdefghi..."

     read $f 3 ; # skip behind "abc"

     constx -attach $f

     # expect to get "xxx" from the transform because

     # of unread "def" input to transform which returns "xxx".

     #

     # Actually the IO layer pre-read the whole file and will

     # read "def" directly from the buffer without bothering

     # to consult the newly stacked transformation. This is

     # wrong.

     set res [read $f 3]

     close $f

     set res

 } {xxx}

 test iogt-6.1 {Push back and up} {testchannel knownBug} {

     set f [open $path(dummy) r]

     # contents of dummy = "abcdefghi..."

     read $f 3 ; # skip behind "abc"

     constx -attach $f

     set res [read $f 3]

     testchannel unstack $f

     append res [read $f 3]

     close $f

     set res

 } {xxxghi}

 # cleanup

 foreach file [list dummy dummyout __echo_srv__.tcl] {

     removeFile $file

 }

 cleanupTests

 }

 namespace delete ::tcl::test::iogt

 return