summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authormax <max@tclers.tk>2014-04-04 15:45:34 (GMT)
committermax <max@tclers.tk>2014-04-04 15:45:34 (GMT)
commita89a49e51557dc13104128a3692631f2edb5c712 (patch)
treeed63ce95475a52f23a387250901fac053941d7a8
parenta07a756335137e754bcd490da46a1cc1fd8df06c (diff)
downloadtcl-a89a49e51557dc13104128a3692631f2edb5c712.zip
tcl-a89a49e51557dc13104128a3692631f2edb5c712.tar.gz
tcl-a89a49e51557dc13104128a3692631f2edb5c712.tar.bz2
Fix/improve tests.
-rw-r--r--tests/socket.test67
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 {