summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog3
-rw-r--r--generic/tclIORChan.c1
-rw-r--r--tests/ioTrans.test183
3 files changed, 93 insertions, 94 deletions
diff --git a/ChangeLog b/ChangeLog
index 2691e4d..1325f72 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
2011-09-15 Don Porter <dgp@users.sourceforge.net>
+ * tests/ioTrans.test: Conversion from [testthread] to Thread package
+ stops most memory leaks.
+
* tests/thread.test: Plug most memory leaks in thread.test Constrain
the rest to be skipped during `make valgrind`. Tests using the
[testthread cancel] testing command are leaky. Corrections wait for
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index da6f642..61c8475 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -439,6 +439,7 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
static Tcl_Obj * NextHandle(void);
static void FreeReflectedChannel(ReflectedChannel *rcPtr);
+static void FreeReflectedChannelArgs(ReflectedChannel *rcPtr);
static int InvokeTclMethod(ReflectedChannel *rcPtr,
const char *method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index d8defcc..7da4329 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -18,10 +18,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# 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.6}]}]
# testchannel cut|splice Both needed to test the reflection in threads.
-# testthread send
+# thread::send
#----------------------------------------------------------------------
@@ -1046,22 +1046,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 +1053,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 +1063,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 +1077,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 +1105,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 +1124,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 +1142,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 +1158,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 +1174,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 +1190,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 +1206,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 +1222,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 +1243,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 +1263,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 +1281,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 +1301,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 +1321,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 +1341,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 +1361,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 +1386,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 +1406,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 +1426,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 +1446,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 +1468,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 +1490,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 +1512,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 +1534,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 +1555,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 +1577,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 +1604,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 +1625,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 +1650,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 +1671,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 +1690,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 +1713,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 +1740,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,13 +1770,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
- testthread send $tidb $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
@@ -1802,65 +1789,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 {
- testthread send $tidb tempdone
- tcltest::threadReap
+ 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
- testthread send $tida $helperscript
- testthread send $tidb $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 {
- testthread send $tidb tempdone
- tcltest::threadReap
+ thread::send $tidb tempdone
+ thread::release $tidb
} -result {Owner lost}
# ### ### ### ######### ######### #########