diff options
author | max <max@tclers.tk> | 2014-04-04 15:45:34 (GMT) |
---|---|---|
committer | max <max@tclers.tk> | 2014-04-04 15:45:34 (GMT) |
commit | a89a49e51557dc13104128a3692631f2edb5c712 (patch) | |
tree | ed63ce95475a52f23a387250901fac053941d7a8 | |
parent | a07a756335137e754bcd490da46a1cc1fd8df06c (diff) | |
download | tcl-a89a49e51557dc13104128a3692631f2edb5c712.zip tcl-a89a49e51557dc13104128a3692631f2edb5c712.tar.gz tcl-a89a49e51557dc13104128a3692631f2edb5c712.tar.bz2 |
Fix/improve tests.
-rw-r--r-- | tests/socket.test | 67 |
1 files changed, 30 insertions, 37 deletions
diff --git a/tests/socket.test b/tests/socket.test index e2e40f1..927e544 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -998,34 +998,36 @@ test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket s close $s1 } -result bye -test socket_$af-8.2 {testing writable event when quick failure} {socket win} { +test socket_$af-8.2 {testing writable event when quick failure} -constraints [list socket win supported_$af] -body { # Test for bug 336441ed59 where a quick background fail was ignored - - # Test only for windows as socket -async 255.255.255.255 fails directly - # on unix + + # Test only for windows as socket -async 255.255.255.255 fails + # directly on unix # The following connect should fail very quickly set a1 [after 2000 {set x timeout}] - set s [socket -async 255.255.255.255 43434] + set s [socket -async $localhost 43434] fileevent $s writable {set x writable} vwait x + set x +} -cleanup { catch {close $s} after cancel $a1 - set x -} writable +} -result writable -test socket_$af-8.3 {testing fileevent readable on failed async socket connect} {socket} { +test socket_$af-8.3 {testing fileevent readable on failed async socket connect} -constraints [list socket supported_$af] -body { # Test for bug 581937ab1e - + set a1 [after 5000 {set x timeout}] # This connect should fail set s [socket -async localhost [randport]] fileevent $s readable {set x readable} vwait x + set x +} -cleanup { catch {close $s} after cancel $a1 - set x -} readable +} -result readable test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup { set len 0 @@ -1602,8 +1604,8 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup { close $f # If the socket doesn't hit end-of-file in 10 seconds, the script1 process # must have inherited the client. - set failed 0 - set after [after 10000 [list set failed 1]] + set timeout 0 + set after [after 10000 {set x "client socket was inherited"}] } -constraints [list socket supported_$af stdio exec] -body { # Create the server socket set server [socket -server accept -myaddr $localhost 0] @@ -1613,26 +1615,20 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup { close $server fileevent $file readable [list getdata $file] fconfigure $file -buffering line -blocking 0 + set ::f $file } proc getdata { file } { # Read handler on the accepted socket. - global x failed + global x set status [catch {read $file} data] if {$status != 0} { - set x {read failed, error was $data} - catch { close $file } + set x "read failed, error was $data" } elseif {$data ne ""} { } elseif {[fblocked $file]} { } elseif {[eof $file]} { - if {$failed} { - set x {client socket was inherited} - } else { - set x {client socket was not inherited} - } - catch { close $file } + set x "client socket was not inherited" } else { - set x {impossible case} - catch { close $file } + set x "impossible case" } } # Launch the script2 process @@ -1642,6 +1638,8 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup { vwait x return $x } -cleanup { + fconfigure $f -blocking 1 + close $f after cancel $after close $p } -result {client socket was not inherited} @@ -1683,35 +1681,30 @@ test socket_$af-12.3 {testing inheritance of accepted sockets} -setup { # If the socket is still open after 5 seconds, the script1 process must # have inherited the accepted socket. set failed 0 - set after [after 5000 [list set failed 1]] + set after [after 5000 [list set x "accepted socket was inherited"]] proc getdata { file } { # Read handler on the client socket. global x global failed set status [catch {read $file} data] if {$status != 0} { - set x {read failed, error was $data} - catch { close $file } + set x "read failed, error was $data" } elseif {[string compare {} $data]} { } elseif {[fblocked $file]} { } elseif {[eof $file]} { - if {$failed} { - set x {accepted socket was inherited} - } else { - set x {accepted socket was not inherited} - } - catch { close $file } + set x "accepted socket was not inherited" } else { - set x {impossible case} - catch { close $file } + set x "impossible case" } return } vwait x - return $x + set x } -cleanup { + fconfigure $f -blocking 1 + close $f after cancel $after - catch {close $p} + close $p } -result {accepted socket was not inherited} test socket_$af-13.1 {Testing use of shared socket between two threads} -body { |