diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | tests/socket.test | 29 |
2 files changed, 16 insertions, 19 deletions
@@ -1,3 +1,9 @@ +2011-09-11 Don Porter <dgp@users.sourceforge.net> + + * tests/socket.test: [Bug 3390699]: Convert [testthread] use to + Thread package use in socket_*-13.1. Eliminates a memory leak in + `make valgrind`. + 2011-09-10 Donal K. Fellows <dkf@users.sf.net> * generic/tclOOMethod.c (InitEnsembleRewrite): [Bug 3400658]: Set the diff --git a/tests/socket.test b/tests/socket.test index 0ea0eb5..58eb3ee 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -63,8 +63,8 @@ package require tcltest 2 namespace import -force ::tcltest::* -# Some tests require the testthread and exec commands -testConstraint testthread [llength [info commands testthread]] +# Some tests require the Thread package or exec command +testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}] testConstraint exec [llength [info commands exec]] # Produce a random port number in the Dynamic/Private range @@ -1672,9 +1672,9 @@ test socket_$af-12.3 {testing inheritance of accepted sockets} -setup { catch {close $p} } -result {accepted socket was not inherited} -test socket_$af-13.1 {Testing use of shared socket between two threads} -setup { - threadReap - set path(script) [makeFile [string map [list @localhost@ $localhost] { +test socket_$af-13.1 {Testing use of shared socket between two threads} -body { + # create a thread + set serverthread [thread::create -preserved [string map [list @localhost@ $localhost] { set f [socket -server accept -myaddr @localhost@ 0] set listen [lindex [fconfigure $f -sockname] 2] proc accept {s a p} { @@ -1696,15 +1696,8 @@ test socket_$af-13.1 {Testing use of shared socket between two threads} -setup { set i 0 vwait x close $f - # thread cleans itself up. - testthread exit - }] script] -} -constraints [list socket supported_$af testthread] -body { - # create a thread - set serverthread [testthread create [list source $path(script) ] ] - update - set port [testthread send $serverthread {set listen}] - update + }]] + set port [thread::send $serverthread {set listen}] set s [socket $localhost $port] fconfigure $s -buffering line catch { @@ -1712,11 +1705,9 @@ test socket_$af-13.1 {Testing use of shared socket between two threads} -setup { gets $s result } close $s - update - append result " " [threadReap] -} -cleanup { - removeFile script -} -result {hello 1} + thread::release $serverthread + append result " " [llength [thread::names]] +} -result {hello 1} -constraints [list socket supported_$af thread] # ---------------------------------------------------------------------- |