# -*- tcl -*-
# Functionality covered: operation of the reflected transformation
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2007 Andreas Kupries <andreask@activestate.com>
#                                    <akupries@shaw.ca>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Custom constraints used in this file
testConstraint testchannel [llength [info commands testchannel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]

# testchannel cut|splice  Both needed to test the reflection in threads.
# thread::send

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

# ### ### ### ######### ######### #########
## Testing the reflected transformation.

# Helper commands to record the arguments to handler methods.  Stored in a
# script so that the tests needing this code do not need their own copy but
# can access this variable.

set helperscript {
    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }

    # This forces the return options to be in the order that the test expects!
    variable optorder {
	-code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
	-errorstack !?!
    }
    proc noteOpts opts {
	variable optorder
	lappend ::res [dict merge $optorder $opts]
    }

    # Helper command, canned result for 'initialize' method.  Gets the
    # optional methods as arguments. Use return features to post the result
    # higher up.

    proc handle.initialize {args} {
	upvar args hargs
	if {[lindex $hargs 0] eq "initialize"} {
	    return -code return [list {*}$args initialize finalize read write]
	}
    }
    proc handle.finalize {} {
	upvar args hargs
	if {[lindex $hargs 0] eq "finalize"} {
	    return -code return ""
	}
    }
    proc handle.read {} {
	upvar args hargs
	if {[lindex $hargs 0] eq "read"} {
	    return -code return "@"
	}
    }
    proc handle.drain {} {
	upvar args hargs
	if {[lindex $hargs 0] eq "drain"} {
	    return -code return "<>"
	}
    }
    proc handle.clear {} {
	upvar args hargs
	if {[lindex $hargs 0] eq "clear"} {
	    return -code return ""
	}
    }

    proc tempchan {{mode r+}} {
	global tempchan
	return [set tempchan [open [makeFile {test data} tempchanfile] $mode]]
    }
    proc tempdone {} {
	global tempchan
	catch {close $tempchan}
	removeFile tempchanfile
	return
    }
    proc tempview {} { viewFile tempchanfile }
}

# Set everything up in the main thread.
eval $helperscript

#puts <<[file channels]>>

# ### ### ### ######### ######### #########

