diff options
Diffstat (limited to 'tests/socket.test')
| -rw-r--r-- | tests/socket.test | 23 |
1 files changed, 20 insertions, 3 deletions
diff --git a/tests/socket.test b/tests/socket.test index 17524a1..55b4f2f 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1822,14 +1822,30 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} { try { set ::count 0 set ::testmode $testmode + set port 0 + set srvsock {} + # if binding on port 0 is not possible (system related, blocked on ISPs etc): + if {[catch {close [socket -async $::localhost $port]}]} { + # simplest server on random port (immediatelly closing a connect): + set port [randport] + set srvsock [socket -server {apply {{ch args} {close $ch}}} -myaddr $::localhost $port] + # socket on windows has some issues yet (e. g. bug [b6d0d8cc2c]), so we simply decrease iteration count (to 1/4): + if {$::tcl_platform(platform) eq "windows" && $maxIter > 50} { + set ::count [expr {$maxIter / 4 * 3 - 1}]; # bypass 3/4 iterations + } + } + tcltest::DebugPuts 1 "== test \[$::localhost\]:$port $testmode ==" set ::master [thread::id] # helper thread creating async connection and initiating transfer (detach) to master: set ::helper [thread::create] - thread::send -async $::helper [list lassign [list $::master $::localhost $testmode] ::master ::localhost ::testmode] + thread::send -async $::helper [list \ + lassign [list $::master $::localhost $port $testmode] \ + ::master ::localhost ::port ::testmode + ] thread::send -async $::helper { set ::helper [thread::id] proc iteration {args} { - set fd [socket -async $::localhost 0] + set fd [socket -async $::localhost $::port] if {"helper-writable" in $::testmode} {;# to test both sides during connect fileevent $fd writable [list apply {{fd} { if {[thread::id] ne $::helper} { @@ -1842,7 +1858,7 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} { thread::detach $fd thread::send -async $::master [list transf_master $fd {*}$args] } - iteration + iteration first } # master proc commiting transfer attempt (attach) and checking acquire was successful: proc transf_master {fd args} { @@ -1880,6 +1896,7 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} { set ::count } finally { catch {after cancel $tout} + if {$srvsock ne {}} {close $srvsock} if {[info exists ::helper]} {thread::release -wait $::helper} tcltest::DebugPuts 1 "== stop / $::count ==" unset -nocomplain ::count ::testmode ::master ::helper |