summaryrefslogtreecommitdiffstats
path: root/tests/socket.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/socket.test')
-rw-r--r--tests/socket.test279
1 files changed, 136 insertions, 143 deletions
diff --git a/tests/socket.test b/tests/socket.test
index 96b81b8..0ae5abd 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -12,46 +12,46 @@
# Running socket tests with a remote server:
# ------------------------------------------
-#
+#
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
# can start the remote server on any machine reachable from the machine on
# which you want to run the socket tests, by issuing:
-#
+#
# tcltest remote.tcl -port 2048 # Or choose another port number.
-#
+#
# If the machine you are running the remote server on has several IP
# interfaces, you can choose which interface the server listens on for
# connections by specifying the -address command line flag, so:
-#
+#
# tcltest remote.tcl -address your.machine.com
-#
+#
# These options can also be set by environment variables. On Unix, you can
# type these commands to the shell from which the remote server is started:
-#
+#
# shell% setenv serverPort 2048
# shell% setenv serverAddress your.machine.com
-#
+#
# and subsequently you can start the remote server with:
-#
+#
# tcltest remote.tcl
-#
+#
# to have it listen on port 2048 on the interface your.machine.com.
-#
+#
# When the server starts, it prints out a detailed message containing its
# configuration information, and it will block until killed with a Ctrl-C.
# Once the remote server exists, you can run the tests in socket.test with
# the server by setting two Tcl variables:
-#
+#
# % set remoteServerIP <name or address of machine on which server runs>
# % set remoteServerPort 2048
-#
+#
# These variables are also settable from the environment. On Unix, you can:
-#
+#
# shell% setenv remoteServerIP machine.where.server.runs
# shell% senetv remoteServerPort 2048
-#
+#
# The preamble of the socket.test file checks to see if the variables are set
# either in Tcl or in the environment; if they are, it attempts to connect to
# the server. If the connection is successful, the tests using the remote
@@ -91,7 +91,7 @@ if {![info exists remoteServerPort]} {
#
set doTestsWithRemoteServer 1
-if {![info exists remoteServerIP] && ($tcl_platform(platform) != "macintosh")} {
+if {![info exists remoteServerIP]} {
set remoteServerIP 127.0.0.1
}
if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {
@@ -109,45 +109,43 @@ set remoteProcChan ""
set commandSocket ""
if {$doTestsWithRemoteServer} {
catch {close $commandSocket}
- if {[catch {set commandSocket [socket $remoteServerIP \
- $remoteServerPort]}] != 0} {
- if {[info commands exec] == ""} {
- set noRemoteTestReason "can't exec"
- set doTestsWithRemoteServer 0
- } else {
- set remoteServerIP 127.0.0.1
- # Be *extra* careful in case this file is sourced from
- # a directory other than the current one...
- set remoteFile [file join [pwd] [file dirname [info script]] \
- remote.tcl]
- if {[catch {set remoteProcChan \
- [open "|[list [interpreter] $remoteFile \
- -serverIsSilent \
- -port $remoteServerPort \
- -address $remoteServerIP]" \
- w+]} \
- msg] == 0} {
- after 1000
- if {[catch {set commandSocket [socket $remoteServerIP \
- $remoteServerPort]} msg] == 0} {
- fconfigure $commandSocket -translation crlf -buffering line
- } else {
- set noRemoteTestReason $msg
- set doTestsWithRemoteServer 0
- }
+ if {![catch {
+ set commandSocket [socket $remoteServerIP $remoteServerPort]
+ }]} then {
+ fconfigure $commandSocket -translation crlf -buffering line
+ } elseif {![testConstraint exec]} {
+ set noRemoteTestReason "can't exec"
+ set doTestsWithRemoteServer 0
+ } else {
+ set remoteServerIP 127.0.0.1
+ # Be *extra* careful in case this file is sourced from
+ # a directory other than the current one...
+ set remoteFile [file join [pwd] [file dirname [info script]] \
+ remote.tcl]
+ if {![catch {
+ set remoteProcChan [open "|[list \
+ [interpreter] $remoteFile -serverIsSilent \
+ -port $remoteServerPort -address $remoteServerIP]" w+]
+ } msg]} then {
+ after 1000
+ if {[catch {
+ set commandSocket [socket $remoteServerIP $remoteServerPort]
+ } msg] == 0} then {
+ fconfigure $commandSocket -translation crlf -buffering line
} else {
- set noRemoteTestReason "$msg [interpreter]"
+ set noRemoteTestReason $msg
set doTestsWithRemoteServer 0
}
+ } else {
+ set noRemoteTestReason "$msg [interpreter]"
+ set doTestsWithRemoteServer 0
}
- } else {
- fconfigure $commandSocket -translation crlf -buffering line
}
}
# Some tests are run only if we are doing testing against a remote server.
-set ::tcltest::testConstraints(doTestsWithRemoteServer) $doTestsWithRemoteServer
-if {$doTestsWithRemoteServer == 0} {
+testConstraint doTestsWithRemoteServer $doTestsWithRemoteServer
+if {!$doTestsWithRemoteServer} {
if {[string first s $::tcltest::verbose] != -1} {
puts "Skipping tests with remote server. See tests/socket.test for"
puts "information on how to run remote server."
@@ -160,14 +158,13 @@ if {$doTestsWithRemoteServer == 0} {
# remote server.
#
-if {$doTestsWithRemoteServer == 1} {
+if {[testConstraint doTestsWithRemoteServer]} {
proc sendCommand {c} {
global commandSocket
if {[eof $commandSocket]} {
error "remote server disappeared"
}
-
if {[catch {puts $commandSocket $c} msg]} {
error "remote server disappaered: $msg"
}
@@ -199,17 +196,13 @@ test socket-1.1 {arg parsing for socket command} {socket} {
} {1 {no argument given for -server option}}
test socket-1.2 {arg parsing for socket command} {socket} {
list [catch {socket -server foo} msg] $msg
-} {1 {wrong # args: should be either:
-socket ?-myaddr addr? ?-myport myport? ?-async? host port
-socket -server command ?-myaddr addr? port}}
+} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.3 {arg parsing for socket command} {socket} {
list [catch {socket -myaddr} msg] $msg
} {1 {no argument given for -myaddr option}}
test socket-1.4 {arg parsing for socket command} {socket} {
list [catch {socket -myaddr 127.0.0.1} msg] $msg
-} {1 {wrong # args: should be either:
-socket ?-myaddr addr? ?-myport myport? ?-async? host port
-socket -server command ?-myaddr addr? port}}
+} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.5 {arg parsing for socket command} {socket} {
list [catch {socket -myport} msg] $msg
} {1 {no argument given for -myport option}}
@@ -218,25 +211,19 @@ test socket-1.6 {arg parsing for socket command} {socket} {
} {1 {expected integer but got "xxxx"}}
test socket-1.7 {arg parsing for socket command} {socket} {
list [catch {socket -myport 2522} msg] $msg
-} {1 {wrong # args: should be either:
-socket ?-myaddr addr? ?-myport myport? ?-async? host port
-socket -server command ?-myaddr addr? port}}
+} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.8 {arg parsing for socket command} {socket} {
list [catch {socket -froboz} msg] $msg
} {1 {bad option "-froboz": must be -async, -myaddr, -myport, or -server}}
test socket-1.9 {arg parsing for socket command} {socket} {
list [catch {socket -server foo -myport 2521 3333} msg] $msg
-} {1 {Option -myport is not valid for servers}}
+} {1 {option -myport is not valid for servers}}
test socket-1.10 {arg parsing for socket command} {socket} {
list [catch {socket host 2528 -junk} msg] $msg
-} {1 {wrong # args: should be either:
-socket ?-myaddr addr? ?-myport myport? ?-async? host port
-socket -server command ?-myaddr addr? port}}
+} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.11 {arg parsing for socket command} {socket} {
list [catch {socket -server callback 2520 --} msg] $msg
-} {1 {wrong # args: should be either:
-socket ?-myaddr addr? ?-myport myport? ?-async? host port
-socket -server command ?-myaddr addr? port}}
+} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.12 {arg parsing for socket command} {socket} {
list [catch {socket foo badport} msg] $msg
} {1 {expected integer but got "badport"}}
@@ -284,7 +271,7 @@ test socket-2.1 {tcp connection} {socket stdio} {
if [info exists port] {
incr port
-} else {
+} else {
set port [expr 2048 + [pid]%1024]
}
test socket-2.2 {tcp connection with client port specified} {socket stdio} {
@@ -486,7 +473,7 @@ test socket-2.8 {echo server, loop 50 times, single connection} -constraints {so
global x
close $s
set x done
- } else {
+ } else {
incr i
puts $s $l
}
@@ -577,6 +564,7 @@ test socket-2.11 {detecting new data} {socket} {
fconfigure $sock -blocking 1
puts $s2 two
flush $s2
+ after 500
fconfigure $sock -blocking 0
lappend result c:[gets $sock]
fconfigure $sock -blocking 1
@@ -591,7 +579,7 @@ test socket-3.1 {socket conflict} {socket stdio} {
file delete $path(script)
set f [open $path(script) w]
puts $f {
- set f [socket -server accept 0]
+ set f [socket -server accept -myaddr 127.0.0.1 0]
puts ready
puts [lindex [fconfigure $f -sockname] 2]
gets stdin
@@ -601,7 +589,7 @@ test socket-3.1 {socket conflict} {socket stdio} {
set f [open "|[list [interpreter] $path(script)]" r+]
gets $f
gets $f listen
- set x [list [catch {socket -server accept $listen} msg] \
+ set x [list [catch {socket -server accept -myaddr 127.0.0.1 $listen} msg] \
$msg]
puts $f bye
close $f
@@ -615,7 +603,7 @@ test socket-3.2 {server with several clients} {socket stdio} {
set t2 [after 31000 "set x timed_out"]
set t3 [after 32000 "set x timed_out"]
set counter 0
- set s [socket -server accept 0]
+ set s [socket -server accept -myaddr 127.0.0.1 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
@@ -706,7 +694,7 @@ test socket-4.1 {server with several clients} {socket stdio} {
set t1 [after 30000 "set x timed_out"]
set t2 [after 31000 "set x timed_out"]
set t3 [after 32000 "set x timed_out"]
- set s [socket -server accept 0]
+ set s [socket -server accept -myaddr 127.0.0.1 0]
set listen [lindex [fconfigure $s -sockname] 2]
puts $p1 $listen
puts $p2 $listen
@@ -732,7 +720,7 @@ test socket-4.1 {server with several clients} {socket stdio} {
} {{p1 bye done} {p2 bye done} {p3 bye done}}
test socket-4.2 {byte order problems, socket numbers, htons} {socket} {
set x ok
- if {[catch {socket -server dodo 0x3000} msg]} {
+ if {[catch {socket -server dodo -myaddr 127.0.0.1 0x3000} msg]} {
set x $msg
} else {
close $msg
@@ -741,7 +729,7 @@ test socket-4.2 {byte order problems, socket numbers, htons} {socket} {
} ok
test socket-5.1 {byte order problems, socket numbers, htons} \
- {socket unixOnly notRoot} {
+ {socket unix notRoot} {
set x {couldn't open socket: not owner}
if {![catch {socket -server dodo 0x1} msg]} {
set x {htons problem, should be disallowed, are you running as SU?}
@@ -758,7 +746,7 @@ test socket-5.2 {byte order problems, socket numbers, htons} {socket} {
set x
} {couldn't open socket: port number too high}
test socket-5.3 {byte order problems, socket numbers, htons} \
- {socket unixOnly notRoot} {
+ {socket unix notRoot} {
set x {couldn't open socket: not owner}
if {![catch {socket -server dodo 21} msg]} {
set x {htons problem, should be disallowed, are you running as SU?}
@@ -767,8 +755,14 @@ test socket-5.3 {byte order problems, socket numbers, htons} \
set x
} {couldn't open socket: not owner}
-test socket-6.1 {accept callback error} {socket stdio} {
+test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
+ proc myHandler {msg options} {
+ variable x $msg
+ }
+ set handler [interp bgerror {}]
+ interp bgerror {} [namespace which myHandler]
file delete $path(script)
+} -body {
set f [open $path(script) w]
puts $f {
gets stdin port
@@ -776,21 +770,18 @@ test socket-6.1 {accept callback error} {socket stdio} {
}
close $f
set f [open "|[list [interpreter] $path(script)]" r+]
- proc bgerror args {
- global x
- set x $args
- }
proc accept {s a p} {expr 10 / 0}
- set s [socket -server accept 0]
+ set s [socket -server accept -myaddr 127.0.0.1 0]
puts $f [lindex [fconfigure $s -sockname] 2]
close $f
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
close $s
- rename bgerror {}
set x
-} {{divide by zero}}
+} -cleanup {
+ interp bgerror {} $handler
+} -result {divide by zero}
test socket-7.1 {testing socket specific options} {socket stdio} {
file delete $path(script)
@@ -848,21 +839,21 @@ test socket-7.2 {testing socket specific options} {socket stdio} {
[expr {[lindex $p 2] == $listen}]
} {3 1 0}
test socket-7.3 {testing socket specific options} {socket} {
- set s [socket -server accept 0]
+ set s [socket -server accept -myaddr 127.0.0.1 0]
set l [fconfigure $s]
close $s
update
llength $l
} 14
test socket-7.4 {testing socket specific options} {socket} {
- set s [socket -server accept 0]
+ set s [socket -server accept -myaddr 127.0.0.1 0]
proc accept {s a p} {
global x
set x [fconfigure $s -sockname]
close $s
}
set listen [lindex [fconfigure $s -sockname] 2]
- set s1 [socket [info hostname] $listen]
+ set s1 [socket 127.0.0.1 $listen]
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
@@ -904,14 +895,14 @@ test socket-8.1 {testing -async flag on sockets} {socket} {
# problem, please email jyl@eng.sun.com. We have not observed this
# failure on Solaris 2.5, so another option (instead of installing
# these patches) is to upgrade to Solaris 2.5.
- set s [socket -server accept 0]
+ set s [socket -server accept -myaddr 127.0.0.1 0]
proc accept {s a p} {
global x
puts $s bye
close $s
set x done
}
- set s1 [socket -async [info hostname] [lindex [fconfigure $s -sockname] 2]]
+ set s1 [socket -async 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
vwait x
set z [gets $s1]
close $s
@@ -941,8 +932,8 @@ test socket-9.1 {testing spurious events} {socket} {
fconfigure $s -buffering none -blocking off
fileevent $s readable [list readlittle $s]
}
- set s [socket -server accept 0]
- set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
+ set s [socket -server accept -myaddr 127.0.0.1 0]
+ set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
puts -nonewline $c 01234567890123456789012345678901234567890123456789
close $c
set timer [after 10000 "set done timed_out"]
@@ -958,7 +949,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
for {set i 0} {$i < 16} {incr i} {
set secondblock "b$secondblock$secondblock"
}
- set l [socket -server accept 0]
+ set l [socket -server accept -myaddr 127.0.0.1 0]
proc accept {s a p} {
fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-buffering line
@@ -979,7 +970,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
puts -nonewline $s $secondblock
close $s
}
- set s [socket [info hostname] [lindex [fconfigure $l -sockname] 2]]
+ set s [socket 127.0.0.1 [lindex [fconfigure $l -sockname] 2]]
fconfigure $s -blocking 0 -trans lf -buffering line
set count 0
puts $s hello
@@ -1018,7 +1009,7 @@ test socket-9.3 {testing EOF stickyness} {socket} {
set done true
set count {timer went off, eof is not sticky}
close $c
- }
+ }
set count 0
set done false
proc write_then_close {s} {
@@ -1029,8 +1020,8 @@ test socket-9.3 {testing EOF stickyness} {socket} {
fconfigure $s -buffering line -translation lf
fileevent $s writable "write_then_close $s"
}
- set s [socket -server accept 0]
- set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
+ set s [socket -server accept -myaddr 127.0.0.1 0]
+ set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
fconfigure $c -blocking off -buffering line -translation lf
fileevent $c readable "count_to_eof $c"
set timer [after 1000 timerproc]
@@ -1041,17 +1032,26 @@ test socket-9.3 {testing EOF stickyness} {socket} {
removeFile script
-test socket-10.1 {testing socket accept callback error handling} {socket} {
- set goterror 0
- proc bgerror args {global goterror; set goterror 1}
- set s [socket -server accept 0]
+test socket-10.1 {testing socket accept callback error handling} -constraints {
+ socket
+} -setup {
+ variable goterror 0
+ proc myHandler {msg options} {
+ variable goterror 1
+ }
+ set handler [interp bgerror {}]
+ interp bgerror {} [namespace which myHandler]
+} -body {
+ set s [socket -server accept -myaddr 127.0.0.1 0]
proc accept {s a p} {close $s; error}
set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
vwait goterror
close $s
close $c
set goterror
-} 1
+} -cleanup {
+ interp bgerror {} $handler
+} -result 1
test socket-11.1 {tcp connection} {socket doTestsWithRemoteServer} {
sendCommand {
@@ -1153,15 +1153,9 @@ test socket-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} {
sendCommand {close $socket10_7_test_server}
set cnt
} 50
-# Macintosh sockets can have more than one server per port
-if {$tcl_platform(platform) == "macintosh"} {
- set conflictResult {0 2836}
-} else {
- set conflictResult {1 {couldn't open socket: address already in use}}
-}
test socket-11.6 {socket conflict} {socket doTestsWithRemoteServer} {
- set s1 [socket -server accept 2836]
- if {[catch {set s2 [socket -server accept 2836]} msg]} {
+ set s1 [socket -server accept -myaddr 127.0.0.1 2836]
+ if {[catch {set s2 [socket -server accept -myaddr 127.0.0.1 2836]} msg]} {
set result [list 1 $msg]
} else {
set result [list 0 [lindex [fconfigure $s2 -sockname] 2]]
@@ -1169,7 +1163,7 @@ test socket-11.6 {socket conflict} {socket doTestsWithRemoteServer} {
}
close $s1
set result
-} $conflictResult
+} {1 {couldn't open socket: address already in use}}
test socket-11.7 {server with several clients} {socket doTestsWithRemoteServer} {
sendCommand {
set socket10_9_test_server [socket -server accept 2836]
@@ -1205,7 +1199,7 @@ test socket-11.7 {server with several clients} {socket doTestsWithRemoteServer}
close $s3
sendCommand {close $socket10_9_test_server}
set i
-} 100
+} 100
test socket-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
sendCommand {
set s1 [socket -server "accept 4003" 4003]
@@ -1232,13 +1226,17 @@ test socket-11.8 {client with several servers} {socket doTestsWithRemoteServer}
}
set l
} {4003 {} 1 4004 {} 1 4005 {} 1}
-test socket-11.9 {accept callback error} {socket doTestsWithRemoteServer} {
+test socket-11.9 {accept callback error} -constraints {
+ socket doTestsWithRemoteServer
+} -setup {
+ proc myHandler {msg options} {
+ variable x $msg
+ }
+ set handler [interp bgerror {}]
+ interp bgerror {} [namespace which myHandler]
+} -body {
set s [socket -server accept 2836]
proc accept {s a p} {expr 10 / 0}
- proc bgerror args {
- global x
- set x $args
- }
if {[catch {sendCommand {
set peername [fconfigure $callerSocket -peername]
set s [socket [lindex $peername 0] 2836]
@@ -1251,9 +1249,10 @@ test socket-11.9 {accept callback error} {socket doTestsWithRemoteServer} {
vwait x
after cancel $timer
close $s
- rename bgerror {}
set x
-} {{divide by zero}}
+} -cleanup {
+ interp bgerror {} $handler
+} -result {divide by zero}
test socket-11.10 {testing socket specific options} {socket doTestsWithRemoteServer} {
sendCommand {
set socket10_12_test_server [socket -server accept 2836]
@@ -1307,7 +1306,6 @@ test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
sendCommand {close $socket10_13_test_server}
list $spurious $len $done
} {0 2690 1}
-
test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
set counter 0
set done 0
@@ -1341,7 +1339,6 @@ test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
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} {
@@ -1420,7 +1417,7 @@ test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} {
set f [open $path(script2) w]
puts $f [list set tcltest [interpreter]]
puts -nonewline $f {
- set f [socket -server accept 0]
+ set f [socket -server accept -myaddr 127.0.0.1 0]
puts [lindex [fconfigure $f -sockname] 2]
proc accept { file addr port } {
close $file
@@ -1433,7 +1430,7 @@ test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} {
vwait forever
}
close $f
-
+
# Launch script2 and wait 5 seconds
### exec [interpreter] script2 &
@@ -1490,7 +1487,7 @@ test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} {
# Create the server socket
- set server [socket -server accept 0]
+ set server [socket -server accept -myaddr 127.0.0.1 0]
proc accept { file host port } {
# When the client connects, establish the read handler
global server
@@ -1556,7 +1553,7 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
set f [open $path(script2) w]
puts $f [list set tcltest [interpreter]]
puts -nonewline $f {
- set server [socket -server accept 0]
+ set server [socket -server accept -myaddr 127.0.0.1 0]
puts stdout [lindex [fconfigure $server -sockname] 2]
proc accept { file host port } }
puts $f \{
@@ -1568,7 +1565,7 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
puts $f {
after 1000 exit
}
- puts $f \}
+ puts $f \}
puts $f {
vwait forever
}
@@ -1617,7 +1614,7 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
}
return
}
-
+
vwait x
close $p
@@ -1625,37 +1622,33 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
} {accepted socket was not inherited}
test socket-13.1 {Testing use of shared socket between two threads} \
- -constraints {socket testthread} -setup {
-
+ -constraints {socket testthread} -setup {
threadReap
-
set path(script) [makeFile {
- set f [socket -server accept 0]
- set listen [lindex [fconfigure $f -sockname] 2]
- proc accept {s a p} {
+ set f [socket -server accept -myaddr 127.0.0.1 0]
+ set listen [lindex [fconfigure $f -sockname] 2]
+ proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
}
- proc echo {s} {
- global i
+ proc echo {s} {
+ global i
set l [gets $s]
if {[eof $s]} {
global x
close $s
set x done
- } else {
- incr i
+ } else {
+ incr i
puts $s $l
}
- }
- set i 0
- vwait x
- close $f
-
- # thread cleans itself up.
- testthread exit
+ }
+ set i 0
+ vwait x
+ close $f
+ # thread cleans itself up.
+ testthread exit
} script]
-
} -body {
# create a thread
set serverthread [testthread create [list source $path(script) ] ]
@@ -1668,8 +1661,8 @@ test socket-13.1 {Testing use of shared socket between two threads} \
fconfigure $s -buffering line
catch {
- puts $s "hello"
- gets $s result
+ puts $s "hello"
+ gets $s result
}
close $s
update
generated by cgit v0.12 at 2024-11-20 02:27:24 (GMT)