* merged core-8-3-1-io-rewrite back into core-8-3-1-branch.

	The core-8-3-1-io-rewrite branch should now be considered defunct.


FossilOrigin-Name: 4a5dd63d1f5efaf30ac7fb5f31fafb9893f69100

3 files changed, 965 insertions, 40 deletions

diff --git a/tests/all.tcl b/tests/all.tcl
index df5cb3d..da89ff2 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -4,10 +4,10 @@
 # tests.  Execute it by invoking "source all.test" when running tcltest
 # in this directory.
 #
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
 # All rights reserved.
 # 
-# RCS: @(#) $Id: all.tcl,v 1.10 2000/04/10 17:18:56 ericm Exp $
+# RCS: @(#) $Id: all.tcl,v 1.10.2.1 2000/07/27 01:39:20 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
diff --git a/tests/iogt.test b/tests/iogt.test
new file mode 100644
index 0000000..293fd00
--- /dev/null
+++ b/tests/iogt.test
@@ -0,0 +1,940 @@
+# -*- 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.1.4.1 2000/07/27 01:39:20 hobbs Exp $
+
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+if {[info commands testchannel] == ""} {
+    puts "Skipping io tests. This application does not seem to have the"
+    puts "testchannel command that is needed to run these tests."
+    return
+}
+
+::tcltest::saveState
+
+#::tcltest::makeFile contents name
+
+::tcltest::makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=} dummy
+
+# " capture coloring of quotes
+
+::tcltest::makeFile {} dummyout
+
+::tcltest::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} {
+    global c fdelay
+    incr   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} {
+    global fdelay
+    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} {
+    global idelay fdelay bsizes
+    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} {
+    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} {
+    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} {
+    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} {
+    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} {
+    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 id
+}
+
+proc audit_ops {var -attach channel} {
+    testchannel transform $channel -command [list id_optrail $var]
+}
+
+proc audit_flow {var -attach channel} {
+    testchannel transform $channel -command [list id_fulltrail $var]
+}
+
+proc stopafter {var n -attach channel} {
+    upvar #0 $var vn
+    set vn $n
+    testchannel transform $channel -command [list counter $var]
+}
+
+proc stopafter_audit {var trail n -attach channel} {
+    upvar #0 $var vn
+    set vn $n
+    testchannel transform $channel -command [list counter_audit $var $trail]
+}
+
+proc rblocks_t {var trail n -attach channel} {
+    testchannel transform $channel -command [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} {
+    set fh [open dummy r]
+    identity -attach $fh
+    testchannel unstack $fh
+    close   $fh
+} {}
+
+test iogt-1.2 {stack/close} {
+    set fh [open dummy r]
+    identity -attach $fh
+    close   $fh
+} {}
+
+test iogt-1.3 {stack/unstack, configuration, options} {
+    set fh [open 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} {
+    set fh [open 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} {
+    set fin  [open dummy    r]
+    set fout [open dummyout w]
+
+    identity -attach $fin
+    identity -attach $fout
+
+    fcopy $fin $fout
+
+    close $fin
+    close $fout
+
+    set fin  [open dummy    r]
+    set fout [open 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} {unixOnly} {
+    set fin  [open dummy    r]
+    set fout [open 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 5
+
+    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
+query/maxRead
+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} {unixOnly} {
+    set fin  [open dummy    r]
+    set fout [open 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 5
+
+    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 {} {}
+query/maxRead {} -1
+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} {unixOnly} {
+    set fin  [open dummy    r]
+    set fout [open 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 {
+} {
+}
+query/maxRead {} -1
+delete/read {} *ignored*
+flush/write {} {}
+delete/write {} *ignored*}
+
+
+test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
+	{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 {}}} {
+	global copy ; set copy 1
+    }
+
+    set fin  [open 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 DoneCopy
+
+	# transform after fcopy got its handles !
+	# They should be still valid for fcopy.
+
+	set trail [list]
+	audit_ops trail -attach $fout
+
+	vwait copy
+    } [read $fin] ; # {}
+
+    close $fout
+
+    rename DoneCopy {}
+
+    # Check result of copy.
+
+    set fin  [open dummy    r]
+    set fout [open 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} {unknownFailure} {
+    set fin  [open dummy    r]
+    set data [read $fin]
+    close $fin
+
+    set trail [list]
+    set got   [list]
+
+    proc Done {args} {
+	global stop
+	set    stop 1
+    }
+
+    proc Get {sock} {
+	global trail 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 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} {unknownFailure} {
+    set fin  [open dummy    r]
+    set fout [open 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 constX
+}
+
+test iogt-6.0 {Push back} {
+    set f [open 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} {knownBug} {
+    set f [open 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] {
+    ::tcltest::removeFile $file
+}
+::tcltest::restoreState
+::tcltest::cleanupTests
+return
diff --git a/tests/socket.test b/tests/socket.test
index ba25211..f55ecc9 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -5,12 +5,12 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: socket.test,v 1.14 2000/04/10 17:19:04 ericm Exp $
+# RCS: @(#) $Id: socket.test,v 1.14.2.1 2000/07/27 01:39:21 hobbs Exp $
 
 # Running socket tests with a remote server:
 # ------------------------------------------
@@ -67,10 +67,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import -force ::tcltest::*
 }
 
-# Some tests require the testthread command
+# Some tests require the testthread and exec commands
 
 set ::tcltest::testConstraints(testthread) \
 	[expr {[info commands testthread] != {}}]
+set ::tcltest::testConstraints(exec) [expr {[info commands exec] != {}}]
 
 #
 # If remoteServerIP or remoteServerPort are not set, check in the
@@ -551,19 +552,19 @@ test socket-2.11 {detecting new data} {socket} {
     flush $s2
     after 500
     fconfigure $sock -blocking 0
-    set result [gets $sock]
-    lappend result [gets $sock]
+    set result a:[gets $sock]
+    lappend result b:[gets $sock]
     fconfigure $sock -blocking 1
     puts $s2 two
     flush $s2
     fconfigure $sock -blocking 0
-    lappend result [gets $sock]
+    lappend result c:[gets $sock]
     fconfigure $sock -blocking 1
     close $s2
     close $s
     close $sock
     set result
-} {one {} two}
+} {a:one b: c:two}
 
 
 test socket-3.1 {socket conflict} {socket stdio} {
@@ -1276,6 +1277,7 @@ test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
     sendCommand {close $socket10_13_test_server}
     list $spurious $len
 } {0 2690}
+
 test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
     set counter 0
     set done 0
@@ -1303,12 +1305,13 @@ test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
 	}
     }
     set c [socket $remoteServerIP 2836]
-    fileevent $c readable "count_up $c"
+    fileevent $c readable [list count_up $c]
     set after_id [after 1000 timed_out]
     vwait done
     sendCommand {close $socket10_14_test_server}
     set done
 } {EOF is sticky}
+
 test socket-11.13 {testing async write, async flush, async close} \
 	{socket doTestsWithRemoteServer} {
     proc readit {s} {
@@ -1363,8 +1366,7 @@ test socket-11.13 {testing async write, async flush, async close} \
     set count
 } 65566
 
-test socket-12.1 {testing inheritance of server sockets} \
-	{socket doTestsWithRemoteServer} {
+test socket-12.1 {testing inheritance of server sockets} {socket exec} {
     removeFile script1
     removeFile script2
 
@@ -1383,14 +1385,13 @@ test socket-12.1 {testing inheritance of server sockets} \
     # be closed unless script1 inherited it.
 
     set f [open script2 w]
-    puts $f [list set tcltest $::tcltest::tcltest]
+    puts $f [list set tclsh $::tcltest::tcltest]
     puts $f {
-	package require tcltest
 	set f [socket -server accept 2828]
 	proc accept { file addr port } {
 	    close $file
 	}
-	exec $::tcltest::tcltest script1 &
+	exec $tclsh script1 &
 	close $f
 	after 1000 exit
 	vwait forever
@@ -1416,8 +1417,7 @@ test socket-12.1 {testing inheritance of server sockets} \
     removeFile script2
     set x
 } {server socket was not inherited}
-test socket-12.2 {testing inheritance of client sockets} \
-	{socket doTestsWithRemoteServer} {
+test socket-12.2 {testing inheritance of client sockets} {socket exec} {
     removeFile script1
     removeFile script2
 
@@ -1436,10 +1436,10 @@ test socket-12.2 {testing inheritance of client sockets} \
     # client socket, the socket will still be open.
 
     set f [open script2 w]
-    puts $f [list set tcltest $::tcltest::tcltest]
+    puts $f [list set tclsh $::tcltest::tcltest]
     puts $f {
 	set f [socket 127.0.0.1 2829]
-	exec $::tcltest::tcltest script1 &
+	exec $tclsh script1 &
 	puts $f testing
 	flush $f
 	after 1000 exit
@@ -1451,7 +1451,6 @@ test socket-12.2 {testing inheritance of client sockets} \
 
     set server [socket -server accept 2829]
     proc accept { file host port } {
-
 	# When the client connects, establish the read handler
 	global server
 	close $server
@@ -1460,7 +1459,6 @@ test socket-12.2 {testing inheritance of client sockets} \
 	return
     }
     proc getdata { file } {
-
 	# Read handler on the accepted socket.
 	global x
 	global failed
@@ -1502,8 +1500,7 @@ test socket-12.2 {testing inheritance of client sockets} \
     removeFile script2
     set x
 } {client socket was not inherited}
-test socket-12.3 {testing inheritance of accepted sockets} \
-	{socket doTestsWithRemoteServer} {
+test socket-12.3 {testing inheritance of accepted sockets} {socket exec} {
     removeFile script1
     removeFile script2
 
@@ -1515,13 +1512,13 @@ test socket-12.3 {testing inheritance of accepted sockets} \
     close $f
 
     set f [open script2 w]
-    puts $f [list set tcltest $::tcltest::tcltest]
+    puts $f [list set tclsh $::tcltest::tcltest]
     puts $f {
-	set server [socket -server accept 2930]
+	set server [socket -server accept 2931]
 	proc accept { file host port } {
-	    global tcltest
+	    global tclsh
 	    puts $file {test data on socket}
-	    exec $::tcltest::tcltest script1 &
+	    exec $tclsh script1 &
 	    after 1000 exit
 	}
 	vwait forever
@@ -1536,7 +1533,7 @@ test socket-12.3 {testing inheritance of accepted sockets} \
     after 1000 set ok_to_proceed 1
     vwait ok_to_proceed
 
-    set f [socket 127.0.0.1 2930]
+    set f [socket 127.0.0.1 2931]
     fconfigure $f -buffering full -blocking 0
     fileevent $f readable [list getdata $f]
 
@@ -1547,7 +1544,6 @@ test socket-12.3 {testing inheritance of accepted sockets} \
     after 5000 set failed 1
 
     proc getdata { file } {
-
 	# Read handler on the client socket.
 	global x
 	global failed
@@ -1642,14 +1638,3 @@ catch {close $remoteProcChan}
 ::tcltest::cleanupTests
 flush stdout
 return
-
-
-
-
-
-
-
-
-
-
-