test iortrans-1.0 {chan, wrong#args} -returnCodes error -body {
    chan
} -result {wrong # args: should be "chan subcommand ?arg ...?"}
test iortrans-1.1 {chan, unknown method} -returnCodes error -body {
    chan foo
} -match glob -result {unknown or ambiguous subcommand "foo": must be*}

# --- --- --- --------- --------- ---------
# chan push, and method "initialize"

test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body {
    chan push
} -result {wrong # args: should be "chan push channel cmdprefix"}
test iortrans-2.1 {chan push, wrong#args, too many} -returnCodes error -body {
    chan push a b c
} -result {wrong # args: should be "chan push channel cmdprefix"}
test iortrans-2.2 {chan push, invalid channel} -setup {
    proc foo {} {}
} -returnCodes error -body {
    chan push {} foo
} -cleanup {
    rename foo {}
} -result {can not find channel named ""}
test iortrans-2.3 {chan push, bad handler, not a list} -body {
    chan push [tempchan] "foo \{"
} -returnCodes error -cleanup {
    tempdone
} -result {unmatched open brace in list}
test iortrans-2.4 {chan push, bad handler, not a command} -body {
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
} -result {invalid command name "foo"}
test iortrans-2.5 {chan push, initialize failed, bad signature} -body {
    proc foo {} {}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -result {wrong # args: should be "foo"}
test iortrans-2.6 {chan push, initialize failed, bad signature} -body {
    proc foo {} {}
    chan push [tempchan] ::foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -result {wrong # args: should be "::foo"}
test iortrans-2.7 {chan push, initialize failed, bad result, not a list} -body {
    proc foo {args} {return "\{"}
    catch {chan push [tempchan] foo}
    return $::errorInfo
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {chan handler "foo initialize" returned non-list: *}
test iortrans-2.8 {chan push, initialize failed, bad result, not a list} -body {
    proc foo {args} {return \{\{\}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {chan handler "foo initialize" returned non-list: *}
test iortrans-2.9 {chan push, initialize failed, bad result, empty list} -body {
    proc foo {args} {}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*all required methods*}
test iortrans-2.10 {chan push, initialize failed, bad result, bogus method name} -body {
    proc foo {args} {return 1}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*bad method "1": must be *}
test iortrans-2.11 {chan push, initialize failed, bad result, bogus method name} -body {
    proc foo {args} {return {a b c}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*bad method "c": must be *}
test iortrans-2.12 {chan push, initialize failed, bad result, required methods missing} -body {
    # Required: initialize, and finalize.
    proc foo {args} {return {initialize}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*all required methods*}
test iortrans-2.13 {chan push, initialize failed, bad result, illegal method name} -body {
    proc foo {args} {return {initialize finalize BOGUS}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*returned bad method "BOGUS": must be clear, drain, finalize, flush, initialize, limit?, read, or write}
test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler mismatch} -body {
    proc foo {args} {return {initialize finalize}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*makes the channel inaccessible}
# iortrans-2.15 event/watch methods elimimated, removed these tests.
# iortrans-2.16
test iortrans-2.17 {chan push, initialize failed, bad result, drain/read mismatch} -body {
    proc foo {args} {return {initialize finalize drain write}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*supports "drain" but not "read"}
test iortrans-2.18 {chan push, initialize failed, bad result, flush/write mismatch} -body {
    proc foo {args} {return {initialize finalize flush read}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*supports "flush" but not "write"}
test iortrans-2.19 {chan push, initialize ok, creates channel} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	global res
	lappend res $args
	if {[lindex $args 0] ne "initialize"} {return}
	return {initialize finalize drain flush read write}
    }
    lappend res [file channel rt*]
    lappend res [chan push [tempchan] foo]
    lappend res [close [lindex $res end]]
    lappend res [file channel rt*]
} -cleanup {
    tempdone
    rename foo {}
} -result {{} {initialize rt* {read write}} file* {drain rt*} {flush rt*} {finalize rt*} {} {}}
test iortrans-2.20 {chan push, init failure -> no channel, no finalize} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	global res
	lappend res $args
	return
    }
    lappend res [file channel rt*]
    lappend res [catch {chan push [tempchan] foo} msg] $msg
    lappend res [file channel rt*]
} -cleanup {
    tempdone
    rename foo {}
} -result {{} {initialize rt* {read write}} 1 {*all required methods*} {}}

# --- --- --- --------- --------- ---------
# method finalize (via close)

# General note: file channels rt* finds the transform channel, however the
# name reported will be that of the underlying base driver, fileXX here.  This
# actually allows us to see if the whole channel is gone, or only the
# transformation, but not the base.

test iortrans-3.1 {chan finalize, handler destruction has no effect on channel} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return
    }
    lappend res [set c [chan push [tempchan] foo]]
    rename foo {}
    lappend res [file channels file*]
    lappend res [file channels rt*]
    lappend res [catch {close $c} msg] $msg
    lappend res [file channels file*]
    lappend res [file channels rt*]
} -cleanup {
    tempdone
} -result {{initialize rt* {read write}} file* file* {} 1 {invalid command name "foo"} {} {}}
test iortrans-3.2 {chan finalize, for close} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return
    }
    lappend res [set c [chan push [tempchan] foo]]
    close $c
    # Close deleted the channel.
    lappend res [file channels rt*]
    # Channel destruction does not kill handler command!
    lappend res [info command foo]
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
test iortrans-3.3 {chan finalize, for close, error, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code error 5
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
    # Channel is gone despite error.
    lappend res [file channels rt*]
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
test iortrans-3.4 {chan finalize, for close, error, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	error FOO
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg $::errorInfo
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO {FOO
*"close $c"}}
test iortrans-3.5 {chan finalize, for close, arbitrary result, ignored} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return SOMETHING
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
test iortrans-3.6 {chan finalize, for close, break, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 3
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans-3.7 {chan finalize, for close, continue, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 4
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans-3.8 {chan finalize, for close, custom code, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 777 BANG
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans-3.9 {chan finalize, for close, ignore level, close error} -setup {
    set res {}
} -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -level 5 -code 777 BANG
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg opt] $msg
    noteOpts $opt
} -match glob -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}

# --- === *** ###########################
# method read (via read)

test iortrans-4.1 {chan read, transform call and return} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return snarf
    }
    set c [chan push [tempchan] foo]
    lappend res [read $c 10]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} snarf}
test iortrans-4.2 {chan read, for non-readable channel} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args MUST_NOT_HAPPEN
    }
    set c [chan push [tempchan w] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {1 {channel "file*" wasn't opened for reading}}
test iortrans-4.3 {chan read, error return} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 BOOM!}
test iortrans-4.4 {chan read, break return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code break BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 *bad code*}
test iortrans-4.5 {chan read, continue return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code continue BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 *bad code*}
test iortrans-4.6 {chan read, custom return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 *bad code*}
test iortrans-4.7 {chan read, level is squashed} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -level 55 -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg opt] $msg
    noteOpts $opt
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
test iortrans-4.8 {chan read, read, bug 2921116} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [read $c]
    #lappend res [gets $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {}}
test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    chan configure $c -buffersize 2
    lappend res [read $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* te} {read rt* st} {read rt* { d}} {read rt* at} {read rt* {a
}} {}}
test iortrans-4.8.2 {chan read, bug 721ec69271} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
	return x
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    chan configure $c -buffersize 1
    lappend res [read $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* t} {read rt* e} {read rt* s} {read rt* t} {read rt* { }} {read rt* d} {read rt* a} {read rt* t} {read rt* a} {read rt* {
}} {}}
test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [gets $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {}}

# Driver for a base channel that emits several short "files"
# with each terminated by a fleeting EOF
    proc driver {cmd args} {
        variable ::tcl::buffer
        variable ::tcl::index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) .....
                return {initialize finalize watch read}
            }
            finalize {
                if {![info exists index($chan)]} {return}
                unset index($chan) buffer($chan)
		array unset index
		array unset buffer
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                if {![info exists index($chan)]} {
                    driver initialize $chan
                }
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                if {[string length $result] == 0} {
                    driver finalize $chan
                }
                return $result
            }
        }
    }



namespace eval reflector {
    proc initialize {_ chan mode} {
	return {initialize finalize watch read}
    }


    proc finalize {_ chan} {
	foreach id [after info] {
	    after cancel $id
	}
	namespace delete $_
    }


    proc read {_ chan count} {
	namespace upvar $_ source source
	set res [string range $source 0 $count-1]
	set source [string range $source $count end]
	return $res
    }


    proc watch {_ chan events} {
	after 0 [list chan postevent $chan read]
	return read
    }

    namespace ensemble create -parameters _
    namespace export *
}




namespace eval inputfilter {
    proc initialize {chan mode} {
	return {initialize finalize read}
    }

    proc read {chan buffer} {
	return $buffer
    }

    proc finalize chan {
	namespace delete $chan
    }

    namespace ensemble create
    namespace export *
}



# Channel read transform that is just the identity - pass all through
    proc idxform {cmd handle args} {
      switch -- $cmd {
        initialize {
            return {initialize finalize read}
        }
        finalize {
            return
        }
        read {
            lassign $args buffer
            return $buffer
        }
      }
    }

# Test that all EOFs pass through full xform stack.  Proper data boundaries.
# Check robustness against buffer sizes.
test iortrans-4.10 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] idxform]
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}
test iortrans-4.10.1 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] idxform]
    chan configure $chan -buffersize 3
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}
test iortrans-4.10.2 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] idxform]
    chan configure $chan -buffersize 5
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}

