summaryrefslogtreecommitdiffstats
path: root/tests/ioTrans.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/ioTrans.test')
-rw-r--r--tests/ioTrans.test241
1 files changed, 146 insertions, 95 deletions
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 8dbad78..7f4f7f0 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -16,12 +16,15 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
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 testthread [llength [info commands testthread]]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# testchannel cut|splice Both needed to test the reflection in threads.
-# testthread send
+# thread::send
#----------------------------------------------------------------------
@@ -207,7 +210,7 @@ test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler misma
} -returnCodes error -cleanup {
tempdone
rename foo {}
-} -match glob -result {*makes the channel inacessible}
+} -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 {
@@ -280,6 +283,8 @@ test iortrans-3.1 {chan finalize, handler destruction has no effect on channel}
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 {}
@@ -297,6 +302,7 @@ test iortrans-3.2 {chan finalize, for close} -setup {
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 {}
@@ -312,6 +318,7 @@ test iortrans-3.3 {chan finalize, for close, error, close error} -setup {
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 {}
@@ -325,6 +332,7 @@ test iortrans-3.4 {chan finalize, for close, error, close error} -setup {
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 {
@@ -339,6 +347,7 @@ test iortrans-3.5 {chan finalize, for close, arbitrary result, ignored} -setup {
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 {}
@@ -352,6 +361,7 @@ test iortrans-3.6 {chan finalize, for close, break, close error} -setup {
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 {}
@@ -365,6 +375,7 @@ test iortrans-3.7 {chan finalize, for close, continue, close error} -setup {
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 {}
@@ -378,6 +389,7 @@ test iortrans-3.8 {chan finalize, for close, custom code, close error} -setup {
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 {}
@@ -392,6 +404,7 @@ test iortrans-3.9 {chan finalize, for close, ignore level, close error} -setup {
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"*}}
# --- === *** ###########################
@@ -526,7 +539,46 @@ test iortrans-4.8 {chan read, read, bug 2921116} -setup {
tempdone
rename foo {}
} -result {{read rt* {test data
-}} file*}
+}} {}}
+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 {
@@ -544,7 +596,7 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
tempdone
rename foo {}
} -result {{read rt* {test data
-}} file*}
+}} {}}
# --- === *** ###########################
# method write (via puts)
@@ -1033,6 +1085,8 @@ test iortrans-11.2 {delete interp of reflected transform} -setup {
chan event $c readable no-op
}
interp delete slave
+} -cleanup {
+ tempdone
} -result {}
# ### ### ### ######### ######### #########
@@ -1046,22 +1100,6 @@ test iortrans-11.2 {delete interp of reflected transform} -setup {
## gaps due to tests not applicable to forwarding are left to keep this
## association.
-# Duplicate of code in "thread.test", and "ioCmd.test". Find a better way of
-# doing this without duplication. Maybe placement into a proc which transforms
-# to nop after the first call, and placement of its defintion in a central
-# location.
-
-if {[testConstraint testthread]} {
- testthread errorproc ThreadError
- proc ThreadError {id info} {
- global threadError
- set threadError $info
- }
- proc ThreadNullError {id info} {
- # ignore
- }
-}
-
# ### ### ### ######### ######### #########
## 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
@@ -1069,7 +1107,8 @@ if {[testConstraint testthread]} {
proc inthread {chan script args} {
# Test thread.
- set tid [testthread create]
+ set tid [thread::create -preserved]
+ thread::send $tid {load {} Tcltest}
# Init thread configuration.
# - Listed variables
@@ -1078,10 +1117,10 @@ proc inthread {chan script args} {
foreach v $args {
upvar 1 $v x
- testthread send $tid [list set $v $x]
+ thread::send $tid [list set $v $x]
}
- testthread send $tid [list set mid $tcltest::mainThread]
- testthread send $tid {
+ thread::send $tid [list set mid [thread::id]]
+ thread::send $tid {
proc notes {} {
return $::notes
}
@@ -1092,27 +1131,27 @@ proc inthread {chan script args} {
} $opts]
}
}
- testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
+ thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
# Transfer channel (cut/splice aka detach/attach)
testchannel cut $chan
- testthread send $tid [list testchannel splice $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 ""
- testthread send -async $tid {
+ thread::send -async $tid {
after 50
catch {s} res; # This runs the script, 's' was defined at (*)
- testthread send -async $mid [list set ::tres $res]
+ thread::send -async $mid [list set ::tres $res]
}
vwait ::tres
# Remove test thread, and return the captured result.
- tcltest::threadReap
+ thread::release $tid
return $::tres
}
@@ -1120,7 +1159,7 @@ proc inthread {chan script args} {
test iortrans.tf-3.2 {chan finalize, for close} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
lappend ::res $args
handle.initialize
@@ -1139,7 +1178,7 @@ test iortrans.tf-3.2 {chan finalize, for close} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
lappend ::res $args
handle.initialize
@@ -1157,7 +1196,7 @@ test iortrans.tf-3.3 {chan finalize, for close, error, close error} -setup {
} -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 testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
lappend ::res $args
handle.initialize
@@ -1173,7 +1212,7 @@ test iortrans.tf-3.4 {chan finalize, for close, error, close errror} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
lappend ::res $args
handle.initialize
@@ -1189,7 +1228,7 @@ test iortrans.tf-3.5 {chan finalize, for close, arbitrary result} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
lappend ::res $args
handle.initialize
@@ -1205,7 +1244,7 @@ test iortrans.tf-3.6 {chan finalize, for close, break, close error} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
lappend ::res $args
handle.initialize
@@ -1221,7 +1260,7 @@ test iortrans.tf-3.7 {chan finalize, for close, continue, close error} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
lappend ::res $args
handle.initialize
@@ -1237,7 +1276,7 @@ test iortrans.tf-3.8 {chan finalize, for close, custom code, close error} -setup
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
lappend ::res $args
handle.initialize
@@ -1258,7 +1297,7 @@ test iortrans.tf-3.9 {chan finalize, for close, ignore level, close error} -setu
test iortrans.tf-4.1 {chan read, transform call and return} -setup {
set res {}
-} -constraints {testchannel testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1278,7 +1317,7 @@ test iortrans.tf-4.1 {chan read, transform call and return} -setup {
}} snarf}
test iortrans.tf-4.2 {chan read, for non-readable channel} -setup {
set res {}
-} -constraints {testchannel testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1296,7 +1335,7 @@ test iortrans.tf-4.2 {chan read, for non-readable channel} -setup {
} -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 testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1316,7 +1355,7 @@ test iortrans.tf-4.3 {chan read, error return} -setup {
}} 1 BOOM!}
test iortrans.tf-4.4 {chan read, break return is error} -setup {
set res {}
-} -constraints {testchannel testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1336,7 +1375,7 @@ test iortrans.tf-4.4 {chan read, break return is error} -setup {
}} 1 *bad code*}
test iortrans.tf-4.5 {chan read, continue return is error} -setup {
set res {}
-} -constraints {testchannel testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1356,7 +1395,7 @@ test iortrans.tf-4.5 {chan read, continue return is error} -setup {
}} 1 *bad code*}
test iortrans.tf-4.6 {chan read, custom return is error} -setup {
set res {}
-} -constraints {testchannel testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1376,7 +1415,7 @@ test iortrans.tf-4.6 {chan read, custom return is error} -setup {
}} 1 *bad code*}
test iortrans.tf-4.7 {chan read, level is squashed} -setup {
set res {}
-} -constraints {testchannel testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1401,7 +1440,7 @@ test iortrans.tf-4.7 {chan read, level is squashed} -setup {
test iortrans.tf-5.1 {chan write, regular write} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1421,7 +1460,7 @@ test iortrans.tf-5.1 {chan write, regular write} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1441,7 +1480,7 @@ test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -setup {
} -result {{write rt* snarfsnarfsnarf} {test data}}
test iortrans.tf-5.3 {chan write, failed write} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1461,7 +1500,7 @@ test iortrans.tf-5.3 {chan write, failed write} -setup {
} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
test iortrans.tf-5.4 {chan write, non-writable channel} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1483,7 +1522,7 @@ test iortrans.tf-5.4 {chan write, non-writable channel} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1505,7 +1544,7 @@ test iortrans.tf-5.5 {chan write, failed write, error return} -setup {
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans.tf-5.6 {chan write, failed write, error return} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1527,7 +1566,7 @@ test iortrans.tf-5.6 {chan write, failed write, error return} -setup {
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans.tf-5.7 {chan write, failed write, break return is error} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1549,7 +1588,7 @@ test iortrans.tf-5.7 {chan write, failed write, break return is error} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1570,7 +1609,7 @@ test iortrans.tf-5.8 {chan write, failed write, continue return is error} -setup
} -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 testthread} -body {
+} -constraints {testchannel thread} -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1592,7 +1631,7 @@ test iortrans.tf-5.9 {chan write, failed write, custom return is error} -setup {
} -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 testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize
handle.finalize
@@ -1619,7 +1658,7 @@ test iortrans.tf-5.10 {chan write, failed write, level is ignored} -setup {
test iortrans.tf-6.1 {chan read, read limits} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize limit?
handle.finalize
@@ -1640,7 +1679,7 @@ test iortrans.tf-6.1 {chan read, read limits} -setup {
}} {limit? rt*} @@}
test iortrans.tf-6.2 {chan read, read transform drain on eof} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize drain
handle.finalize
@@ -1665,7 +1704,7 @@ test iortrans.tf-6.2 {chan read, read transform drain on eof} -setup {
test iortrans.tf-7.1 {chan write, write clears read buffers} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize clear
handle.finalize
@@ -1686,7 +1725,7 @@ test iortrans.tf-7.1 {chan write, write clears read buffers} -setup {
} -result {{clear rt*} {write rt* snarf}}
test iortrans.tf-7.2 {seek clears read buffers} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize clear
handle.finalize
@@ -1705,7 +1744,7 @@ test iortrans.tf-7.2 {seek clears read buffers} -setup {
} -result {{clear rt*}}
test iortrans.tf-7.3 {clear, any result is ignored} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize clear
handle.finalize
@@ -1728,7 +1767,7 @@ test iortrans.tf-7.3 {clear, any result is ignored} -setup {
test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize flush
handle.finalize
@@ -1755,7 +1794,7 @@ test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup {
} -result {{flush rt*} {flush rt*} | {} | {teXt data}}
test iortrans.tf-8.2 {close flushes write buffers, writes data} -setup {
set res {}
-} -constraints {testchannel testthread} -match glob -body {
+} -constraints {testchannel thread} -match glob -body {
proc foo {args} {
handle.initialize flush
lappend ::res $args
@@ -1785,12 +1824,15 @@ test iortrans.tf-8.2 {close flushes write buffers, writes data} -setup {
test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
#puts <<$tcltest::mainThread>>main
- set tida [testthread create]; #puts <<$tida>>
- set tidb [testthread create]; #puts <<$tidb>>
-} -constraints {testchannel testthread} -match glob -body {
+ 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
- testthread send $tida $helperscript
- set chan [testthread send $tida {
+ 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
@@ -1801,64 +1843,73 @@ test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
fconfigure $chan -buffering none
set chan
}]
+
# Move channel to 2nd thread, transform goes with it.
- testthread send $tida [list testchannel cut $chan]
- testthread send $tidb [list testchannel splice $chan]
+ thread::send $tida [list testchannel cut $chan]
+ thread::send $tidb [list testchannel splice $chan]
+
# Kill origin thread, then access channel from 2nd thread.
- testthread send -async $tida {testthread exit}
- after 50
- set res {}
- lappend res [catch {testthread send $tidb [list puts $chan shoo]} msg] $msg
- lappend res [catch {testthread send $tidb [list tell $chan]} msg] $msg
- lappend res [catch {testthread send $tidb [list seek $chan 1]} msg] $msg
- lappend res [catch {testthread send $tidb [list gets $chan]} msg] $msg
- lappend res [catch {testthread send $tidb [list close $chan]} msg] $msg
+ 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 {
- tcltest::threadReap
- tempdone
+ 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 [testthread create]; #puts <<$tida>>
- set tidb [testthread create]; #puts <<$tidb>>
-} -constraints {testchannel testthread} -match glob -body {
+ 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
- set chan [testthread send $tida $helperscript]
- set chan [testthread send $tida {
+ 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
- testthread exit
- return
+ thread::exit
}
set chan [chan push [tempchan] foo]
fconfigure $chan -buffering none
set chan
}]
+
# Move channel to 2nd thread, transform goes with it.
- testthread send $tida [list testchannel cut $chan]
- testthread send $tidb [list testchannel splice $chan]
+ 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.
- testthread send $tidb [list set chan $chan]
- testthread send $tidb [list set mid $tcltest::mainThread]
- testthread send -async $tidb {
+ 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 }
- testthread send -async $mid [list set ::res $res]
+ thread::send -async $mid [list set ::res $res]
}
vwait ::res
- return $res
+ set res
} -cleanup {
- tcltest::threadReap
- tempdone
+ thread::send $tidb tempdone
+ thread::release $tidb
} -result {Owner lost}
# ### ### ### ######### ######### #########
generated by cgit v0.12 at 2025-11-16 17:16:31 (GMT)