summaryrefslogtreecommitdiffstats
path: root/tests/socket.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/socket.test')
-rw-r--r--tests/socket.test64
1 files changed, 33 insertions, 31 deletions
diff --git a/tests/socket.test b/tests/socket.test
index 1f95749..3719b0f 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -10,7 +10,7 @@
# 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.26 2002/07/10 11:56:45 dgp Exp $
+# RCS: @(#) $Id: socket.test,v 1.27 2003/10/07 21:45:39 dgp Exp $
# Running socket tests with a remote server:
# ------------------------------------------
@@ -246,7 +246,7 @@ test socket-1.12 {arg parsing for socket command} {socket} {
set path(script) [makeFile {} script]
test socket-2.1 {tcp connection} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set timer [after 10000 "set x timed_out"]
@@ -284,7 +284,7 @@ if [info exists port] {
set port [expr 2048 + [pid]%1024]
}
test socket-2.2 {tcp connection with client port specified} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set timer [after 10000 "set x timeout"]
@@ -320,7 +320,7 @@ test socket-2.2 {tcp connection with client port specified} {socket stdio} {
set x
} [list ready "hello $port"]
test socket-2.3 {tcp connection with client interface specified} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set timer [after 2000 "set x done"]
@@ -351,7 +351,7 @@ test socket-2.3 {tcp connection with client interface specified} {socket stdio}
set x
} {ready {hello 127.0.0.1}}
test socket-2.4 {tcp connection with server interface specified} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set timer [after 2000 "set x done"]
@@ -384,7 +384,7 @@ test socket-2.4 {tcp connection with server interface specified} {socket stdio}
set x
} {ready hello}
test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set timer [after 10000 "set x timeout"]
@@ -427,7 +427,7 @@ test socket-2.6 {tcp connection} {socket} {
set status
} ok
test socket-2.7 {echo server, one line} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set timer [after 10000 "set x timeout"]
@@ -467,8 +467,9 @@ test socket-2.7 {echo server, one line} {socket stdio} {
close $f
list $x $y
} {{hello abcdefghijklmnop} done}
-test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
- makeFile {
+removeFile script
+test socket-2.8 {echo server, loop 50 times, single connection} -constraints {socket stdio} -setup {
+ set path(script) [makeFile {
set f [socket -server accept 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
@@ -494,7 +495,8 @@ test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
after cancel $timer
close $f
puts "done $i"
- } script
+ } script]
+} -body {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
@@ -510,10 +512,13 @@ test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
catch {set x [gets $f]}
close $f
set x
-} {done 50}
+} -cleanup {
+ removeFile script
+} -result {done 50}
+set path(script) [makeFile {} script]
test socket-2.9 {socket conflict} {socket stdio} {
set s [socket -server accept 0]
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
close $f
@@ -579,7 +584,7 @@ test socket-2.11 {detecting new data} {socket} {
test socket-3.1 {socket conflict} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set f [socket -server accept 0]
@@ -599,7 +604,7 @@ test socket-3.1 {socket conflict} {socket stdio} {
set x
} {1 {couldn't open socket: address already in use}}
test socket-3.2 {server with several clients} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set t1 [after 30000 "set x timed_out"]
@@ -659,7 +664,7 @@ test socket-3.2 {server with several clients} {socket stdio} {
} {ready done}
test socket-4.1 {server with several clients} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set port [gets stdin]
@@ -759,7 +764,7 @@ test socket-5.3 {byte order problems, socket numbers, htons} \
} {couldn't open socket: not owner}
test socket-6.1 {accept callback error} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
gets stdin port
@@ -784,7 +789,7 @@ test socket-6.1 {accept callback error} {socket stdio} {
} {{divide by zero}}
test socket-7.1 {testing socket specific options} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set ss [socket -server accept 0]
@@ -812,7 +817,7 @@ test socket-7.1 {testing socket specific options} {socket stdio} {
lappend l [llength $p]
} {0 0 3}
test socket-7.2 {testing socket specific options} {socket stdio} {
- removeFile script
+ file delete $path(script)
set f [open $path(script) w]
puts $f {
set ss [socket -server accept 2821]
@@ -1391,8 +1396,8 @@ set path(script1) [makeFile {} script1]
set path(script2) [makeFile {} script2]
test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} {
- removeFile script1
- removeFile script2
+ file delete $path(script1)
+ file delete $path(script2)
# Script1 is just a 10 second delay. If the server socket
# is inherited, it will be held open for 10 seconds
@@ -1441,14 +1446,12 @@ test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} {
set x {server socket was inherited}
}
- removeFile script1
- removeFile script2
close $p
set x
} {server socket was not inherited}
test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} {
- removeFile script1
- removeFile script2
+ file delete $path(script1)
+ file delete $path(script2)
# Script1 is just a 20 second delay. If the server socket
# is inherited, it will be held open for 10 seconds
@@ -1528,14 +1531,12 @@ test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} {
if {!$failed} {
vwait failed
}
- removeFile script1
- removeFile script2
close $p
set x
} {client socket was not inherited}
test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
- removeFile script1
- removeFile script2
+ file delete $path(script1)
+ file delete $path(script2)
set f [open $path(script1) w]
puts $f {
@@ -1605,8 +1606,6 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
vwait x
- removeFile script1
- removeFile script2
close $p
set x
} {accepted socket was not inherited}
@@ -1614,7 +1613,7 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
test socket-13.1 {Testing use of shared socket between two threads} \
{socket testthread} {
- removeFile script
+ file delete $path(script1)
threadReap
makeFile {
@@ -1668,6 +1667,9 @@ test socket-13.1 {Testing use of shared socket between two threads} \
} {hello 1}
+removeFile script1
+removeFile script2
+
# cleanup
if {[string match sock* $commandSocket] == 1} {
puts $commandSocket exit