rename idxform {}

# Channel read transform that delays the data and always returns something
    proc delayxform {cmd handle args} {
      variable store
      switch -- $cmd {
        initialize {
	    set store($handle) {}
            return {initialize finalize read drain}
        }
        finalize {
	    unset store($handle)
            return
        }
        read {
            lassign $args buffer
	    if {$store($handle) eq {}} {
		set reply [string index $buffer 0]
		set store($handle) [string range $buffer 1 end]
	    } else {
		set reply $store($handle)
		set store($handle) $buffer
	    }
            return $reply
        }
	drain {
	    delayxform read $handle {}
	}
      }
    }

# Test that all EOFs pass through full xform stack.  Proper data boundaries.
# Check robustness against buffer sizes.
test iortrans-4.11 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] delayxform]
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}
test iortrans-4.11.1 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] delayxform]
    chan configure $chan -buffersize 3
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}
test iortrans-4.11.2 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] delayxform]
    chan configure $chan -buffersize 5
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}

    rename delayxform {}

# Channel read transform that delays the data and may return {}
    proc delay2xform {cmd handle args} {
      variable store
      switch -- $cmd {
        initialize {
	    set store($handle) {}
            return {initialize finalize read drain}
        }
        finalize {
	    unset store($handle)
            return
        }
        read {
            lassign $args buffer
		set reply $store($handle)
		set store($handle) $buffer
            return $reply
        }
	drain {
	    delay2xform read $handle {}
	}
      }
    }

