? unix/lin-build
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.593
diff -u -r1.593 ChangeLog
--- ChangeLog	2001/09/10 17:17:41	1.593
+++ ChangeLog	2001/09/10 21:43:14
@@ -1,5 +1,19 @@
 2001-09-10  Andreas Kupries <andreas_kupries@users.sourceforge.net>
 
+	* The changes below are a partial fix for [21925].
+
+	* tests/socket.test: Removed _most_ instances of hardwired port
+	  numbers for listening sockets. Remaining are the ports in all
+	  tests with constraint 'doTestsWithRemoteServer'. These seem to
+	  be designed for a more controlled environment and are uusually
+	  skipped when running the testsuite. Also left the instances in
+	  the tests 12.[123] and 13.1. More thought is required on how to
+	  communicate the port number between server and client in these
+	  tests.
+
+	* tests/io.test: Removed all instances of hardwired port numbers
+	  for listening sockets.
+
 	* generic/tclInt.decls: Also added 'TclWinFlushDirtyChannels' to
 	  the internal platform specific stub table.
 
Index: tests/all.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/all.tcl,v
retrieving revision 1.12
diff -u -r1.12 all.tcl
--- tests/all.tcl	2000/10/24 22:30:35	1.12
+++ tests/all.tcl	2001/09/10 21:43:14
@@ -13,6 +13,8 @@
 set tcltestVersion [package require tcltest]
 namespace import -force tcltest::*
 
+tcltest::matchFiles socket.test
+
 tcltest::testsDirectory [file dir [info script]]
 tcltest::runAllTests
 
Index: tests/io.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/io.test,v
retrieving revision 1.20
diff -u -r1.20 io.test
--- tests/io.test	2001/07/31 19:12:07	1.20
+++ tests/io.test	2001/09/10 21:43:14
@@ -2653,8 +2653,8 @@
 	    incr c
 	}
     }
-    set ss [socket -server accept 2828]
-    set cs [socket [info hostname] 2828]
+    set ss [socket -server accept 0]
+    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
     vwait x
     fconfigure $cs -blocking off
     writelots $cs $l
@@ -2671,12 +2671,12 @@
     catch {interp delete y}
     interp create x
     interp create y
-    set s [socket -server accept 2828]
+    set s [socket -server accept 0]
     proc accept {s a p} {
 	puts $s hello
 	close $s
     }
-    set c [socket [info hostname] 2828]
+    set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
     interp share {} $c x
     interp share {} $c y
     close $c
@@ -6232,27 +6232,27 @@
 	close $s
 	set wait done
     }
-    set ss [socket -server accept 2831]
+    set ss [socket -server accept 0]
     set wait ""
-    set cs [socket [info hostname] 2831]
+    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
     vwait wait
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] 2831]
+    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
     vwait wait
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] 2831]
+    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
     vwait wait
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] 2831]
+    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
     vwait wait
     lappend result [gets $cs]
     close $cs
@@ -6579,9 +6579,9 @@
 }
 
 test io-53.5 {CopyData: error during fcopy} {socket} {
-    set listen [socket -server FcopyTestAccept 2828]
+    set listen [socket -server FcopyTestAccept 0]
     set in [open $thisScript]	;# 126 K
-    set out [socket 127.0.0.1 2828]
+    set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
     catch {unset fcopyTestDone}
     close $listen	;# This means the socket open never really succeeds
     fcopy $in $out -command FcopyTestDone
@@ -6630,14 +6630,14 @@
 	}
 	incr x
     }
-    set ss [socket -server accept 2828]
+    set ss [socket -server accept 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] 2828]}]} {
+	if {![catch {set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]}]} {
 	    set done 1
 	    break
 	}
@@ -6665,7 +6665,7 @@
 test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
     set accept {}
     set after {}
