Index: socket.test
===================================================================
RCS file: TclBase/src/tcl8.4.6/tests/socket.test,v
retrieving revision 1.1
diff -C3 -r1.1 socket.test
*** socket.test	30 Apr 2004 07:10:44 -0000	1.1
--- socket.test	14 May 2004 12:18:34 -0000
***************
*** 255,261 ****
      set f [open $path(script) w]
      puts $f {
  	set timer [after 10000 "set x timed_out"]
! 	set f [socket -server accept 0]
  	proc accept {file addr port} {
  	    global x
  	    set x done
--- 255,261 ----
      set f [open $path(script) w]
      puts $f {
  	set timer [after 10000 "set x timed_out"]
! 	set f [socket -server accept -myaddr 127.0.0.1 0]
  	proc accept {file addr port} {
  	    global x
  	    set x done
***************
*** 293,299 ****
      set f [open $path(script) w]
      puts $f {
  	set timer [after 10000 "set x timeout"]
!         set f [socket -server accept 0]
  	proc accept {file addr port} {
              global x
              puts "[gets $file] $port"
--- 293,299 ----
      set f [open $path(script) w]
      puts $f {
  	set timer [after 10000 "set x timeout"]
!         set f [socket -server accept -myaddr 127.0.0.1 0]
  	proc accept {file addr port} {
              global x
              puts "[gets $file] $port"
***************
*** 329,335 ****
      set f [open $path(script) w]
      puts $f {
  	set timer [after 2000 "set x done"]
!         set f [socket  -server accept 2830]
  	proc accept {file addr port} {
              global x
              puts "[gets $file] $addr"
--- 329,335 ----
      set f [open $path(script) w]
      puts $f {
  	set timer [after 2000 "set x done"]
!         set f [socket  -server accept -myaddr 127.0.0.1 2830]
  	proc accept {file addr port} {
              global x
              puts "[gets $file] $addr"
***************
*** 393,399 ****
      set f [open $path(script) w]
      puts $f {
  	set timer [after 10000 "set x timeout"]
!         set f [socket -server accept 0]
  	proc accept {file addr port} {
              global x
              puts "[gets $file]"
--- 393,399 ----
      set f [open $path(script) w]
      puts $f {
  	set timer [after 10000 "set x timeout"]
!         set f [socket -server accept -myaddr 127.0.0.1 0]
  	proc accept {file addr port} {
              global x
              puts "[gets $file]"
***************
*** 436,442 ****
      set f [open $path(script) w]
      puts $f {
  	set timer [after 10000 "set x timeout"]
! 	set f [socket -server accept 0]
  	proc accept {s a p} {
              fileevent $s readable [list echo $s]
  	    fconfigure $s -translation lf -buffering line
--- 436,442 ----
      set f [open $path(script) w]
      puts $f {
  	set timer [after 10000 "set x timeout"]
! 	set f [socket -server accept -myaddr 127.0.0.1 0]
  	proc accept {s a p} {
              fileevent $s readable [list echo $s]
  	    fconfigure $s -translation lf -buffering line
***************
*** 475,481 ****
  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]
              fconfigure $s -buffering line
--- 475,481 ----
  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 -myaddr 127.0.0.1 0]
  	proc accept {s a p} {
              fileevent $s readable [list echo $s]
              fconfigure $s -buffering line
***************
*** 523,532 ****
  set path(script) [makeFile {} script]
  #Interix (WinSocket) allows two server-connections on the same port
  test socket-2.9 {socket conflict} {socket stdio notInterix} {
!     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]"
      close $f
      set f [open "|[list [interpreter] $path(script)]" r]
      gets $f
--- 523,532 ----
  set path(script) [makeFile {} script]
  #Interix (WinSocket) allows two server-connections on the same port
  test socket-2.9 {socket conflict} {socket stdio notInterix} {
!     set s [socket -server accept -myaddr 127.0.0.1 0]
      file delete $path(script)
      set f [open $path(script) w]
!     puts -nonewline $f "socket -server accept -myaddr 127.0.0.1 [lindex [fconfigure $s -sockname] 2]"
      close $f
      set f [open "|[list [interpreter] $path(script)]" r]
      gets $f
***************
*** 540,546 ****
  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 0]
      proc accept {s a p} {
  	global ss
  	close $ss
--- 540,546 ----
  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 -myaddr [info hostname] 0]
      proc accept {s a p} {
  	global ss
  	close $ss
***************
*** 566,572 ****
  	set sock $s
      }
  
!     set s [socket -server accept 0]
      set sock ""
      set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
      vwait sock
--- 566,572 ----
  	set sock $s
      }
  
!     set s [socket -server accept -myaddr 127.0.0.1 0]
      set sock ""
      set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
      vwait sock
***************
*** 588,600 ****
      set result
  } {a:one b: c:two}
  
! 
! #Interix (WinSocket) allows two server-connections on the same port
  test socket-3.1 {socket conflict} {socket stdio notInterix} {
      file delete $path(script)
      set f [open $path(script) w]
      puts $f {
! 	set f [socket -server accept 0]
  	puts ready
  	puts [lindex [fconfigure $f -sockname] 2]
  	gets stdin
--- 588,599 ----
      set result
  } {a:one b: c:two}
  
! ##Interix (WinSocket) allows two server-connections on the same port
  test socket-3.1 {socket conflict} {socket stdio notInterix} {
      file delete $path(script)
      set f [open $path(script) w]
      puts $f {
! 	set f [socket -server accept -myaddr 127.0.0.1 0]
  	puts ready
  	puts [lindex [fconfigure $f -sockname] 2]
  	gets stdin
***************
*** 604,610 ****
      set f [open "|[list [interpreter] $path(script)]" r+]
      gets $f
      gets $f listen
!     set x [list [catch {socket -server accept $listen} msg] \
  		$msg]
      puts $f bye
      close $f
--- 603,609 ----
      set f [open "|[list [interpreter] $path(script)]" r+]
      gets $f
      gets $f listen
!     set x [list [catch {socket -server accept -myaddr 127.0.0.1 $listen} msg] \
  		$msg]
      puts $f bye
      close $f
***************
*** 618,624 ****
  	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]
  	proc accept {s a p} {
  	    fileevent $s readable [list echo $s]
  	    fconfigure $s -buffering line
--- 617,623 ----
  	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]
  	proc accept {s a p} {
  	    fileevent $s readable [list echo $s]
  	    fconfigure $s -buffering line
***************
*** 709,715 ****
      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 listen [lindex [fconfigure $s -sockname] 2]
      puts $p1 $listen
      puts $p2 $listen
--- 708,714 ----
      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 listen [lindex [fconfigure $s -sockname] 2]
      puts $p1 $listen
      puts $p2 $listen
***************
*** 786,792 ****
  	set x $args
      }
      proc accept {s a p} {expr 10 / 0}
!     set s [socket -server accept 0]
      puts $f [lindex [fconfigure $s -sockname] 2]
      close $f
      set timer [after 10000 "set x timed_out"]
--- 785,791 ----
  	set x $args
      }
      proc accept {s a p} {expr 10 / 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"]
***************
*** 801,807 ****
      file delete $path(script)
      set f [open $path(script) w]
      puts $f {
! 	set ss [socket -server accept 0]
  	proc accept args {
  	    global x
  	    set x done
--- 800,806 ----
      file delete $path(script)
      set f [open $path(script) w]
      puts $f {
! 	set ss [socket -server accept -myaddr 127.0.0.1 0]
  	proc accept args {
  	    global x
  	    set x done
***************
*** 829,835 ****
      file delete $path(script)
      set f [open $path(script) w]
      puts $f {
! 	set ss [socket -server accept 2821]
  	proc accept args {
  	    global x
  	    set x done
--- 828,834 ----
      file delete $path(script)
      set f [open $path(script) w]
      puts $f {
! 	set ss [socket -server accept -myaddr 127.0.0.1 2821]
  	proc accept args {
  	    global x
  	    set x done
***************
*** 853,866 ****
  	    [expr {[lindex $p 2] == $listen}]
  } {3 1 0}
  test socket-7.3 {testing socket specific options} {socket} {
!     set s [socket -server accept 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]
      proc accept {s a p} {
  	global x
  	set x [fconfigure $s -sockname]
--- 852,865 ----
  	    [expr {[lindex $p 2] == $listen}]
  } {3 1 0}
  test socket-7.3 {testing socket specific options} {socket} {
!     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 -myaddr [info hostname] 0]
      proc accept {s a p} {
  	global x
  	set x [fconfigure $s -sockname]
***************
*** 877,883 ****
      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 0]
      proc accept {s a p} {
  	global x
  	set x [fconfigure $s -sockname]
--- 876,882 ----
      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 -myaddr 127.0.0.1 0]
      proc accept {s a p} {
  	global x
  	set x [fconfigure $s -sockname]
***************
*** 909,915 ****
      # 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]
      proc accept {s a p} {
  	global x
  	puts $s bye
--- 908,914 ----
      # 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 -myaddr [info hostname] 0]
      proc accept {s a p} {
  	global x
  	puts $s bye
***************
*** 946,952 ****
  	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]]
      puts -nonewline $c 01234567890123456789012345678901234567890123456789
      close $c
--- 945,951 ----
  	fconfigure $s -buffering none -blocking off
  	fileevent $s readable [list readlittle $s]
      }
!     set s [socket -server accept -myaddr [info hostname] 0]
      set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
      puts -nonewline $c 01234567890123456789012345678901234567890123456789
      close $c
***************
*** 963,969 ****
      for {set i 0} {$i < 16} {incr i} {
  	set secondblock "b$secondblock$secondblock"
      }
!     set l [socket -server accept 0]
      proc accept {s a p} {
  	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
  		-buffering line
--- 962,968 ----
      for {set i 0} {$i < 16} {incr i} {
  	set secondblock "b$secondblock$secondblock"
      }
!     set l [socket -server accept -myaddr [info hostname] 0]
      proc accept {s a p} {
  	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
  		-buffering line
***************
*** 1034,1040 ****
  	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]]
      fconfigure $c -blocking off -buffering line -translation lf
      fileevent $c readable "count_to_eof $c"
--- 1033,1039 ----
  	fconfigure $s -buffering line -translation lf
  	fileevent $s writable "write_then_close $s"
      }
!     set s [socket -server accept -myaddr [info hostname] 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"
***************
*** 1049,1055 ****
  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]
      proc accept {s a p} {close $s; error}
      set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
      vwait goterror
--- 1048,1054 ----
  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 -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
***************
*** 1426,1432 ****
      set f [open $path(script2) w]
      puts $f [list set tcltest [interpreter]]
      puts -nonewline $f {
! 	set f [socket -server accept 0]
  	puts [lindex [fconfigure $f -sockname] 2]
  	proc accept { file addr port } {
  	    close $file
--- 1425,1431 ----
      set f [open $path(script2) w]
      puts $f [list set tcltest [interpreter]]
      puts -nonewline $f {
! 	set f [socket -server accept -myaddr 127.0.0.1 0]
  	puts [lindex [fconfigure $f -sockname] 2]
  	proc accept { file addr port } {
  	    close $file
***************
*** 1496,1502 ****
  
      # Create the server socket
  
!     set server [socket -server accept 0]
      proc accept { file host port } {
  	# When the client connects, establish the read handler
  	global server
--- 1495,1501 ----
  
      # Create the server socket
  
!     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
***************
*** 1562,1568 ****
      set f [open $path(script2) w]
      puts $f [list set tcltest [interpreter]]
      puts -nonewline $f {
! 	set server [socket -server accept 0]
  	puts stdout [lindex [fconfigure $server -sockname] 2]
  	proc accept { file host port } }
      puts $f \{
--- 1561,1567 ----
      set f [open $path(script2) w]
      puts $f [list set tcltest [interpreter]]
      puts -nonewline $f {
! 	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 \{
***************
*** 1637,1643 ****
      threadReap
  
      makeFile {
! 	set f [socket -server accept 0]
  	set listen [lindex [fconfigure $f -sockname] 2]
  	proc accept {s a p} {
              fileevent $s readable [list echo $s]
--- 1636,1642 ----
      threadReap
  
      makeFile {
! 	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]