test iortrans-4.12 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] delay2xform]
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}

    rename delay2xform {}
    rename driver {}


# --- === *** ###########################
# method write (via puts)

test iortrans-5.1 {chan write, regular write} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return transformresult
    }
    set c [chan push [tempchan] foo]
    puts -nonewline $c snarf
    flush $c
    close $c
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarf} transformresult}
test iortrans-5.2 {chan write, no write is ok, no change to file} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return
    }
    set c [chan push [tempchan] foo]
    puts -nonewline $c snarfsnarfsnarf
    flush $c
    close $c
    lappend res [tempview];	# This has to show the original data, as nothing was written
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} {test data}}
test iortrans-5.3 {chan write, failed write} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error FAIL!
    }
    set c [chan push [tempchan] foo]
    puts -nonewline $c snarfsnarfsnarf
    lappend res [catch {flush $c} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
test iortrans-5.4 {chan write, non-writable channel} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args MUST_NOT_HAPPEN
	return
    }
    set c [chan push [tempchan r] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    close $c
    tempdone
    rename foo {}
} -result {1 {channel "file*" wasn't opened for writing}}
test iortrans-5.5 {chan write, failed write, error return} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans-5.6 {chan write, failed write, error return} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans-5.7 {chan write, failed write, break return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code break BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans-5.8 {chan write, failed write, continue return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code continue BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans-5.9 {chan write, failed write, custom return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans-5.10 {chan write, failed write, level is ignored} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -level 55 -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg opt] $msg
    noteOpts $opt
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}}
test iortrans-5.11 {chan write, bug 2921116} -match glob -setup {
    set res {}
    set level 0
} -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# pop - invokes flush - invokes 'foo write' - infinite recursion - stop it
	global level
	if {$level} {
	    return
	}
	incr level
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [puts -nonewline $c abcdef]
    lappend res [flush $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{} {write rt* abcdef} {write rt* abcdef} {}}

# --- === *** ###########################
# method limit?, drain (via read)

test iortrans-6.1 {chan read, read limits} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize limit?
	handle.finalize
	lappend ::res $args
	handle.read
	return 6
    }
    set c [chan push [tempchan] foo]
    lappend res [read $c 10]
} -cleanup {
    tempdone
    rename foo {}
} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
}} {limit? rt*} @@}
test iortrans-6.2 {chan read, read transform drain on eof} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize drain
	handle.finalize
	lappend ::res $args
	handle.read
	handle.drain
	return
    }
    set c [chan push [tempchan] foo]
    lappend res [read $c]
    lappend res [close $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {drain rt*} @<> {}}

# --- === *** ###########################
# method clear (via puts, seek)