-    set s [socket -server accept 3939]
+    set s [socket -server accept 0]
     proc accept {s a p} {
 	global counter accept
 
@@ -6693,9 +6693,9 @@
 	set accept {}
     }
     proc producer {} {
-	global writer
+	global writer s
 
-	set writer [socket 127.0.0.1 3939]
+	set writer [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
 	fconfigure $writer -buffering line
 	puts -nonewline $writer hello
 	flush $writer
@@ -6756,8 +6756,8 @@
     proc accept {sock args} {
 	set ::s2 $sock
     }
-    set server [socket -server accept 4040]
-    set s [socket 127.0.0.1 4040]
+    set server [socket -server accept 0]
+    set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
     vwait s2
     update
     fileevent $s2 readable {lappend result readable}
@@ -6777,8 +6777,8 @@
     proc accept {sock args} {
 	set ::s2 $sock
     }
-    set server [socket -server accept 4041]
-    set s [socket 127.0.0.1 4041]
+    set server [socket -server accept 0]
+    set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
     vwait s2
     update
     fileevent $s2 readable {lappend result readable}
Index: tests/socket.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/socket.test,v
retrieving revision 1.16
diff -u -r1.16 socket.test
--- tests/socket.test	2000/09/21 00:58:30	1.16
+++ tests/socket.test	2001/09/10 21:43:15
@@ -250,13 +250,14 @@
     set f [open script w]
     puts $f {
 	set timer [after 2000 "set x timed_out"]
-	set f [socket -server accept 2828]
+	set f [socket -server accept 0]
 	proc accept {file addr port} {
 	    global x
 	    set x done
             close $file
 	}
 	puts ready
+	puts [lindex [fconfigure $f -sockname] 2]
 	vwait x
 	after cancel $timer
 	close $f
@@ -265,7 +266,8 @@
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f x
-    if {[catch {socket 127.0.0.1 2828} msg]} {
+    gets $f listen
+    if {[catch {socket 127.0.0.1 $listen} msg]} {
         set x $msg
     } else {
         lappend x [gets $f]
@@ -286,7 +288,7 @@
     set f [open script w]
     puts $f {
 	set timer [after 2000 "set x done"]
-        set f [socket -server accept 2829]
+        set f [socket -server accept 0]
 	proc accept {file addr port} {
             global x
             puts "[gets $file] $port"
@@ -294,6 +296,7 @@
             set x done
 	}
 	puts ready
+	puts [lindex [fconfigure $f -sockname] 2]
 	vwait x
 	after cancel $timer
 	close $f
@@ -301,10 +304,11 @@
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f x
+    gets $f listen
     global port
-    if {[catch {socket -myport $port 127.0.0.1 2829} sock]} {
+    if {[catch {socket -myport $port 127.0.0.1 $listen} sock]} {
         set x $sock
-	close [socket 127.0.0.1 2829]
+	close [socket 127.0.0.1 $listen]
 	puts stderr $sock
     } else {
         puts $sock hello
@@ -351,7 +355,7 @@
     set f [open script w]
     puts $f {
 	set timer [after 2000 "set x done"]
-        set f [socket -server accept -myaddr [info hostname] 2831]
+        set f [socket -server accept -myaddr [info hostname] 0]
 	proc accept {file addr port} {
             global x
             puts "[gets $file]"
@@ -359,6 +363,7 @@
             set x done
 	}
 	puts ready
+	puts [lindex [fconfigure $f -sockname] 2]
 	vwait x
 	after cancel $timer
 	close $f
@@ -366,7 +371,8 @@
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f x
-    if {[catch {socket [info hostname] 2831} sock]} {
+    gets $f listen
+    if {[catch {socket [info hostname] $listen} sock]} {
         set x $sock
     } else {
         puts $sock hello
@@ -382,7 +388,7 @@
     set f [open script w]
     puts $f {
 	set timer [after 2000 "set x done"]
-        set f [socket -server accept 2832]
+        set f [socket -server accept 0]
 	proc accept {file addr port} {
             global x
             puts "[gets $file]"
@@ -390,6 +396,7 @@
             set x done
 	}
 	puts ready
+	puts [lindex [fconfigure $f -sockname] 2]
 	vwait x
 	after cancel $timer
 	close $f
@@ -397,7 +404,8 @@
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f x
-    if {[catch {socket 127.0.0.1 2832} sock]} {
+    gets $f listen
+    if {[catch {socket 127.0.0.1 $listen} sock]} {
         set x $sock
     } else {
         puts $sock hello
@@ -423,7 +431,7 @@
     set f [open script w]
     puts $f {
 	set timer [after 2000 "set x done"]
-	set f [socket -server accept 2834]
+	set f [socket -server accept 0]
 	proc accept {s a p} {
             fileevent $s readable [list echo $s]
 	    fconfigure $s -translation lf -buffering line
@@ -439,6 +447,7 @@
              }
 	}
 	puts ready
+	puts [lindex [fconfigure $f -sockname] 2]
 	vwait x
 	after cancel $timer
 	close $f
@@ -447,7 +456,8 @@
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f
-    set s [socket 127.0.0.1 2834]
+    gets $f listen
+    set s [socket 127.0.0.1 $listen]
     fconfigure $s -buffering line -translation lf
     puts $s "hello abcdefghijklmnop"
     after 1000
@@ -459,7 +469,7 @@
 } {{hello abcdefghijklmnop} done}
 test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
     makeFile {
-	set f [socket -server accept 2835]
+	set f [socket -server accept 0]
 	proc accept {s a p} {
             fileevent $s readable [list echo $s]
             fconfigure $s -buffering line
@@ -478,6 +488,7 @@
 	}
 	set i 0
 	puts ready
+	puts [lindex [fconfigure $f -sockname] 2]
 	set timer [after 20000 "set x done"]
 	vwait x
 	after cancel $timer
@@ -486,7 +497,8 @@
     } script
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f
-    set s [socket 127.0.0.1 2835]
+    gets $f listen
+    set s [socket 127.0.0.1 $listen]
     fconfigure $s -buffering line
     catch {
 	for {set x 0} {$x < 50} {incr x} {
@@ -500,25 +512,24 @@
     set x
 } {done 50}
 test socket-2.9 {socket conflict} {socket stdio} {
-    set s [socket -server accept 2828]
+    set s [socket -server accept 0]
     removeFile script
     set f [open script w]
-    puts -nonewline $f {socket -server accept 2828}
+    puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f
     after 100
-    set x [list [catch {close $f} msg] $msg]
+    set x [list [catch {close $f} msg]]
+    regsub "\n.*$" $msg {} msg ; # cut part of the error message containing the port number
+    lappend x $msg
     close $s
     set x
-} {1 {couldn't open socket: address already in use
-    while executing
-"socket -server accept 2828"
-    (file "script" line 1)}}
+} {1 {couldn't open socket: address already in use}}
 test socket-2.10 {close on accept, accepted socket lives} {socket} {
     set done 0
     set timer [after 20000 "set done timed_out"]
-    set ss [socket -server accept 2830]
+    set ss [socket -server accept 0]
     proc accept {s a p} {
 	global ss
 	close $ss
@@ -531,7 +542,7 @@
 	close $s
 	set done 1
     }
-    set cs [socket [info hostname] 2830]
+    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
     puts $cs hello
     close $cs
     vwait done
@@ -544,9 +555,9 @@
 	set sock $s
     }
 
-    set s [socket -server accept 2400]
+    set s [socket -server accept 0]
     set sock ""
-    set s2 [socket 127.0.0.1 2400]
+    set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
     vwait sock
     puts $s2 one
     flush $s2
@@ -571,15 +582,17 @@
     removeFile script
     set f [open script w]
     puts $f {
-	set f [socket -server accept 2828]
+	set f [socket -server accept 0]
 	puts ready
+	puts [lindex [fconfigure $f -sockname] 2]
 	gets stdin
 	close $f
     }
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r+]
     gets $f
-    set x [list [catch {socket -server accept 2828} msg] \
+    gets $f listen
+    set x [list [catch {socket -server accept $listen} msg] \
 		$msg]
     puts $f bye
     close $f
@@ -593,7 +606,7 @@
 	set t2 [after 31000 "set x timed_out"]
 	set t3 [after 32000 "set x timed_out"]
 	set counter 0
-	set s [socket -server accept 2828]
+	set s [socket -server accept 0]
 	proc accept {s a p} {
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line
@@ -609,6 +622,7 @@
              }
 	}
 	puts ready
+	puts [lindex [fconfigure $s -sockname] 2]
 	vwait x
 	after cancel $t1
 	vwait x
@@ -621,11 +635,12 @@
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r+]
     set x [gets $f]
-    set s1 [socket 127.0.0.1 2828]
+    gets $f listen
+    set s1 [socket 127.0.0.1 $listen]
     fconfigure $s1 -buffering line
-    set s2 [socket 127.0.0.1 2828]
+    set s2 [socket 127.0.0.1 $listen]
     fconfigure $s2 -buffering line
-    set s3 [socket 127.0.0.1 2828]
+    set s3 [socket 127.0.0.1 $listen]
     fconfigure $s3 -buffering line
     for {set i 0} {$i < 100} {incr i} {
 	puts $s1 hello,s1
@@ -647,8 +662,8 @@
     removeFile script
     set f [open script w]
     puts $f {
-	gets stdin
-	set s [socket 127.0.0.1 2828]
+	set port [gets stdin]
+	set s [socket 127.0.0.1 $port]
 	fconfigure $s -buffering line
 	for {set i 0} {$i < 100} {incr i} {
 	    puts $s hello
@@ -682,10 +697,11 @@
     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 2828]
-    puts $p1 open
-    puts $p2 open
-    puts $p3 open
+    set s [socket -server accept 0]
+    set listen [lindex [fconfigure $s -sockname] 2]
+    puts $p1 $listen
+    puts $p2 $listen
+    puts $p3 $listen
     vwait x
     vwait x
     vwait x
@@ -746,8 +762,8 @@
     removeFile script
     set f [open script w]
     puts $f {
-	gets stdin
-	socket 127.0.0.1 2848
+	gets stdin port
+	socket 127.0.0.1 $port
     }
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r+]
@@ -756,8 +772,8 @@
 	set x $args
     }
     proc accept {s a p} {expr 10 / 0}
-    set s [socket -server accept 2848]
-    puts $f hello
+    set s [socket -server accept 0]
+    puts $f [lindex [fconfigure $s -sockname] 2]
     close $f
     set timer [after 10000 "set x timed_out"]
     vwait x
@@ -771,12 +787,13 @@
     removeFile script
     set f [open script w]
     puts $f {
-	socket -server accept 2820
+	set ss [socket -server accept 0]
 	proc accept args {
 	    global x
 	    set x done
 	}
 	puts ready
+	puts [lindex [fconfigure $ss -sockname] 2]
 	set timer [after 10000 "set x timed_out"]
 	vwait x
 	after cancel $timer
@@ -784,25 +801,27 @@
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f
-    set s [socket 127.0.0.1 2820]
+    gets $f listen
+    set s [socket 127.0.0.1 $listen]
     set p [fconfigure $s -peername]
     close $s
     close $f
     set l ""
     lappend l [string compare [lindex $p 0] 127.0.0.1]
-    lappend l [string compare [lindex $p 2] 2820]
+    lappend l [string compare [lindex $p 2] $listen]
     lappend l [llength $p]
 } {0 0 3}
 test socket-7.2 {testing socket specific options} {socket stdio} {
     removeFile script
     set f [open script w]
     puts $f {
-	socket -server accept 2821
+	set ss [socket -server accept 2821]
 	proc accept args {
 	    global x
 	    set x done
 	}
 	puts ready
+	puts [lindex [fconfigure $ss -sockname] 2]
 	set timer [after 10000 "set x timed_out"]
 	vwait x
 	after cancel $timer
@@ -810,54 +829,57 @@
     close $f
     set f [open "|[list $::tcltest::tcltest script]" r]
     gets $f
-    set s [socket 127.0.0.1 2821]
+    gets $f listen
+    set s [socket 127.0.0.1 $listen]
     set p [fconfigure $s -sockname]
     close $s
     close $f
     set l ""
     lappend l [llength $p]
     lappend l [lindex $p 0]
-    lappend l [expr [lindex $p 2] == 2821]
+    lappend l [expr [lindex $p 2] == $listen]
 } {3 127.0.0.1 0}
 test socket-7.3 {testing socket specific options} {socket} {
-    set s [socket -server accept 2822]
+    set s [socket -server accept 0]
     set l [fconfigure $s]
     close $s
     update
     llength $l
 } 12
 test socket-7.4 {testing socket specific options} {socket} {
-    set s [socket -server accept 2823]
+    set s [socket -server accept 0]
     proc accept {s a p} {
 	global x
 	set x [fconfigure $s -sockname]
 	close $s
     }
-    set s1 [socket [info hostname] 2823]
+    set listen [lindex [fconfigure $s -sockname] 2]
+    set s1 [socket [info hostname] $listen]
     set timer [after 10000 "set x timed_out"]
     vwait x
     after cancel $timer
     close $s
     close $s1
     set l ""
-    lappend l [lindex $x 2] [llength $x]
-} {2823 3}
+    lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
+} {1 3}
 test socket-7.5 {testing socket specific options} {socket unixOrPc} {
-    set s [socket -server accept 2829]
+    set s [socket -server accept 0]
     proc accept {s a p} {
 	global x
 	set x [fconfigure $s -sockname]
 	close $s
     }
-    set s1 [socket 127.0.0.1 2829]
+    set listen [lindex [fconfigure $s -sockname] 2]
+    set s1 [socket 127.0.0.1 $listen]
     set timer [after 10000 "set x timed_out"]
     vwait x
     after cancel $timer
     close $s
     close $s1
     set l ""
-    lappend l [lindex $x 0] [lindex $x 2] [llength $x]
-} {127.0.0.1 2829 3}
+    lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]
+} {127.0.0.1 1 3}
 
 test socket-8.1 {testing -async flag on sockets} {socket} {
     # NOTE: This test may fail on some Solaris 2.4 systems. If it does,
@@ -874,14 +896,14 @@
     # 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 2830]
+    set s [socket -server accept 0]
     proc accept {s a p} {
 	global x
 	puts $s bye
 	close $s
 	set x done
     }
-    set s1 [socket -async [info hostname] 2830]
+    set s1 [socket -async [info hostname] [lindex [fconfigure $s -sockname] 2]]
     vwait x
     set z [gets $s1]
     close $s
@@ -911,8 +933,8 @@
 	fconfigure $s -buffering none -blocking off
 	fileevent $s readable [list readlittle $s]
     }
-    set s [socket -server accept 2831]
-    set c [socket [info hostname] 2831]
+    set s [socket -server accept 0]
+    set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
     puts -nonewline $c 01234567890123456789012345678901234567890123456789
     close $c
     set timer [after 10000 "set done timed_out"]
@@ -928,7 +950,7 @@
     for {set i 0} {$i < 16} {incr i} {
 	set secondblock "b$secondblock$secondblock"
     }
-    set l [socket -server accept 2832]
+    set l [socket -server accept 0]
     proc accept {s a p} {
 	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
 		-buffering line
@@ -949,7 +971,7 @@
 	puts -nonewline $s $secondblock
 	close $s
     }
-    set s [socket [info hostname] 2832]
+    set s [socket [info hostname] [lindex [fconfigure $l -sockname] 2]]
     fconfigure $s -blocking 0 -trans lf -buffering line
     set count 0
     puts $s hello
@@ -999,8 +1021,8 @@
 	fconfigure $s -buffering line -translation lf
 	fileevent $s writable "write_then_close $s"
     }
-    set s [socket -server accept 2833]
-    set c [socket [info hostname] 2833]
+    set s [socket -server accept 0]
+    set c [socket [info hostname] [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]
@@ -1014,9 +1036,9 @@
 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 2898]
+    set s [socket -server accept 0]
     proc accept {s a p} {close $s; error}
-    set c [socket 127.0.0.1 2898]
+    set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
     vwait goterror
     close $s
     close $c
