Attachment "chanpush.patch" to
ticket [2920003fff]
added by
sbron
2009-12-23 19:12:26.
Index: generic/tclIORTrans.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIORTrans.c,v
retrieving revision 1.10
diff -u -r1.10 tclIORTrans.c
--- generic/tclIORTrans.c 18 Nov 2009 22:21:06 -0000 1.10
+++ generic/tclIORTrans.c 23 Dec 2009 12:02:48 -0000
@@ -707,10 +707,10 @@
#endif
/*
- * Return the channel as the result of the command.
+ * Return the transformation handle as the result of the command.
*/
- Tcl_AppendResult(interp, Tcl_GetChannelName(rtPtr->chan), NULL);
+ Tcl_SetObjResult(interp, rtId);
return TCL_OK;
error:
Index: tests/ioTrans.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/ioTrans.test,v
retrieving revision 1.7
diff -u -r1.7 ioTrans.test
--- tests/ioTrans.test 21 Jul 2008 21:12:49 -0000 1.7
+++ tests/ioTrans.test 23 Dec 2009 12:02:49 -0000
@@ -243,13 +243,13 @@
}
set res {}
lappend res [file channel rt*]
- lappend res [chan push [tempchan] foo]
- lappend res [close [lindex $res end]]
+ lappend res [chan push [set tmp [tempchan]] foo]
+ lappend res [close $tmp]
lappend res [file channel rt*]
tempdone
rename foo {}
set res
-} -result {{} {initialize rt* {read write}} file* {drain rt*} {flush rt*} {finalize rt*} {} {}}
+} -result {{} {initialize rt* {read write}} rt* {drain rt*} {flush rt*} {finalize rt*} {} {}}
test iortrans-2.20 {chan push, init failure -> no channel, no finalize} -match glob -body {
proc foo {args} {
global res
@@ -277,88 +277,88 @@
test iortrans-3.1 {chan finalize, handler destruction has no effect on channel} -match glob -body {
set res {}
proc foo {args} {track; oninit; return}
- note [set c [chan push [tempchan] foo]]
+ note [set c [chan push [set tmp [tempchan]] foo]]
rename foo {}
note [file channels file*]
note [file channels rt*]
- note [catch {close $c} msg]; note $msg
+ note [catch {close $tmp} msg]; note $msg
note [file channels file*]
note [file channels rt*]
set res
-} -result {{initialize rt* {read write}} file* file* {} 1 {invalid command name "foo"} {} {}}
+} -result {{initialize rt* {read write}} rt* file* {} 1 {invalid command name "foo"} {} {}}
test iortrans-3.2 {chan finalize, for close} -match glob -body {
set res {}
proc foo {args} {track; oninit; return {}}
- note [set c [chan push [tempchan] foo]]
- close $c
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ close $tmp
# Close deleted the channel.
note [file channels rt*]
# Channel destruction does not kill handler command!
note [info command foo]
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
+} -result {{initialize rt* {read write}} rt* {finalize rt*} {} foo}
test iortrans-3.3 {chan finalize, for close, error, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code error 5}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ note [catch {close $tmp} msg]; note $msg
# Channel is gone despite error.
note [file channels rt*]
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 5 {}}
test iortrans-3.4 {chan finalize, for close, error, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; error FOO}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg; note $::errorInfo
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ note [catch {close $tmp} msg]; note $msg; note $::errorInfo
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO {FOO
-*"close $c"}}
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 FOO {FOO
+*"close $tmp"}}
test iortrans-3.5 {chan finalize, for close, arbitrary result, ignored} -match glob -body {
set res {}
proc foo {args} {track; oninit; return SOMETHING}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ note [catch {close $tmp} msg]; note $msg
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 0 {}}
test iortrans-3.6 {chan finalize, for close, break, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 3}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ note [catch {close $tmp} msg]; note $msg
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 *bad code*}
test iortrans-3.7 {chan finalize, for close, continue, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 4}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ note [catch {close $tmp} msg]; note $msg
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 *bad code*}
test iortrans-3.8 {chan finalize, for close, custom code, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 777 BANG}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ note [catch {close $tmp} msg]; note $msg
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 *bad code*}
test iortrans-3.9 {chan finalize, for close, ignore level, close error} -match glob -setup {
set res {}
} -body {
proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
- note [set c [chan push [tempchan] foo]]
- note [catch {close $c} msg opt]; note $msg; noteOpts $opt
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ note [catch {close $tmp} msg opt]; note $msg; noteOpts $opt
return $res
} -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"*}}
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
# --- === *** ###########################
# method read (via read)
@@ -369,8 +369,8 @@
oninit; onfinal; track
return snarf
}
- set c [chan push [tempchan] foo]
- note [read $c 10]
+ set c [chan push [set tmp [tempchan]] foo]
+ note [read $tmp 10]
tempdone
rename foo {}
set res
@@ -381,8 +381,8 @@
proc foo {args} {
oninit; onfinal; track; note MUST_NOT_HAPPEN
}
- set c [chan push [tempchan w] foo]
- note [catch {read $c 2} msg]; note $msg
+ set c [chan push [set tmp [tempchan w]] foo]
+ note [catch {read $tmp 2} msg]; note $msg
tempdone
rename foo {}
set res
@@ -393,8 +393,8 @@
oninit; onfinal; track
return -code error BOOM!
}
- set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg]; note $msg
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {read $tmp 2} msg]; note $msg
tempdone
rename foo {}
set res
@@ -406,8 +406,8 @@
oninit; onfinal; track
return -code break BOOM!
}
- set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg]; note $msg
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {read $tmp 2} msg]; note $msg
tempdone
rename foo {}
set res
@@ -419,8 +419,8 @@
oninit; onfinal; track
return -code continue BOOM!
}
- set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg]; note $msg
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {read $tmp 2} msg]; note $msg
tempdone
rename foo {}
set res
@@ -432,8 +432,8 @@
oninit; onfinal; track
return -code 777 BOOM!
}
- set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg]; note $msg
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {read $tmp 2} msg]; note $msg
tempdone
rename foo {}
set res
@@ -445,8 +445,8 @@
oninit; onfinal; track
return -level 55 -code 777 BOOM!
}
- set c [chan push [tempchan] foo]
- note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {read $tmp 2} msg opt]; note $msg; noteOpts $opt
tempdone
rename foo {}
set res
@@ -460,9 +460,9 @@
test iortrans-5.1 {chan write, regular write} -match glob -body {
set res {}
proc foo {args} { oninit; onfinal; track ; return transformresult }
- set c [chan push [tempchan] foo]
- puts -nonewline $c snarf; flush $c
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ puts -nonewline $tmp snarf; flush $tmp
+ close $tmp
note [tempview]
tempdone
rename foo {}
@@ -471,9 +471,9 @@
test iortrans-5.2 {chan write, no write is ok, no change to file} -match glob -body {
set res {}
proc foo {args} { oninit; onfinal; track ; return {} }
- set c [chan push [tempchan] foo]
- puts -nonewline $c snarfsnarfsnarf; flush $c
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ puts -nonewline $tmp snarfsnarfsnarf; flush $tmp
+ close $tmp
note [tempview];# This has to show the original data, as nothing was written
tempdone
rename foo {}
@@ -482,9 +482,9 @@
test iortrans-5.3 {chan write, failed write} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code error FAIL!}
- set c [chan push [tempchan] foo]
- puts -nonewline $c snarfsnarfsnarf
- note [catch {flush $c} msg] ; note $msg
+ set c [chan push [set tmp [tempchan]] foo]
+ puts -nonewline $tmp snarfsnarfsnarf
+ note [catch {flush $tmp} msg] ; note $msg
tempdone
rename foo {}
set res
@@ -492,9 +492,10 @@
test iortrans-5.4 {chan write, non-writable channel} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
- set c [chan push [tempchan r] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]; note $msg
- close $c
+ set c [chan push [set tmp [tempchan r]] foo]
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
+ note $msg
+ close $tmp
tempdone
rename foo {}
set res
@@ -502,8 +503,8 @@
test iortrans-5.5 {chan write, failed write, error return} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
- set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
tempdone
rename foo {}
@@ -512,8 +513,8 @@
test iortrans-5.6 {chan write, failed write, error return} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; error BOOM!}
- set c [chan push [tempchan] foo]
- notes [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
tempdone
rename foo {}
@@ -522,8 +523,8 @@
test iortrans-5.7 {chan write, failed write, break return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
- set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
tempdone
rename foo {}
@@ -532,8 +533,8 @@
test iortrans-5.8 {chan write, failed write, continue return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
- set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
tempdone
rename foo {}
@@ -542,8 +543,8 @@
test iortrans-5.9 {chan write, failed write, custom return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
- set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
tempdone
rename foo {}
@@ -552,8 +553,8 @@
test iortrans-5.10 {chan write, failed write, level is ignored} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
- set c [chan push [tempchan] foo]
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
+ set c [chan push [set tmp [tempchan]] foo]
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg opt]
note $msg
noteOpts $opt
tempdone
@@ -570,8 +571,8 @@
oninit limit?; onfinal; track ; onread
return 6
}
- set c [chan push [tempchan] foo]
- note [read $c 10]
+ set c [chan push [set tmp [tempchan]] foo]
+ note [read $tmp 10]
tempdone
rename foo {}
set res
@@ -583,9 +584,9 @@
oninit drain; onfinal; track ; onread ; ondrain
return
}
- set c [chan push [tempchan] foo]
- note [read $c]
- note [close $c]
+ set c [chan push [set tmp [tempchan]] foo]
+ note [read $tmp]
+ note [close $tmp]
tempdone
rename foo {}
set res
@@ -601,8 +602,8 @@
oninit clear; onfinal; track ; onclear
return transformresult
}
- set c [chan push [tempchan] foo]
- puts -nonewline $c snarf; flush $c
+ set c [chan push [set tmp [tempchan]] foo]
+ puts -nonewline $tmp snarf; flush $tmp
tempdone
rename foo {}
set res
@@ -613,8 +614,8 @@
oninit clear; onfinal; track
return
}
- set c [chan push [tempchan] foo]
- seek $c 2
+ set c [chan push [set tmp [tempchan]] foo]
+ seek $tmp 2
tempdone
rename foo {}
set res
@@ -625,8 +626,8 @@
oninit clear; onfinal; track
return -code error "X"
}
- set c [chan push [tempchan] foo]
- seek $c 2
+ set c [chan push [set tmp [tempchan]] foo]
+ seek $tmp 2
tempdone
rename foo {}
set res
@@ -641,11 +642,11 @@
oninit flush; onfinal; track
return X
}
- set c [chan push [tempchan] foo]
+ set c [chan push [set tmp [tempchan]] foo]
# Flush, no writing
- seek $c 2
+ seek $tmp 2
# The close flushes again, this modifies the file!
- note | ; note [close $c] ; note |
+ note | ; note [close $tmp] ; note |
note [tempview]
tempdone
rename foo {}
@@ -658,8 +659,8 @@
oninit flush; track ; onfinal
return .flushed.
}
- set c [chan push [tempchan] foo]
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ close $tmp
note [tempview]
tempdone
rename foo {}
@@ -695,8 +696,8 @@
variable tempchan
proc foo {args} {oninit clear drain flush limit? read write; onfinal; track; return}
set chan [chan push $tempchan foo]
- fconfigure $chan -buffering none
- set chan
+ fconfigure $tempchan -buffering none
+ set tempchan
}]
# Move channel to 2nd interpreter, transform goes with it.
@@ -739,9 +740,9 @@
# Actually not possible for an interp to destroy itself.
interp delete {}
return}
- set chan [chan push [tempchan] foo]
- fconfigure $chan -buffering none
- set chan
+ set chan [chan push [set tmp [tempchan]] foo]
+ fconfigure $tmp -buffering none
+ set tmp
}]
# Move channel to 2nd thread, transform goes with it.
@@ -853,105 +854,105 @@
test iortrans.tf-3.2 {chan finalize, for close} -match glob -body {
set res {}
proc foo {args} {track; oninit; return {}}
- note [set c [chan push [tempchan] foo]]
- note [inthread $c {
- close $c
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ note [inthread $tmp {
+ close $tmp
# Close the deleted the channel.
file channels rt*
- } c]
+ } tmp]
# Channel destruction does not kill handler command!
note [info command foo]
rename foo {}
set res
} -constraints {testchannel testthread} \
- -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
+ -result {{initialize rt* {read write}} rt* {finalize rt*} {} foo}
test iortrans.tf-3.3 {chan finalize, for close, error, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code error 5}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ notes [inthread $tmp {
+ note [catch {close $tmp} msg]; note $msg
# Channel is gone despite error.
note [file channels rt*]
notes
- } c]
+ } tmp]
rename foo {}
set res
} -constraints {testchannel testthread} \
- -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
+ -result {{initialize rt* {read write}} rt* {finalize rt*} 1 5 {}}
test iortrans.tf-3.4 {chan finalize, for close, error, close errror} -match glob -body {
set res {}
proc foo {args} {track; oninit; error FOO}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ notes [inthread $tmp {
+ note [catch {close $tmp} msg]; note $msg
notes
- } c]
+ } tmp]
rename foo {}
set res
} -constraints {testchannel testthread} \
- -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO}
+ -result {{initialize rt* {read write}} rt* {finalize rt*} 1 FOO}
test iortrans.tf-3.5 {chan finalize, for close, arbitrary result} -match glob -body {
set res {}
proc foo {args} {track; oninit; return SOMETHING}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ notes [inthread $tmp {
+ note [catch {close $tmp} msg]; note $msg
notes
- } c]
+ } tmp]
rename foo {}
set res
} -constraints {testchannel testthread} \
- -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
+ -result {{initialize rt* {read write}} rt* {finalize rt*} 0 {}}
test iortrans.tf-3.6 {chan finalize, for close, break, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 3}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ notes [inthread $tmp {
+ note [catch {close $tmp} msg]; note $msg
notes
- } c]
+ } tmp]
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} \
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 *bad code*} \
-constraints {testchannel testthread}
test iortrans.tf-3.7 {chan finalize, for close, continue, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 4}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ notes [inthread $tmp {
+ note [catch {close $tmp} msg]; note $msg
notes
- } c]
+ } tmp]
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} \
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 *bad code*} \
-constraints {testchannel testthread}
test iortrans.tf-3.8 {chan finalize, for close, custom code, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -code 777 BANG}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg]; note $msg
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ notes [inthread $tmp {
+ note [catch {close $tmp} msg]; note $msg
notes
- } c]
+ } tmp]
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*} \
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 *bad code*} \
-constraints {testchannel testthread}
test iortrans.tf-3.9 {chan finalize, for close, ignore level, close error} -match glob -body {
set res {}
proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
- note [set c [chan push [tempchan] foo]]
- notes [inthread $c {
- note [catch {close $c} msg opt]; note $msg; noteOpts $opt
+ note [set c [chan push [set tmp [tempchan]] foo]]
+ notes [inthread $tmp {
+ note [catch {close $tmp} msg opt]; note $msg; noteOpts $opt
notes
- } c]
+ } tmp]
rename foo {}
set res
-} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \
+} -result {{initialize rt* {read write}} rt* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \
-constraints {testchannel testthread}
# --- === *** ###########################
@@ -963,12 +964,12 @@
oninit; onfinal; track
return snarf
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [read $c 10]
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [read $tmp 10]
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -980,12 +981,12 @@
proc foo {args} {
oninit; onfinal; track; note MUST_NOT_HAPPEN
}
- set c [chan push [tempchan w] foo]
- notes [inthread $c {
- note [catch {[read $c 2]} msg]; note $msg
- close $c
+ set c [chan push [set tmp [tempchan w]] foo]
+ notes [inthread $tmp {
+ note [catch {[read $tmp 2]} msg]; note $msg
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -996,12 +997,12 @@
oninit; onfinal; track
return -code error BOOM!
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg]; note $msg
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {read $tmp 2} msg]; note $msg
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1014,12 +1015,12 @@
oninit; onfinal; track
return -code break BOOM!
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg]; note $msg
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {read $tmp 2} msg]; note $msg
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1032,12 +1033,12 @@
oninit; onfinal; track
return -code continue BOOM!
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg]; note $msg
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {read $tmp 2} msg]; note $msg
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1050,12 +1051,12 @@
oninit; onfinal; track
return -code 777 BOOM!
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg]; note $msg
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {read $tmp 2} msg]; note $msg
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1069,12 +1070,12 @@
oninit; onfinal; track
return -level 55 -code 777 BOOM!
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {read $tmp 2} msg opt]; note $msg; noteOpts $opt
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1088,11 +1089,11 @@
test iortrans.tf-5.1 {chan write, regular write} -match glob -body {
set res {}
proc foo {args} { oninit; onfinal; track ; return transformresult }
- set c [chan push [tempchan] foo]
- inthread $c {
- puts -nonewline $c snarf; flush $c
- close $c
- } c
+ set c [chan push [tmp [tempchan]] foo]
+ inthread $tmp {
+ puts -nonewline $tmp snarf; flush $tmp
+ close $tmp
+ } tmp
note [tempview]
tempdone
rename foo {}
@@ -1101,11 +1102,11 @@
test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -match glob -body {
set res {}
proc foo {args} { oninit; onfinal; track ; return {} }
- set c [chan push [tempchan] foo]
- inthread $c {
- puts -nonewline $c snarfsnarfsnarf; flush $c
- close $c
- } c
+ set c [chan push [set tmp [tempchan]] foo]
+ inthread $tmp {
+ puts -nonewline $tmp snarfsnarfsnarf; flush $tmp
+ close $tmp
+ } tmp
note [tempview];# This has to show the original data, as nothing was written
tempdone
rename foo {}
@@ -1115,14 +1116,14 @@
test iortrans.tf-5.3 {chan write, failed write} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code error FAIL!}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- puts -nonewline $c snarfsnarfsnarf
- note [catch {flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ puts -nonewline $tmp snarfsnarfsnarf
+ note [catch {flush $tmp} msg]
note $msg
- close $c
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1131,13 +1132,13 @@
test iortrans.tf-5.4 {chan write, non-writable channel} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
- set c [chan push [tempchan r] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan r]] foo]
+ notes [inthread $tmp {
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
- close $c
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1146,13 +1147,13 @@
test iortrans.tf-5.5 {chan write, failed write, error return} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
- close $c
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1161,13 +1162,13 @@
test iortrans.tf-5.6 {chan write, failed write, error return} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; error BOOM!}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
- close $c
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1178,13 +1179,13 @@
test iortrans.tf-5.7 {chan write, failed write, break return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
- close $c
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1193,13 +1194,13 @@
test iortrans.tf-5.8 {chan write, failed write, continue return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
- close $c
+ close $tmp
notes
- } c]
+ } tmp]
rename foo {}
set res
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*} \
@@ -1207,13 +1208,13 @@
test iortrans.tf-5.9 {chan write, failed write, custom return is error} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg]
note $msg
- close $c
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1222,14 +1223,14 @@
test iortrans.tf-5.10 {chan write, failed write, level is ignored} -match glob -body {
set res {}
proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [catch {puts -nonewline $tmp snarfsnarfsnarf; flush $tmp} msg opt]
note $msg
noteOpts $opt
- close $c
+ close $tmp
notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1246,12 +1247,12 @@
oninit limit?; onfinal; track ; onread
return 6
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [read $c 10]
- close $c
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [read $tmp 10]
+ close $tmp
set notes
- } c]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1263,11 +1264,11 @@
oninit drain; onfinal; track ; onread ; ondrain
return
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
- note [read $c]
- note [close $c]
- } c]
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
+ note [read $tmp]
+ note [close $tmp]
+ } tmp]
tempdone
rename foo {}
set res
@@ -1283,11 +1284,11 @@
oninit clear; onfinal; track ; onclear
return transformresult
}
- set c [chan push [tempchan] foo]
- inthread $c {
- puts -nonewline $c snarf; flush $c
- close $c
- } c
+ set c [chan push [set tmp [tempchan]] foo]
+ inthread $tmp {
+ puts -nonewline $tmp snarf; flush $tmp
+ close $tmp
+ } tmp
tempdone
rename foo {}
set res
@@ -1298,11 +1299,11 @@
oninit clear; onfinal; track
return
}
- set c [chan push [tempchan] foo]
- inthread $c {
- seek $c 2
- close $c
- } c
+ set c [chan push [set tmp [tempchan]] foo]
+ inthread $tmp {
+ seek $tmp 2
+ close $tmp
+ } tmp
tempdone
rename foo {}
set res
@@ -1313,11 +1314,11 @@
oninit clear; onfinal; track
return -code error "X"
}
- set c [chan push [tempchan] foo]
- inthread $c {
- seek $c 2
- close $c
- } c
+ set c [chan push [set tmp [tempchan]] foo]
+ inthread $tmp {
+ seek $tmp 2
+ close $tmp
+ } tmp
tempdone
rename foo {}
set res
@@ -1332,12 +1333,12 @@
oninit flush; onfinal; track
return X
}
- set c [chan push [tempchan] foo]
- notes [inthread $c {
+ set c [chan push [set tmp [tempchan]] foo]
+ notes [inthread $tmp {
# Flush, no writing
- seek $c 2
+ seek $tmp 2
# The close flushes again, this modifies the file!
- note | ; note [close $c] ; note |
+ note | ; note [close $tmp] ; note |
# 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
@@ -1345,7 +1346,7 @@
# right). This is an artifact of the 'inthread' framework, not
# of the transformation itself.
notes
- } c]
+ } tmp]
note [tempview]
tempdone
rename foo {}
@@ -1358,10 +1359,10 @@
oninit flush; track ; onfinal
return .flushed.
}
- set c [chan push [tempchan] foo]
- inthread $c {
- close $c
- } c
+ set c [chan push [set tmp [tempchan]] foo]
+ inthread $tmp {
+ close $tmp
+ } tmp
note [tempview]
tempdone
rename foo {}
@@ -1390,9 +1391,9 @@
testthread send $tida $helperscript
set chan [testthread send $tida {
proc foo {args} {oninit clear drain flush limit? read write; onfinal; track; return}
- set chan [chan push [tempchan] foo]
- fconfigure $chan -buffering none
- set chan
+ set chan [chan push [set tmp [tempchan]] foo]
+ fconfigure $tmp -buffering none
+ set tmp
}]
# Move channel to 2nd thread, transform goes with it.
@@ -1432,9 +1433,9 @@
# destroy thread during channel access
testthread exit
return}
- set chan [chan push [tempchan] foo]
- fconfigure $chan -buffering none
- set chan
+ set chan [chan push [set tmp [tempchan]] foo]
+ fconfigure $tmp -buffering none
+ set tmp
}]
# Move channel to 2nd thread, transform goes with it.
