new subtree for tcl/tk

1 files changed, 0 insertions, 2093 deletions

diff --git a/tcl8.6/tests/ioTrans.test b/tcl8.6/tests/ioTrans.test
deleted file mode 100644
index e179eab..0000000
--- a/tcl8.6/tests/ioTrans.test
+++ /dev/null
@@ -1,2093 +0,0 @@
-# -*- 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 {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    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 {[lsearch [namespace children] ::tcltest] == -1} {
-	package require tcltest 2
-	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 "initalize"
-
-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
-            }
-        }
-    }
-
-# 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 slaves
-    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
-} -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 slaves
-    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 {
-    tempdone
-} -result {Owner lost}
-test iortrans-11.2 {delete interp of reflected transform} -setup {
-    interp create slave
-    # Magic to get the test* commands into the slave
-    load {} Tcltest slave
-} -constraints {testchannel} -body {
-    # Get base channel into the slave
-    set c [tempchan]
-    testchannel cut $c
-    interp eval slave [list testchannel splice $c]
-    interp eval slave [list set c $c]
-    slave 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 slave
-} -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 transfered into the thread as well, and a list of configuation
-## 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 defered 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}}
-
-testConstraint notValgrind [expr {![testConstraint valgrind]}]
-
-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}
-
-# ### ### ### ######### ######### #########
-
-cleanupTests
-return