Keep most tests from making sockets that are reachable off the machine.

1 files changed, 27 insertions, 25 deletions

diff --git a/tests/io.test b/tests/io.test
index c940222..7d1933e 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: io.test,v 1.73 2006/11/03 00:34:52 hobbs Exp $
+# RCS: @(#) $Id: io.test,v 1.74 2006/11/03 11:45:34 dkf Exp $
 
 if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -2688,7 +2688,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
 	variable c
 	variable x
 	set l [gets $s]
-	
+
 	if {[eof $s]} {
 	    close $s
 	    set x done
@@ -2696,8 +2696,8 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
 	    incr c
 	}
     }
-    set ss [socket -server [namespace code accept] 0]
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set cs [socket 127.0.0.1 [lindex [fconfigure $ss -sockname] 2]]
     vwait [namespace which -variable x]
     fconfigure $cs -blocking off
     writelots $cs $l
@@ -2707,19 +2707,19 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
     set c
 } 2000
 test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} {
-    # On Mac, this test screws up sockets such that subsequent tests using port 2828 
+    # On Mac, this test screws up sockets such that subsequent tests using port 2828
     # either cause errors or panic().
-     
+
     catch {interp delete x}
     catch {interp delete y}
     interp create x
     interp create y
-    set s [socket -server [namespace code accept] 0]
+    set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     proc accept {s a p} {
 	puts $s hello
 	close $s
     }
-    set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
+    set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
     interp share {} $c x
     interp share {} $c y
     close $c
@@ -5030,7 +5030,7 @@ test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA}
 test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
 	{socket} {
     proc accept {s a p} {close $s}
-    set s1 [socket -server [namespace code accept] 0]
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $s1 -sockname] 2]
     set s2 [socket 127.0.0.1 $port]
     update
@@ -5043,7 +5043,7 @@ test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
 test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
 	{socket} {
     proc accept {s a p} {close $s}
-    set s1 [socket -server [namespace code accept] 0]
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $s1 -sockname] 2]
     set s2 [socket 127.0.0.1 $port]
     update
@@ -5056,7 +5056,7 @@ test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
 test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
 	{socket} {
     proc accept {s a p} {close $s}
-    set s1 [socket -server [namespace code accept] 0]
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $s1 -sockname] 2]
     set s2 [socket 127.0.0.1 $port]
     update
@@ -5069,7 +5069,7 @@ test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
 test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
 	{socket} {
     proc accept {s a p} {close $s}
-    set s1 [socket -server [namespace code accept] 0]
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $s1 -sockname] 2]
     set s2 [socket 127.0.0.1 $port]
     update
@@ -5106,7 +5106,7 @@ test io-39.22a {Tcl_SetChannelOption, invariance} {
 test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
         writeable, it should still have valid -eofchar and -translation options } {
     set l [list]
-    set sock [socket -server [namespace code accept] 0]
+    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
     close $sock
     set l
@@ -5114,7 +5114,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
 test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
         writable so we can't change -eofchar or -translation } {
     set l [list]
-    set sock [socket -server [namespace code accept] 0]
+    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     fconfigure $sock -eofchar D -translation lf
     lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
     close $sock
@@ -6391,27 +6391,29 @@ test io-51.1 {Test old socket deletion on Macintosh} {socket} {
 	close $s
 	set wait done
     }
-    set ss [socket -server [namespace code accept] 0]
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set port [lindex [fconfigure $ss -sockname] 2]
+
     variable wait ""
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket 127.0.0.1 $port]
     vwait [namespace which -variable wait]
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket 127.0.0.1 $port]
     vwait [namespace which -variable wait]
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket 127.0.0.1 $port]
     vwait [namespace which -variable wait]
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket 127.0.0.1 $port]
     vwait [namespace which -variable wait]
     lappend result [gets $cs]
     close $cs
@@ -6735,7 +6737,7 @@ proc FcopyTestDone {bytes {error {}}} {
 }
 test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
     variable fcopyTestDone
-    set listen [socket -server [namespace code FcopyTestAccept] 0]
+    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
     set in [open $thisScript]	;# 126 K
     set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
     catch {unset fcopyTestDone}
@@ -6838,14 +6840,14 @@ test io-54.1 {Recursive channel events} {socket fileevent} {
 	}
 	incr x
     }
-    set ss [socket -server [namespace code accept] 0]
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
 
     # We need to delay on some systems until the creation of the
     # server socket completes.
 
     set done 0
     for {set i 0} {$i < 10} {incr i} {
-	if {![catch {set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]}]} {
+	if {![catch {set cs [socket 127.0.0.1 [lindex [fconfigure $ss -sockname] 2]]}]} {
 	    set done 1
 	    break
 	}
@@ -6874,7 +6876,7 @@ test io-54.1 {Recursive channel events} {socket fileevent} {
 test io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} {
     set accept {}
     set after {}
-    variable s [socket -server [namespace code accept] 0]
+    variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     proc accept {s a p} {
 	variable counter
 	variable accept
@@ -6984,7 +6986,7 @@ test io-57.1 {buffered data and file events, gets} {fileevent} {
 	variable s2
 	set s2 $sock
     }
-    set server [socket -server [namespace code accept] 0]
+    set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
     variable s2
     vwait [namespace which -variable s2]
@@ -7007,7 +7009,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} {
 	variable s2
 	set s2 $sock
     }
-    set server [socket -server [namespace code accept] 0]
+    set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
     variable s2
     vwait [namespace which -variable s2]