test iortrans-7.1 {chan write, write clears read buffers} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	handle.clear
	return transformresult
    }
    set c [chan push [tempchan] foo]
    puts -nonewline $c snarf
    flush $c
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*} {write rt* snarf}}
test iortrans-7.2 {seek clears read buffers} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	return
    }
    set c [chan push [tempchan] foo]
    seek $c 2
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}
test iortrans-7.3 {clear, any result is ignored} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	return -code error "X"
    }
    set c [chan push [tempchan] foo]
    seek $c 2
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}
test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup {
    set res {}
} -body {
    proc foo {fd args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    seek $c 2
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}

# --- === *** ###########################
# method flush (via seek, close)

test iortrans-8.1 {seek flushes write buffers, ignores data} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize flush
	handle.finalize
	lappend ::res $args
	return X
    }
    set c [chan push [tempchan] foo]
    # Flush, no writing
    seek $c 2
    # The close flushes again, this modifies the file!
    lappend res |
    lappend res [close $c] | [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*} | {flush rt*} {} | {teXt data}}
test iortrans-8.2 {close flushes write buffers, writes data} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize flush
	lappend ::res $args
	handle.finalize
	return .flushed.
    }
    set c [chan push [tempchan] foo]
    close $c
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*} {finalize rt*} .flushed.}
test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
    set res {}
} -body {
    proc foo {fd args} {
	handle.initialize flush
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    seek $c 2
    set res
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*}}

# --- === *** ###########################
# method watch - removed from TIP (rev 1.12+)

# --- === *** ###########################
# method event - removed from TIP (rev 1.12+)

# --- === *** ###########################
# 'Pull the rug' tests. Create channel in a interpreter A, move to other
# interpreter B, destroy the origin interpreter (A) before or during access
# from B. Must not crash, must return proper errors.
test iortrans-11.0 {origin interpreter of moved transform gone} -setup {
    set ida [interp create];	#puts <<$ida>>
    set idb [interp create];	#puts <<$idb>>
    # Magic to get the test* commands in the children
    load {} Tcltest $ida
    load {} Tcltest $idb
} -constraints {testchannel} -match glob -body {
    # Set up channel and transform in interpreter
    interp eval $ida $helperscript
    interp eval $ida [list ::variable tempchan [tempchan]]
    interp transfer {} $::tempchan $ida
    set chan [interp eval $ida {
	variable tempchan
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    return
	}
	set chan [chan push $tempchan foo]
	fconfigure $chan -buffering none
	set chan
    }]
    # Move channel to 2nd interpreter, transform goes with it.
    interp eval $ida [list testchannel cut $chan]
    interp eval $idb [list testchannel splice $chan]
    # Kill origin interpreter, then access channel from 2nd interpreter.
    interp delete $ida
    set res {}
    lappend res \
	[catch {interp eval $idb [list puts $chan shoo]} msg] $msg \
	[catch {interp eval $idb [list tell $chan]} msg] $msg \
	[catch {interp eval $idb [list seek $chan 1]} msg] $msg \
	[catch {interp eval $idb [list gets $chan]} msg] $msg \
	[catch {interp eval $idb [list close $chan]} msg] $msg
    #lappend res [interp eval $ida {set res}]
    # actions: clear|write|clear|write|clear|flush|limit?|drain|flush
    # The 'tell' is ok, as it passed through the transform to the base channel
    # without invoking the transform handler.
} -cleanup {
    tempdone
    interp delete $idb
} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -setup {
    set ida [interp create];	#puts <<$ida>>
    set idb [interp create];	#puts <<$idb>>
    # Magic to get the test* commands in the children
    load {} Tcltest $ida
    load {} Tcltest $idb
} -constraints {testchannel} -match glob -body {
    # Set up channel in thread
    set chan [interp eval $ida $helperscript]
    interp eval $ida [list ::variable tempchan [tempchan]]
    interp transfer {} $::tempchan $ida
    set chan [interp eval $ida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    # Destroy interpreter during channel access.
	    suicide
	}
	set chan [chan push $tempchan foo]
	fconfigure $chan -buffering none
	set chan
    }]
    interp alias $ida suicide {} interp delete $ida
    # Move channel to 2nd thread, transform goes with it.
    interp eval $ida [list testchannel cut $chan]
    interp eval $idb [list testchannel splice $chan]
    # Run access from interpreter B, this will give us a synchronous response.
    interp eval $idb [list set chan $chan]
    interp eval $idb [list set mid $tcltest::mainThread]
    set res [interp eval $idb {
	# Wait a bit, give the main thread the time to start its event loop to
	# wait for the response from B
	after 50
	catch { puts $chan shoo } res
	set res
    }]
} -cleanup {
    interp delete $idb
    tempdone
} -result {Owner lost}
test iortrans-11.2 {delete interp of reflected transform} -setup {
    interp create child
    # Magic to get the test* commands into the child
    load {} Tcltest child
} -constraints {testchannel} -body {
    # Get base channel into the child
    set c [tempchan]
    testchannel cut $c
    interp eval child [list testchannel splice $c]
    interp eval child [list set c $c]
    child eval {
	proc no-op args {}
	proc driver {c sub args} {
	    return {initialize finalize read write}
	}
	set t [chan push $c [list driver $c]]
	chan event $c readable no-op
    }
    interp delete child
} -cleanup {
    tempdone
} -result {}

