Attachment "socket.patch" to
ticket [953920ffff]
added by
aotto1968
2004-05-14 19:28:56.
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 [email protected]. 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 [email protected]. 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]
