diff options
| -rw-r--r-- | tests/socket.test | 42 |
1 files changed, 14 insertions, 28 deletions
diff --git a/tests/socket.test b/tests/socket.test index 9754f05..2251bb5 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -5,12 +5,12 @@ # generates output for errors. No output means no errors were found. # # Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: socket.test,v 1.15 2000/09/20 23:09:54 jenn Exp $ +# RCS: @(#) $Id: socket.test,v 1.16 2000/09/21 00:58:30 hobbs Exp $ # Running socket tests with a remote server: # ------------------------------------------ @@ -67,10 +67,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } -# Some tests require the testthread command +# Some tests require the testthread and exec commands set ::tcltest::testConstraints(testthread) \ [expr {[info commands testthread] != {}}] +set ::tcltest::testConstraints(exec) [expr {[info commands exec] != {}}] # # If remoteServerIP or remoteServerPort are not set, check in the @@ -551,19 +552,19 @@ test socket-2.11 {detecting new data} {socket} { flush $s2 after 500 fconfigure $sock -blocking 0 - set result [gets $sock] - lappend result [gets $sock] + set result a:[gets $sock] + lappend result b:[gets $sock] fconfigure $sock -blocking 1 puts $s2 two flush $s2 fconfigure $sock -blocking 0 - lappend result [gets $sock] + lappend result c:[gets $sock] fconfigure $sock -blocking 1 close $s2 close $s close $sock set result -} {one {} two} +} {a:one b: c:two} test socket-3.1 {socket conflict} {socket stdio} { @@ -1276,6 +1277,7 @@ test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} { sendCommand {close $socket10_13_test_server} list $spurious $len } {0 2690} + test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} { set counter 0 set done 0 @@ -1303,12 +1305,13 @@ test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} { } } set c [socket $remoteServerIP 2836] - fileevent $c readable "count_up $c" + fileevent $c readable [list count_up $c] set after_id [after 1000 timed_out] vwait done sendCommand {close $socket10_14_test_server} set done } {EOF is sticky} + test socket-11.13 {testing async write, async flush, async close} \ {socket doTestsWithRemoteServer} { proc readit {s} { @@ -1363,8 +1366,7 @@ test socket-11.13 {testing async write, async flush, async close} \ set count } 65566 -test socket-12.1 {testing inheritance of server sockets} \ - {socket doTestsWithRemoteServer} { +test socket-12.1 {testing inheritance of server sockets} {socket exec} { removeFile script1 removeFile script2 @@ -1415,8 +1417,7 @@ test socket-12.1 {testing inheritance of server sockets} \ removeFile script2 set x } {server socket was not inherited} -test socket-12.2 {testing inheritance of client sockets} \ - {socket doTestsWithRemoteServer} { +test socket-12.2 {testing inheritance of client sockets} {socket exec} { removeFile script1 removeFile script2 @@ -1450,7 +1451,6 @@ test socket-12.2 {testing inheritance of client sockets} \ set server [socket -server accept 2829] proc accept { file host port } { - # When the client connects, establish the read handler global server close $server @@ -1459,7 +1459,6 @@ test socket-12.2 {testing inheritance of client sockets} \ return } proc getdata { file } { - # Read handler on the accepted socket. global x global failed @@ -1501,8 +1500,7 @@ test socket-12.2 {testing inheritance of client sockets} \ removeFile script2 set x } {client socket was not inherited} -test socket-12.3 {testing inheritance of accepted sockets} \ - {socket doTestsWithRemoteServer} { +test socket-12.3 {testing inheritance of accepted sockets} {socket exec} { removeFile script1 removeFile script2 @@ -1546,7 +1544,6 @@ test socket-12.3 {testing inheritance of accepted sockets} \ after 5000 set failed 1 proc getdata { file } { - # Read handler on the client socket. global x global failed @@ -1641,14 +1638,3 @@ catch {close $remoteProcChan} ::tcltest::cleanupTests flush stdout return - - - - - - - - - - - |