# ### ### ### ######### ######### #########
## Same tests as above, but exercising the code forwarding and receiving
## driver operations to the originator thread.

# ### ### ### ######### ######### #########
## Testing the reflected channel (Thread forwarding).
#
## The id numbers refer to the original test without thread forwarding, and
## gaps due to tests not applicable to forwarding are left to keep this
## association.

# ### ### ### ######### ######### #########
## Helper command. Runs a script in a separate thread and returns the result.
## A channel is transferred into the thread as well, and a list of configuration
## variables

proc inthread {chan script args} {
    # Test thread.
    set tid [thread::create -preserved]
    thread::send $tid {load {} Tcltest}

    # Init thread configuration.
    # - Listed variables
    # - Id of main thread
    # - A number of helper commands

    foreach v $args {
	upvar 1 $v x
	thread::send $tid [list set $v $x]
    }
    thread::send $tid [list set mid [thread::id]]
    thread::send $tid {
	proc notes {} {
	    return $::notes
	}
	proc noteOpts opts {
	    lappend ::notes [dict merge {
		-code !?! -level !?! -errorcode !?! -errorline !?!
		-errorinfo !?! -errorstack !?!
	    } $opts]
	}
    }
    thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)

    # Transfer channel (cut/splice aka detach/attach)

    testchannel cut $chan
    thread::send $tid [list testchannel splice $chan]

    # Run test script, also run local event loop!  The local event loop waits
    # for the result to come back.  It is also necessary for the execution of
    # forwarded channel operations.

    set ::tres ""
    thread::send -async $tid {
	after 50
	catch {s} res;	# This runs the script, 's' was defined at (*)
	thread::send -async $mid [list set ::tres $res]
    }
    vwait ::tres
    # Remove test thread, and return the captured result.

    thread::release $tid
    return $::tres
}

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

test iortrans.tf-3.2 {chan finalize, for close} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return {}
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [inthread $c {
	close $c
	# Close the deleted the channel.
	file channels rt*
    } c]
    # Channel destruction does not kill handler command!
    lappend res [info command foo]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
