summaryrefslogtreecommitdiffstats
path: root/tests/socket.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/socket.test')
-rw-r--r--tests/socket.test326
1 files changed, 172 insertions, 154 deletions
diff --git a/tests/socket.test b/tests/socket.test
index 6e92afd..0538b28 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.44 2010/09/28 15:13:55 rmax Exp $
+# RCS: @(#) $Id: socket.test,v 1.45 2010/11/04 15:40:08 rmax Exp $
# Running socket tests with a remote server:
# ------------------------------------------
@@ -92,13 +92,23 @@ if {![info exists remoteServerPort]} {
}
}
+foreach {af localhost} {
+ any 127.0.0.1
+ inet 127.0.0.1
+ inet6 ::1
+} {
+ set ::tcl::unsupported::socketAF $af
+ # Check if the family is supported and set the constraint accordingly
+ testConstraint supported_$af [expr {![catch {socket -server foo 0} sock]}]
+ catch {close $sock}
+
#
# Check if we're supposed to do tests against the remote server
#
set doTestsWithRemoteServer 1
if {![info exists remoteServerIP]} {
- set remoteServerIP 127.0.0.1
+ set remoteServerIP $localhost
}
if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {
set remoteServerPort [randport]
@@ -123,7 +133,7 @@ if {$doTestsWithRemoteServer} {
set noRemoteTestReason "can't exec"
set doTestsWithRemoteServer 0
} else {
- set remoteServerIP 127.0.0.1
+ set remoteServerIP $localhost
# 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]] \
@@ -198,52 +208,52 @@ proc getPort sock {
# ----------------------------------------------------------------------
-test socket-1.1 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server
} -returnCodes error -result {no argument given for -server option}
-test socket-1.2 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo
} -returnCodes error -result {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} -constraints socket -body {
+test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myaddr
} -returnCodes error -result {no argument given for -myaddr option}
-test socket-1.4 {arg parsing for socket command} -constraints socket -body {
- socket -myaddr 127.0.0.1
+test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+ socket -myaddr $localhost
} -returnCodes error -result {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} -constraints socket -body {
+test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myport
} -returnCodes error -result {no argument given for -myport option}
-test socket-1.6 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myport xxxx
} -returnCodes error -result {expected integer but got "xxxx"}
-test socket-1.7 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myport 2522
} -returnCodes error -result {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} -constraints socket -body {
+test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -froboz
} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, or -server}
-test socket-1.9 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo -myport 2521 3333
} -returnCodes error -result {option -myport is not valid for servers}
-test socket-1.10 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket host 2528 -junk
} -returnCodes error -result {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} -constraints socket -body {
+test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server callback 2520 --
} -returnCodes error -result {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} -constraints socket -body {
+test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket foo badport
} -returnCodes error -result {expected integer but got "badport"}
-test socket-1.13 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -async -server
} -returnCodes error -result {cannot set -async option for server sockets}
-test socket-1.14 {arg parsing for socket command} -constraints socket -body {
+test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo -async
} -returnCodes error -result {cannot set -async option for server sockets}
set path(script) [makeFile {} script]
-test socket-2.1 {tcp connection} -constraints {socket stdio} -setup {
+test socket_$af-2.1 {tcp connection} -constraints [list socket stdio supported_$af] -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -267,14 +277,14 @@ test socket-2.1 {tcp connection} -constraints {socket stdio} -setup {
gets $f listen
} -body {
# $x == "ready" at this point
- set sock [socket 127.0.0.1 $listen]
+ set sock [socket $localhost $listen]
lappend x [gets $f]
close $sock
lappend x [gets $f]
} -cleanup {
close $f
} -result {ready done {}}
-test socket-2.2 {tcp connection with client port specified} -setup {
+test socket_$af-2.2 {tcp connection with client port specified} -setup {
set port [randport]
file delete $path(script)
set f [open $path(script) w]
@@ -297,19 +307,19 @@ test socket-2.2 {tcp connection with client port specified} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
-} -constraints {socket stdio} -body {
+} -constraints [list socket stdio supported_$af] -body {
# $x == "ready" at this point
- set sock [socket -myport $port 127.0.0.1 $listen]
+ set sock [socket -myport $port $localhost $listen]
puts $sock hello
flush $sock
lappend x [expr {[gets $f] eq "hello $port"}]
close $sock
return $x
} -cleanup {
- catch {close [socket 127.0.0.1 $listen]}
+ catch {close [socket $localhost $listen]}
close $f
} -result {ready 1}
-test socket-2.3 {tcp connection with client interface specified} -setup {
+test socket_$af-2.3 {tcp connection with client interface specified} -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -331,9 +341,9 @@ test socket-2.3 {tcp connection with client interface specified} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f listen
gets $f x
-} -constraints {socket stdio} -body {
+} -constraints [list socket stdio supported_$af] -body {
# $x == "ready" at this point
- set sock [socket -myaddr 127.0.0.1 127.0.0.1 $listen]
+ set sock [socket -myaddr $localhost $localhost $listen]
puts $sock hello
flush $sock
lappend x [gets $f]
@@ -341,13 +351,14 @@ test socket-2.3 {tcp connection with client interface specified} -setup {
return $x
} -cleanup {
close $f
-} -result {ready {hello 127.0.0.1}}
-test socket-2.4 {tcp connection with server interface specified} -setup {
+} -result [list ready [list hello $localhost]]
+test socket_$af-2.4 {tcp connection with server interface specified} -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept -myaddr 127.0.0.1 0]
+ set f [socket -server accept -myaddr $localhost 0]
proc accept {file addr port} {
global x
puts "[gets $file]"
@@ -364,9 +375,9 @@ test socket-2.4 {tcp connection with server interface specified} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
-} -constraints {socket stdio} -body {
+} -constraints [list socket stdio supported_$af] -body {
# $x == "ready" at this point
- set sock [socket 127.0.0.1 $listen]
+ set sock [socket $localhost $listen]
puts $sock hello
flush $sock
lappend x [gets $f]
@@ -375,7 +386,7 @@ test socket-2.4 {tcp connection with server interface specified} -setup {
} -cleanup {
close $f
} -result {ready hello}
-test socket-2.5 {tcp connection with redundant server port} -setup {
+test socket_$af-2.5 {tcp connection with redundant server port} -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -397,9 +408,9 @@ test socket-2.5 {tcp connection with redundant server port} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
gets $f listen
-} -constraints {socket stdio} -body {
+} -constraints [list socket stdio supported_$af] -body {
# $x == "ready" at this point
- set sock [socket 127.0.0.1 $listen]
+ set sock [socket $localhost $listen]
puts $sock hello
flush $sock
lappend x [gets $f]
@@ -408,9 +419,9 @@ test socket-2.5 {tcp connection with redundant server port} -setup {
} -cleanup {
close $f
} -result {ready hello}
-test socket-2.6 {tcp connection} -constraints socket -body {
+test socket_$af-2.6 {tcp connection} -constraints [list socket supported_$af] -body {
set status ok
- if {![catch {set sock [socket 127.0.0.1 [randport]]}]} {
+ if {![catch {set sock [socket $localhost [randport]]}]} {
if {![catch {gets $sock}]} {
set status broken
}
@@ -418,7 +429,7 @@ test socket-2.6 {tcp connection} -constraints socket -body {
}
set status
} -result ok
-test socket-2.7 {echo server, one line} -constraints {socket stdio} -setup {
+test socket_$af-2.7 {echo server, one line} -constraints [list socket stdio supported_$af] -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -450,7 +461,7 @@ test socket-2.7 {echo server, one line} -constraints {socket stdio} -setup {
gets $f
gets $f listen
} -body {
- set s [socket 127.0.0.1 $listen]
+ set s [socket $localhost $listen]
fconfigure $s -buffering line -translation lf
puts $s "hello abcdefghijklmnop"
after 1000
@@ -461,7 +472,7 @@ test socket-2.7 {echo server, one line} -constraints {socket stdio} -setup {
close $f
} -result {{hello abcdefghijklmnop} done}
removeFile script
-test socket-2.8 {echo server, loop 50 times, single connection} -setup {
+test socket_$af-2.8 {echo server, loop 50 times, single connection} -setup {
set path(script) [makeFile {
set f [socket -server accept 0]
proc accept {s a p} {
@@ -492,8 +503,8 @@ test socket-2.8 {echo server, loop 50 times, single connection} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
-} -constraints {socket stdio} -body {
- set s [socket 127.0.0.1 $listen]
+} -constraints [list socket stdio supported_$af] -body {
+ set s [socket $localhost $listen]
fconfigure $s -buffering line
catch {
for {set x 0} {$x < 50} {incr x} {
@@ -509,11 +520,12 @@ test socket-2.8 {echo server, loop 50 times, single connection} -setup {
removeFile script
} -result {done 50}
set path(script) [makeFile {} script]
-test socket-2.9 {socket conflict} -constraints {socket stdio} -body {
+test socket_$af-2.9 {socket conflict} -constraints [list socket stdio supported_$af] -body {
set s [socket -server accept 0]
file delete $path(script)
set f [open $path(script) w]
- puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
+ puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF]
+ puts $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
close $f
set f [open "|[list [interpreter] $path(script)]" r]
gets $f
@@ -522,10 +534,10 @@ test socket-2.9 {socket conflict} -constraints {socket stdio} -body {
} -returnCodes error -cleanup {
close $s
} -match glob -result {couldn't open socket: address already in use*}
-test socket-2.10 {close on accept, accepted socket lives} -setup {
+test socket_$af-2.10 {close on accept, accepted socket lives} -setup {
set done 0
set timer [after 20000 "set done timed_out"]
-} -constraints socket -body {
+} -constraints [list socket supported_$af] -body {
set ss [socket -server accept 0]
proc accept {s a p} {
global ss
@@ -539,7 +551,7 @@ test socket-2.10 {close on accept, accepted socket lives} -setup {
close $s
set done 1
}
- set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ set cs [socket $localhost [lindex [fconfigure $ss -sockname] 2]]
puts $cs hello
close $cs
vwait done
@@ -547,7 +559,7 @@ test socket-2.10 {close on accept, accepted socket lives} -setup {
} -cleanup {
after cancel $timer
} -result 1
-test socket-2.11 {detecting new data} -constraints socket -setup {
+test socket_$af-2.11 {detecting new data} -constraints [list socket supported_$af] -setup {
proc accept {s a p} {
global sock
set sock $s
@@ -555,7 +567,7 @@ test socket-2.11 {detecting new data} -constraints socket -setup {
set s [socket -server accept 0]
set sock ""
} -body {
- set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]]
vwait sock
puts $s2 one
flush $s2
@@ -576,11 +588,12 @@ test socket-2.11 {detecting new data} -constraints socket -setup {
close $sock
} -result {a:one b: c:two}
-test socket-3.1 {socket conflict} -constraints {socket stdio} -setup {
+test socket_$af-3.1 {socket conflict} -constraints [list socket stdio supported_$af] -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
- set f [socket -server accept -myaddr 127.0.0.1 0]
+ set f [socket -server accept -myaddr $localhost 0]
puts ready
puts [lindex [fconfigure $f -sockname] 2]
gets stdin
@@ -591,20 +604,21 @@ test socket-3.1 {socket conflict} -constraints {socket stdio} -setup {
gets $f
gets $f listen
} -body {
- socket -server accept -myaddr 127.0.0.1 $listen
+ socket -server accept -myaddr $localhost $listen
} -cleanup {
puts $f bye
close $f
} -returnCodes error -result {couldn't open socket: address already in use}
-test socket-3.2 {server with several clients} -setup {
+test socket_$af-3.2 {server with several clients} -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
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 counter 0
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
@@ -634,13 +648,13 @@ test socket-3.2 {server with several clients} -setup {
set f [open "|[list [interpreter] $path(script)]" r+]
set x [gets $f]
gets $f listen
-} -constraints {socket stdio} -body {
+} -constraints [list socket stdio supported_$af] -body {
# $x == "ready" here
- set s1 [socket 127.0.0.1 $listen]
+ set s1 [socket $localhost $listen]
fconfigure $s1 -buffering line
- set s2 [socket 127.0.0.1 $listen]
+ set s2 [socket $localhost $listen]
fconfigure $s2 -buffering line
- set s3 [socket 127.0.0.1 $listen]
+ set s3 [socket $localhost $listen]
fconfigure $s3 -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s1 hello,s1
@@ -658,12 +672,13 @@ test socket-3.2 {server with several clients} -setup {
close $f
} -result {ready done}
-test socket-4.1 {server with several clients} -setup {
+test socket_$af-4.1 {server with several clients} -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
set port [gets stdin]
- set s [socket 127.0.0.1 $port]
+ set s [socket $localhost $port]
fconfigure $s -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s hello
@@ -680,7 +695,7 @@ test socket-4.1 {server with several clients} -setup {
fconfigure $p2 -buffering line
set p3 [open "|[list [interpreter] $path(script)]" r+]
fconfigure $p3 -buffering line
-} -constraints {socket stdio} -body {
+} -constraints [list socket stdio supported_$af] -body {
proc accept {s a p} {
fconfigure $s -buffering line
fileevent $s readable [list echo $s]
@@ -698,7 +713,7 @@ test socket-4.1 {server with several clients} -setup {
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 -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
set listen [lindex [fconfigure $s -sockname] 2]
puts $p1 $listen
puts $p2 $listen
@@ -722,34 +737,34 @@ test socket-4.1 {server with several clients} -setup {
close $p2
close $p3
} -result {{p1 bye done} {p2 bye done} {p3 bye done}}
-test socket-4.2 {byte order problems, socket numbers, htons} -body {
- close [socket -server dodo -myaddr 127.0.0.1 0x3000]
+test socket_$af-4.2 {byte order problems, socket numbers, htons} -body {
+ close [socket -server dodo -myaddr $localhost 0x3000]
return ok
-} -constraints socket -result ok
+} -constraints [list socket supported_$af] -result ok
-test socket-5.1 {byte order problems, socket numbers, htons} -body {
+test socket_$af-5.1 {byte order problems, socket numbers, htons} -body {
if {![catch {socket -server dodo 0x1} msg]} {
close $msg
return {htons problem, should be disallowed, are you running as SU?}
}
return {couldn't open socket: not owner}
-} -constraints {socket unix notRoot} -result {couldn't open socket: not owner}
-test socket-5.2 {byte order problems, socket numbers, htons} -body {
+} -constraints [list socket unix notRoot supported_$af] -result {couldn't open socket: not owner}
+test socket_$af-5.2 {byte order problems, socket numbers, htons} -body {
if {![catch {socket -server dodo 0x10000} msg]} {
close $msg
return {port resolution problem, should be disallowed}
}
return {couldn't open socket: port number too high}
-} -constraints socket -result {couldn't open socket: port number too high}
-test socket-5.3 {byte order problems, socket numbers, htons} -body {
+} -constraints [list socket supported_$af] -result {couldn't open socket: port number too high}
+test socket_$af-5.3 {byte order problems, socket numbers, htons} -body {
if {![catch {socket -server dodo 21} msg]} {
close $msg
return {htons problem, should be disallowed, are you running as SU?}
}
return {couldn't open socket: not owner}
-} -constraints {socket unix notRoot} -result {couldn't open socket: not owner}
+} -constraints [list socket unix notRoot supported_$af] -result {couldn't open socket: not owner}
-test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
+test socket_$af-6.1 {accept callback error} -constraints [list socket stdio supported_$af] -setup {
proc myHandler {msg options} {
variable x $msg
}
@@ -758,14 +773,15 @@ test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
file delete $path(script)
} -body {
set f [open $path(script) w]
+ puts $f [list set localhost $localhost]
puts $f {
gets stdin port
- socket 127.0.0.1 $port
+ socket $localhost $port
}
close $f
set f [open "|[list [interpreter] $path(script)]" r+]
proc accept {s a p} {expr 10 / 0}
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
puts $f [lindex [fconfigure $s -sockname] 2]
close $f
set timer [after 10000 "set x timed_out"]
@@ -777,7 +793,7 @@ test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
interp bgerror {} $handler
} -result {divide by zero}
-test socket-7.1 {testing socket specific options} -setup {
+test socket_$af-7.1 {testing socket specific options} -setup {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -797,19 +813,20 @@ test socket-7.1 {testing socket specific options} -setup {
gets $f
gets $f listen
set l ""
-} -constraints {socket stdio} -body {
- set s [socket 127.0.0.1 $listen]
+} -constraints [list socket stdio supported_$af] -body {
+ set s [socket $localhost $listen]
set p [fconfigure $s -peername]
close $s
- lappend l [string compare [lindex $p 0] 127.0.0.1]
+ lappend l [string compare [lindex $p 0] $localhost]
lappend l [string compare [lindex $p 2] $listen]
lappend l [llength $p]
} -cleanup {
close $f
} -result {0 0 3}
-test socket-7.2 {testing socket specific options} -setup {
+test socket_$af-7.2 {testing socket specific options} -setup {
file delete $path(script)
set f [open $path(script) w]
+ puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF]
puts $f {
set ss [socket -server accept 0]
proc accept args {
@@ -826,35 +843,35 @@ test socket-7.2 {testing socket specific options} -setup {
set f [open "|[list [interpreter] $path(script)]" r]
gets $f
gets $f listen
-} -constraints {socket stdio} -body {
- set s [socket 127.0.0.1 $listen]
+} -constraints [list socket stdio supported_$af] -body {
+ set s [socket $localhost $listen]
set p [fconfigure $s -sockname]
close $s
list [llength $p] \
- [regexp {^(127\.0\.0\.1|0\.0\.0\.0)$} [lindex $p 0]] \
+ [regexp {^(127\.0\.0\.1|0\.0\.0\.0|::1)$} [lindex $p 0]] \
[expr {[lindex $p 2] == $listen}]
} -cleanup {
close $f
} -result {3 1 0}
-test socket-7.3 {testing socket specific options} -constraints socket -body {
- set s [socket -server accept -myaddr 127.0.0.1 0]
+test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body {
+ set s [socket -server accept -myaddr $localhost 0]
set l [fconfigure $s]
close $s
update
llength $l
} -result 14
-test socket-7.4 {testing socket specific options} -constraints socket -setup {
+test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
set timer [after 10000 "set x timed_out"]
set l ""
} -body {
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 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 127.0.0.1 $listen]
+ set s1 [socket $localhost $listen]
vwait x
lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
} -cleanup {
@@ -862,10 +879,10 @@ test socket-7.4 {testing socket specific options} -constraints socket -setup {
close $s
close $s1
} -result {1 3}
-test socket-7.5 {testing socket specific options} -setup {
+test socket_$af-7.5 {testing socket specific options} -setup {
set timer [after 10000 "set x timed_out"]
set l ""
-} -constraints {socket unixOrPc} -body {
+} -constraints [list socket unixOrPc supported_$af] -body {
set s [socket -server accept 0]
proc accept {s a p} {
global x
@@ -873,16 +890,16 @@ test socket-7.5 {testing socket specific options} -setup {
close $s
}
set listen [lindex [fconfigure $s -sockname] 2]
- set s1 [socket 127.0.0.1 $listen]
+ set s1 [socket $localhost $listen]
vwait x
lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]
} -cleanup {
after cancel $timer
close $s
close $s1
-} -result {127.0.0.1 1 3}
+} -result [list $localhost 1 3]
-test socket-8.1 {testing -async flag on sockets} -constraints socket -body {
+test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body {
# NOTE: This test may fail on some Solaris 2.4 systems. If it does, check
# that you have these patches installed (using showrev -p):
#
@@ -897,14 +914,14 @@ test socket-8.1 {testing -async flag on sockets} -constraints socket -body {
# 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 -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {
global x
puts $s bye
close $s
set x done
}
- set s1 [socket -async 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set s1 [socket -async $localhost [lindex [fconfigure $s -sockname] 2]]
vwait x
gets $s1
} -cleanup {
@@ -912,7 +929,7 @@ test socket-8.1 {testing -async flag on sockets} -constraints socket -body {
close $s1
} -result bye
-test socket-9.1 {testing spurious events} -constraints socket -setup {
+test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
set len 0
set spurious 0
set done 0
@@ -936,8 +953,8 @@ test socket-9.1 {testing spurious events} -constraints socket -setup {
fconfigure $s -buffering none -blocking off
fileevent $s readable [list readlittle $s]
}
- set s [socket -server accept -myaddr 127.0.0.1 0]
- set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set s [socket -server accept -myaddr $localhost 0]
+ set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
puts -nonewline $c 01234567890123456789012345678901234567890123456789
close $c
vwait done
@@ -946,7 +963,7 @@ test socket-9.1 {testing spurious events} -constraints socket -setup {
} -cleanup {
after cancel $timer
} -result {0 50}
-test socket-9.2 {testing async write, fileevents, flush on close} -constraints socket -setup {
+test socket_$af-9.2 {testing async write, fileevents, flush on close} -constraints [list socket supported_$af] -setup {
set firstblock ""
for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
set secondblock ""
@@ -954,7 +971,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} -constraints s
set secondblock "b$secondblock$secondblock"
}
set timer [after 10000 "set done timed_out"]
- set l [socket -server accept -myaddr 127.0.0.1 0]
+ set l [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {
fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-buffering line
@@ -976,7 +993,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} -constraints s
close $s
}
} -body {
- set s [socket 127.0.0.1 [lindex [fconfigure $l -sockname] 2]]
+ set s [socket $localhost [lindex [fconfigure $l -sockname] 2]]
fconfigure $s -blocking 0 -trans lf -buffering line
set count 0
puts $s hello
@@ -996,7 +1013,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} -constraints s
close $l
after cancel $timer
} -result 65566
-test socket-9.3 {testing EOF stickyness} -constraints socket -setup {
+test socket_$af-9.3 {testing EOF stickyness} -constraints [list socket supported_$af] -setup {
set count 0
set done false
proc write_then_close {s} {
@@ -1007,7 +1024,7 @@ test socket-9.3 {testing EOF stickyness} -constraints socket -setup {
fconfigure $s -buffering line -translation lf
fileevent $s writable "write_then_close $s"
}
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
} -body {
proc count_to_eof {s} {
global count done
@@ -1027,7 +1044,7 @@ test socket-9.3 {testing EOF stickyness} -constraints socket -setup {
set count {timer went off, eof is not sticky}
close $s
}
- set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set c [socket $localhost [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 $c]
@@ -1040,9 +1057,8 @@ test socket-9.3 {testing EOF stickyness} -constraints socket -setup {
removeFile script
-test socket-10.1 {testing socket accept callback error handling} -constraints {
- socket
-} -setup {
+test socket_$af-10.1 {testing socket accept callback error handling} \
+ -constraints [list socket supported_$af] -setup {
variable goterror 0
proc myHandler {msg options} {
variable goterror 1
@@ -1050,9 +1066,9 @@ test socket-10.1 {testing socket accept callback error handling} -constraints {
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
} -body {
- set s [socket -server accept -myaddr 127.0.0.1 0]
+ set s [socket -server accept -myaddr $localhost 0]
proc accept {s a p} {close $s; error}
- set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+ set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
vwait goterror
close $s
close $c
@@ -1061,7 +1077,7 @@ test socket-10.1 {testing socket accept callback error handling} -constraints {
interp bgerror {} $handler
} -result 1
-test socket-11.1 {tcp connection} -setup {
+test socket_$af-11.1 {tcp connection} -setup {
set port [sendCommand {
set server [socket -server accept 0]
proc accept {s a p} {
@@ -1070,14 +1086,14 @@ test socket-11.1 {tcp connection} -setup {
}
getPort $server
}]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
set s [socket $remoteServerIP $port]
gets $s
} -cleanup {
close $s
sendCommand {close $server}
} -result done
-test socket-11.2 {client specifies its port} -setup {
+test socket_$af-11.2 {client specifies its port} -setup {
set lport [randport]
set rport [sendCommand {
set server [socket -server accept 0]
@@ -1087,7 +1103,7 @@ test socket-11.2 {client specifies its port} -setup {
}
getPort $server
}]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
set s [socket -myport $lport $remoteServerIP $rport]
set r [gets $s]
expr {$r==$lport ? "ok" : "broken: $r != $port"}
@@ -1095,7 +1111,7 @@ test socket-11.2 {client specifies its port} -setup {
close $s
sendCommand {close $server}
} -result ok
-test socket-11.3 {trying to connect, no server} -body {
+test socket_$af-11.3 {trying to connect, no server} -body {
set status ok
if {![catch {set s [socket $remoteServerIp [randport]]}]} {
if {![catch {gets $s}]} {
@@ -1104,8 +1120,8 @@ test socket-11.3 {trying to connect, no server} -body {
close $s
}
return $status
-} -constraints {socket doTestsWithRemoteServer} -result ok
-test socket-11.4 {remote echo, one line} -setup {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -result ok
+test socket_$af-11.4 {remote echo, one line} -setup {
set port [sendCommand {
set server [socket -server accept 0]
proc accept {s a p} {
@@ -1122,7 +1138,7 @@ test socket-11.4 {remote echo, one line} -setup {
}
getPort $server
}]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
set f [socket $remoteServerIP $port]
fconfigure $f -translation crlf -buffering line
puts $f hello
@@ -1131,7 +1147,7 @@ test socket-11.4 {remote echo, one line} -setup {
catch {close $f}
sendCommand {close $server}
} -result hello
-test socket-11.5 {remote echo, 50 lines} -setup {
+test socket_$af-11.5 {remote echo, 50 lines} -setup {
set port [sendCommand {
set server [socket -server accept 0]
proc accept {s a p} {
@@ -1148,7 +1164,7 @@ test socket-11.5 {remote echo, 50 lines} -setup {
}
getPort $server
}]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
set f [socket $remoteServerIP $port]
fconfigure $f -translation crlf -buffering line
for {set cnt 0} {$cnt < 50} {incr cnt} {
@@ -1162,15 +1178,15 @@ test socket-11.5 {remote echo, 50 lines} -setup {
close $f
sendCommand {close $server}
} -result 50
-test socket-11.6 {socket conflict} -setup {
- set s1 [socket -server accept -myaddr 127.0.0.1 0]
-} -constraints {socket doTestsWithRemoteServer} -body {
- set s2 [socket -server accept -myaddr 127.0.0.1 [getPort $s1]]
+test socket_$af-11.6 {socket conflict} -setup {
+ set s1 [socket -server accept -myaddr $localhost 0]
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
+ set s2 [socket -server accept -myaddr $localhost [getPort $s1]]
list [getPort $s2] [close $s2]
} -cleanup {
close $s1
} -returnCodes error -result {couldn't open socket: address already in use}
-test socket-11.7 {server with several clients} -setup {
+test socket_$af-11.7 {server with several clients} -setup {
set port [sendCommand {
set server [socket -server accept 0]
proc accept {s a p} {
@@ -1187,7 +1203,7 @@ test socket-11.7 {server with several clients} -setup {
}
getPort $server
}]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
set s1 [socket $remoteServerIP $port]
fconfigure $s1 -buffering line
set s2 [socket $remoteServerIP $port]
@@ -1209,7 +1225,7 @@ test socket-11.7 {server with several clients} -setup {
close $s3
sendCommand {close $server}
} -result 100
-test socket-11.8 {client with several servers} -setup {
+test socket_$af-11.8 {client with several servers} -setup {
lassign [sendCommand {
set s1 [socket -server "accept server1" 0]
set s2 [socket -server "accept server2" 0]
@@ -1220,7 +1236,7 @@ test socket-11.8 {client with several servers} -setup {
}
list [getPort $s1] [getPort $s2] [getPort $s3]
}] p1 p2 p3
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
set s1 [socket $remoteServerIP $p1]
set s2 [socket $remoteServerIP $p2]
set s3 [socket $remoteServerIP $p3]
@@ -1236,9 +1252,7 @@ test socket-11.8 {client with several servers} -setup {
close $s3
}
} -result {server1 {} 1 server2 {} 1 server3 {} 1}
-test socket-11.9 {accept callback error} -constraints {
- socket doTestsWithRemoteServer
-} -setup {
+test socket_$af-11.9 {accept callback error} -constraints [list socket doTestsWithRemoteServer supported_$af] -setup {
proc myHandler {msg options} {
variable x $msg
}
@@ -1266,13 +1280,13 @@ test socket-11.9 {accept callback error} -constraints {
after cancel $timer
interp bgerror {} $handler
} -result {divide by zero}
-test socket-11.10 {testing socket specific options} -setup {
+test socket_$af-11.10 {testing socket specific options} -setup {
set port [sendCommand {
set server [socket -server accept 0]
proc accept {s a p} {close $s}
getPort $server
}]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
set s [socket $remoteServerIP $port]
set p [fconfigure $s -peername]
set n [fconfigure $s -sockname]
@@ -1281,7 +1295,7 @@ test socket-11.10 {testing socket specific options} -setup {
close $s
sendCommand {close $server}
} -result {1 3 3}
-test socket-11.11 {testing spurious events} -setup {
+test socket_$af-11.11 {testing spurious events} -setup {
set port [sendCommand {
set server [socket -server accept 0]
proc accept {s a p} {
@@ -1300,7 +1314,7 @@ test socket-11.11 {testing spurious events} -setup {
set spurious 0
set done 0
set timer [after 40000 "set done timed_out"]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
proc readlittle {s} {
global spurious done len
set l [read $s 1]
@@ -1323,7 +1337,7 @@ test socket-11.11 {testing spurious events} -setup {
after cancel $timer
sendCommand {close $server}
} -result {0 2690 1}
-test socket-11.12 {testing EOF stickyness} -constraints {socket doTestsWithRemoteServer} -setup {
+test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket doTestsWithRemoteServer supported_$af] -setup {
set counter 0
set done 0
set port [sendCommand {
@@ -1359,7 +1373,7 @@ test socket-11.12 {testing EOF stickyness} -constraints {socket doTestsWithRemot
after cancel $after_id
sendCommand {close $server}
} -result {EOF is sticky}
-test socket-11.13 {testing async write, async flush, async close} -setup {
+test socket_$af-11.13 {testing async write, async flush, async close} -setup {
set port [sendCommand {
set firstblock ""
for {set i 0} {$i < 5} {incr i} {
@@ -1393,7 +1407,7 @@ test socket-11.13 {testing async write, async flush, async close} -setup {
getPort $l
}]
set timer [after 10000 "set done timed_out"]
-} -constraints {socket doTestsWithRemoteServer} -body {
+} -constraints [list socket doTestsWithRemoteServer supported_$af] -body {
proc readit {s} {
global count done
set l [read $s]
@@ -1418,7 +1432,7 @@ test socket-11.13 {testing async write, async flush, async close} -setup {
set path(script1) [makeFile {} script1]
set path(script2) [makeFile {} script2]
-test socket-12.1 {testing inheritance of server sockets} -setup {
+test socket_$af-12.1 {testing inheritance of server sockets} -setup {
file delete $path(script1)
file delete $path(script2)
# Script1 is just a 10 second delay. If the server socket is inherited, it
@@ -1434,8 +1448,9 @@ test socket-12.1 {testing inheritance of server sockets} -setup {
set f [open $path(script2) w]
puts $f [list set tcltest [interpreter]]
puts $f [list set delay $path(script1)]
+ puts $f [list set localhost $localhost]
puts $f {
- set f [socket -server accept -myaddr 127.0.0.1 0]
+ set f [socket -server accept -myaddr $localhost 0]
puts [lindex [fconfigure $f -sockname] 2]
proc accept { file addr port } {
close $file
@@ -1446,7 +1461,7 @@ test socket-12.1 {testing inheritance of server sockets} -setup {
vwait forever
}
close $f
-} -constraints {socket stdio exec} -body {
+} -constraints [list socket stdio exec supported_$af] -body {
# Launch script2 and wait 5 seconds
### exec [interpreter] script2 &
set p [open "|[list [interpreter] $path(script2)]" r]
@@ -1454,7 +1469,7 @@ test socket-12.1 {testing inheritance of server sockets} -setup {
after 5000 { set ok_to_proceed 1 }
vwait ok_to_proceed
# If we can still connect to the server, the socket got inherited.
- if {[catch {close [socket 127.0.0.1 $listen]}]} {
+ if {[catch {close [socket $localhost $listen]}]} {
return {server socket was not inherited}
} else {
return {server socket was inherited}
@@ -1462,7 +1477,7 @@ test socket-12.1 {testing inheritance of server sockets} -setup {
} -cleanup {
close $p
} -result {server socket was not inherited}
-test socket-12.2 {testing inheritance of client sockets} -setup {
+test socket_$af-12.2 {testing inheritance of client sockets} -setup {
file delete $path(script1)
file delete $path(script2)
# Script1 is just a 20 second delay. If the server socket is inherited, it
@@ -1479,9 +1494,10 @@ test socket-12.2 {testing inheritance of client sockets} -setup {
set f [open $path(script2) w]
puts $f [list set tcltest [interpreter]]
puts $f [list set delay $path(script1)]
+ puts $f [list set localhost $localhost]
puts $f {
gets stdin port
- set f [socket 127.0.0.1 $port]
+ set f [socket $localhost $port]
exec $tcltest $delay &
puts $f testing
flush $f
@@ -1493,9 +1509,9 @@ test socket-12.2 {testing inheritance of client sockets} -setup {
# must have inherited the client.
set failed 0
after 10000 [list set failed 1]
-} -constraints {socket stdio exec} -body {
+} -constraints [list socket stdio exec supported_$af] -body {
# Create the server socket
- set server [socket -server accept -myaddr 127.0.0.1 0]
+ set server [socket -server accept -myaddr $localhost 0]
proc accept { file host port } {
# When the client connects, establish the read handler
global server
@@ -1536,7 +1552,7 @@ test socket-12.2 {testing inheritance of client sockets} -setup {
}
close $p
} -result {client socket was not inherited}
-test socket-12.3 {testing inheritance of accepted sockets} -setup {
+test socket_$af-12.3 {testing inheritance of accepted sockets} -setup {
file delete $path(script1)
file delete $path(script2)
set f [open $path(script1) w]
@@ -1548,8 +1564,9 @@ test socket-12.3 {testing inheritance of accepted sockets} -setup {
set f [open $path(script2) w]
puts $f [list set tcltest [interpreter]]
puts $f [list set delay $path(script1)]
+ puts $f [list set localhost $localhost]
puts $f {
- set server [socket -server accept -myaddr 127.0.0.1 0]
+ set server [socket -server accept -myaddr $localhost 0]
puts stdout [lindex [fconfigure $server -sockname] 2]
proc accept { file host port } {
global tcltest delay
@@ -1560,7 +1577,7 @@ test socket-12.3 {testing inheritance of accepted sockets} -setup {
vwait forever
}
close $f
-} -constraints {socket stdio exec} -body {
+} -constraints [list socket stdio exec supported_$af] -body {
# Launch the script2 process and connect to it. See how long the socket
# stays open
## exec [interpreter] script2 &
@@ -1568,7 +1585,7 @@ test socket-12.3 {testing inheritance of accepted sockets} -setup {
gets $p listen
after 1000 set ok_to_proceed 1
vwait ok_to_proceed
- set f [socket 127.0.0.1 $listen]
+ set f [socket $localhost $listen]
fconfigure $f -buffering full -blocking 0
fileevent $f readable [list getdata $f]
# If the socket is still open after 5 seconds, the script1 process must
@@ -1604,10 +1621,10 @@ test socket-12.3 {testing inheritance of accepted sockets} -setup {
catch {close $p}
} -result {accepted socket was not inherited}
-test socket-13.1 {Testing use of shared socket between two threads} -setup {
+test socket_$af-13.1 {Testing use of shared socket between two threads} -setup {
threadReap
- set path(script) [makeFile {
- set f [socket -server accept -myaddr 127.0.0.1 0]
+ set path(script) [makeFile [string map [list @localhost@ $localhost] {
+ set f [socket -server accept -myaddr @localhost@ 0]
set listen [lindex [fconfigure $f -sockname] 2]
proc accept {s a p} {
fileevent $s readable [list echo $s]
@@ -1630,15 +1647,15 @@ test socket-13.1 {Testing use of shared socket between two threads} -setup {
close $f
# thread cleans itself up.
testthread exit
- } script]
-} -constraints {socket testthread} -body {
+ }] script]
+} -constraints [list socket testthread supported_$af] -body {
# create a thread
set serverthread [testthread create [list source $path(script) ] ]
update
set port [testthread send $serverthread {set listen}]
update
after 1000
- set s [socket 127.0.0.1 $port]
+ set s [socket $localhost $port]
fconfigure $s -buffering line
catch {
puts $s "hello"
@@ -1665,6 +1682,7 @@ catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
+}
return
# Local Variables:
generated by cgit v0.12 at 2024-12-27 13:16:07 (GMT)