test iortrans.tf-3.3 {chan finalize, for close, error, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code error 5
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	# Channel is gone despite error.
	lappend notes [file channels rt*]
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
test iortrans.tf-3.4 {chan finalize, for close, error, close errror} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	error FOO
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -match glob -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO}
test iortrans.tf-3.5 {chan finalize, for close, arbitrary result} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return SOMETHING
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
test iortrans.tf-3.6 {chan finalize, for close, break, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 3
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans.tf-3.7 {chan finalize, for close, continue, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 4
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans.tf-3.8 {chan finalize, for close, custom code, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 777 BANG
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans.tf-3.9 {chan finalize, for close, ignore level, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -level 5 -code 777 BANG
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg opt] $msg
	noteOpts $opt
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}

# --- === *** ###########################
# method read

test iortrans.tf-4.1 {chan read, transform call and return} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return snarf
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [read $c 10]
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} snarf}
test iortrans.tf-4.2 {chan read, for non-readable channel} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args MUST_NOT_HAPPEN
    }
    set c [chan push [tempchan w] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {[read $c 2]} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {1 {channel "file*" wasn't opened for reading}}
test iortrans.tf-4.3 {chan read, error return} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 BOOM!}
test iortrans.tf-4.4 {chan read, break return is error} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code break BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 *bad code*}
test iortrans.tf-4.5 {chan read, continue return is error} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code continue BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 *bad code*}
test iortrans.tf-4.6 {chan read, custom return is error} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 *bad code*}
test iortrans.tf-4.7 {chan read, level is squashed} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -level 55 -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg opt] $msg
	noteOpts $opt
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}

# --- === *** ###########################
# method write

test iortrans.tf-5.1 {chan write, regular write} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return transformresult
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	puts -nonewline $c snarf
	flush $c
	close $c
    } c
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarf} transformresult}
test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
	close $c
    } c
    lappend res [tempview];	# This has to show the original data, as nothing was written
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} {test data}}
test iortrans.tf-5.3 {chan write, failed write} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error FAIL!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	puts -nonewline $c snarfsnarfsnarf
	lappend notes [catch {flush $c} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
test iortrans.tf-5.4 {chan write, non-writable channel} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args MUST_NOT_HAPPEN
	return
    }
    set c [chan push [tempchan r] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {1 {channel "file*" wasn't opened for writing}}
test iortrans.tf-5.5 {chan write, failed write, error return} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans.tf-5.6 {chan write, failed write, error return} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans.tf-5.7 {chan write, failed write, break return is error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code break BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans.tf-5.8 {chan write, failed write, continue return is error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code continue BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans.tf-5.9 {chan write, failed write, custom return is error} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans.tf-5.10 {chan write, failed write, level is ignored} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -level 55 -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg opt] $msg
	noteOpts $opt
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}}

# --- === *** ###########################
# method limit?, drain (via read)

test iortrans.tf-6.1 {chan read, read limits} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize limit?
	handle.finalize
	lappend ::res $args
	handle.read
	return 6
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [read $c 10]
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
}} {limit? rt*} @@}
test iortrans.tf-6.2 {chan read, read transform drain on eof} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize drain
	handle.finalize
	lappend ::res $args
	handle.read
	handle.drain
	return
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [read $c]
	lappend notes [close $c]
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {drain rt*} @<> {}}

# --- === *** ###########################
# method clear (via puts, seek)

test iortrans.tf-7.1 {chan write, write clears read buffers} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	handle.clear
	return transformresult
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	puts -nonewline $c snarf
	flush $c
	close $c
    } c
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*} {write rt* snarf}}
test iortrans.tf-7.2 {seek clears read buffers} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	return
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	seek $c 2
	close $c
    } c
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}
test iortrans.tf-7.3 {clear, any result is ignored} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	return -code error "X"
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	seek $c 2
	close $c
    } c
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}

# --- === *** ###########################
# method flush (via seek, close)

test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize flush
	handle.finalize
	lappend ::res $args
	return X
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	# Flush, no writing
	seek $c 2
	# The close flushes again, this modifies the file!
	lappend notes | [close $c] |
	# NOTE: The flush generated by the close is recorded immediately, the
	# other note's here are deferred until after the thread is done. This
	# changes the order of the result a bit from the non-threaded case
	# (The first | moves one to the right). This is an artifact of the
	# 'inthread' framework, not of the transformation itself.
	notes
    } c]
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*} {flush rt*} | {} | {teXt data}}
test iortrans.tf-8.2 {close flushes write buffers, writes data} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize flush
	lappend ::res $args
	handle.finalize
	return .flushed.
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	close $c
    } c
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*} {finalize rt*} .flushed.}

# --- === *** ###########################
# method watch - removed from TIP (rev 1.12+)

# --- === *** ###########################
# method event - removed from TIP (rev 1.12+)

# --- === *** ###########################
# 'Pull the rug' tests. Create channel in a thread A, move to other thread B,
# destroy the origin thread (A) before or during access from B. Must not
# crash, must return proper errors.

test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];	#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    set tidb [thread::create -preserved];	#puts <<$tida>>
    thread::send $tidb {load {} Tcltest}
} -constraints {testchannel thread} -match glob -body {
    # Set up channel in thread
    thread::send $tida $helperscript
    thread::send $tidb $helperscript
    set chan [thread::send $tida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    return
	}
	set chan [chan push [tempchan] foo]
	fconfigure $chan -buffering none
	set chan
    }]

    # Move channel to 2nd thread, transform goes with it.
    thread::send $tida [list testchannel cut $chan]
    thread::send $tidb [list testchannel splice $chan]

    # Kill origin thread, then access channel from 2nd thread.
    thread::release -wait $tida

    set res {}
    lappend res [catch {thread::send $tidb [list puts $chan shoo]} msg] $msg
    lappend res [catch {thread::send $tidb [list tell $chan]} msg] $msg
    lappend res [catch {thread::send $tidb [list seek $chan 1]} msg] $msg
    lappend res [catch {thread::send $tidb [list gets $chan]} msg] $msg
    lappend res [catch {thread::send $tidb [list close $chan]} msg] $msg
    # The 'tell' is ok, as it passed through the transform to the base
    # channel without invoking the transform handler.
} -cleanup {
    thread::send $tidb tempdone
    thread::release $tidb
} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}

test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup {
    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];	#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    set tidb [thread::create -preserved];	#puts <<$tidb>>
    thread::send $tidb {load {} Tcltest}
} -constraints {testchannel thread notValgrind} -match glob -body {
    # Set up channel in thread
    thread::send $tida $helperscript
    thread::send $tidb $helperscript
    set chan [thread::send $tida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    # destroy thread during channel access
	    thread::exit
	}
	set chan [chan push [tempchan] foo]
	fconfigure $chan -buffering none
	set chan
    }]

    # Move channel to 2nd thread, transform goes with it.
    thread::send $tida [list testchannel cut $chan]
    thread::send $tidb [list testchannel splice $chan]

    # Run access from thread B, wait for response from A (A is not using event
    # loop at this point, so the event pile up in the queue.
    thread::send $tidb [list set chan $chan]
    thread::send $tidb [list set mid [thread::id]]
    thread::send -async $tidb {
	# Wait a bit, give the main thread the time to start its event loop to
	# wait for the response from B
	after 50
	catch { puts $chan shoo } res
	catch { close $chan }
	thread::send -async $mid [list set ::res $res]
    }
    vwait ::res
    set res
} -cleanup {
    thread::send $tidb tempdone
    thread::release $tidb
} -result {Owner lost}


test iortrans-ea69b0258a9833cb {
    Crash when using a channel transformation on TCP client socket

    "line two" does not make it into result.  This issue should probably be
    addressed, but it is outside the scope of this test.
} -setup {
    set res {}
    set read 0
} -body {
    namespace eval reflector1 {
	variable source "line one\nline two"
	interp alias {} [namespace current]::dispatch {} [
	    namespace parent]::reflector [namespace current]
    }
    set chan [chan create read [namespace which reflector1::dispatch]]
    chan configure $chan -blocking 0
    chan push $chan inputfilter
    chan event $chan read [list ::apply [list chan {
	variable res
	variable read
	set gets [gets $chan]
	append res $gets
	incr read
    } [namespace current]] $chan]
    vwait [namespace current]::read
    chan pop $chan
    vwait [namespace current]::read
    return $res
} -cleanup {
    catch {unset read}
    close $chan
} -result {line one}

cleanupTests
return