Attachment "tests.patch" to
ticket [954014ffff]
added by
aotto1968
2004-05-14 21:51:32.
Index: clock.test
===================================================================
RCS file: TclBase/src/tcl8.4.6/tests/clock.test,v
retrieving revision 1.1
diff -C3 -r1.1 clock.test
*** clock.test 30 Apr 2004 07:10:40 -0000 1.1
--- clock.test 14 May 2004 11:07:07 -0000
***************
*** 202,207 ****
--- 202,210 ----
set time [clock scan "19921023T000000"]
clock format $time -format {%b %d, %Y %H:%M:%S}
} "Oct 23, 1992 00:00:00"
+ test clock-4.19 {clock scan, clock format output} {
+ clock scan [clock format [clock seconds]]
+ } [clock seconds]
# CLOCK SCAN REAL TESTS
# We use 5am PST, 31-12-1999 as the base for these scans because irrespective
***************
*** 459,464 ****
--- 462,469 ----
# It's hard-coded to check P[SD]T now. (8 hours)
set c [expr {$b-$a}]
} {28800}
+
+
# cleanup
::tcltest::cleanupTests
Index: http.test
===================================================================
RCS file: TclBase/src/tcl8.4.6/tests/http.test,v
retrieving revision 1.1
diff -C3 -r1.1 http.test
*** http.test 30 Apr 2004 07:10:41 -0000 1.1
--- http.test 14 May 2004 14:41:19 -0000
***************
*** 52,58 ****
# Ensure httpd file exists
! set origFile [file join $::tcltest::testsDirectory httpd]
set httpdFile [file join [temporaryDirectory] httpd_[pid]]
if {![file exists $httpdFile]} {
makeFile "" $httpdFile
--- 52,65 ----
# Ensure httpd file exists
! ## BUG!! aotto1968.sf.net
! ## if I start the test with "./tclsh ../tests/tcltest.test" from an other
! ## directory as the "tests" directory the "::tcltest::testsDirectory" points
! ## to the current directory and !not! to the "tests" directory
!
! set origFile [file join $::tcltest::testsDirectory \
! [file dirname [file normalize [info script]]] \
! httpd]
set httpdFile [file join [temporaryDirectory] httpd_[pid]]
if {![file exists $httpdFile]} {
makeFile "" $httpdFile
Index: ioCmd.test
===================================================================
RCS file: TclBase/src/tcl8.4.6/tests/ioCmd.test,v
retrieving revision 1.1
diff -C3 -r1.1 ioCmd.test
*** ioCmd.test 30 Apr 2004 07:10:41 -0000 1.1
--- ioCmd.test 14 May 2004 14:39:22 -0000
***************
*** 272,278 ****
proc iocmdSSETUP {} {
uplevel {
! set srv [socket -server iocmdSRV 0]
set port [lindex [fconfigure $srv -sockname] 2]
proc iocmdSRV {sock ip port} {close $sock}
set cli [socket 127.0.0.1 $port]
--- 272,278 ----
proc iocmdSSETUP {} {
uplevel {
! set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $srv -sockname] 2]
proc iocmdSRV {sock ip port} {close $sock}
set cli [socket 127.0.0.1 $port]
Index: io.test
===================================================================
RCS file: TclBase/src/tcl8.4.6/tests/io.test,v
retrieving revision 1.1
diff -C3 -r1.1 io.test
*** io.test 30 Apr 2004 07:10:41 -0000 1.1
--- io.test 14 May 2004 14:18:01 -0000
***************
*** 2711,2717 ****
incr c
}
}
! set ss [socket -server [namespace code accept] 0]
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
vwait [namespace which -variable x]
fconfigure $cs -blocking off
--- 2711,2717 ----
incr c
}
}
! set ss [socket -server [namespace code accept] -myaddr [info hostname] 0]
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
vwait [namespace which -variable x]
fconfigure $cs -blocking off
***************
*** 2729,2735 ****
catch {interp delete y}
interp create x
interp create y
! set s [socket -server [namespace code accept] 0]
proc accept {s a p} {
puts $s hello
close $s
--- 2729,2735 ----
catch {interp delete y}
interp create x
interp create y
! set s [socket -server [namespace code accept] -myaddr [info hostname] 0]
proc accept {s a p} {
puts $s hello
close $s
***************
*** 5053,5059 ****
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 port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
--- 5053,5059 ----
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] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
***************
*** 5066,5072 ****
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 port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
--- 5066,5072 ----
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] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
***************
*** 5079,5085 ****
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 port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
--- 5079,5085 ----
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] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
***************
*** 5092,5098 ****
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 port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
--- 5092,5098 ----
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] -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
***************
*** 5133,5139 ****
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]
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
set l
--- 5133,5139 ----
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] -myaddr 127.0.0.1 0]
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
set l
***************
*** 5141,5147 ****
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]
fconfigure $sock -eofchar D -translation lf
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
--- 5141,5147 ----
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] -myaddr 127.0.0.1 0]
fconfigure $sock -eofchar D -translation lf
lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
close $sock
***************
*** 6397,6403 ****
close $s
set wait done
}
! set ss [socket -server [namespace code accept] 0]
variable wait ""
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
vwait [namespace which -variable wait]
--- 6397,6403 ----
close $s
set wait done
}
! set ss [socket -server [namespace code accept] -myaddr [info hostname] 0]
variable wait ""
set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
vwait [namespace which -variable wait]
***************
*** 6748,6754 ****
test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
variable fcopyTestDone
! set listen [socket -server [namespace code FcopyTestAccept] 0]
set in [open $thisScript] ;# 126 K
set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
catch {unset fcopyTestDone}
--- 6748,6754 ----
test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
variable fcopyTestDone
! 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}
***************
*** 6855,6861 ****
}
incr x
}
! set ss [socket -server [namespace code accept] 0]
# We need to delay on some systems until the creation of the
# server socket completes.
--- 6855,6861 ----
}
incr x
}
! set ss [socket -server [namespace code accept] -myaddr [info hostname] 0]
# We need to delay on some systems until the creation of the
# server socket completes.
***************
*** 6891,6897 ****
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]
proc accept {s a p} {
variable counter
variable accept
--- 6891,6897 ----
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] -myaddr 127.0.0.1 0]
proc accept {s a p} {
variable counter
variable accept
***************
*** 6992,6998 ****
variable s2
set s2 $sock
}
! set server [socket -server [namespace code accept] 0]
set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
variable s2
vwait [namespace which -variable s2]
--- 6992,6998 ----
variable s2
set s2 $sock
}
! 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]
***************
*** 7015,7021 ****
variable s2
set s2 $sock
}
! set server [socket -server [namespace code accept] 0]
set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
variable s2
vwait [namespace which -variable s2]
--- 7015,7021 ----
variable s2
set s2 $sock
}
! 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]
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]
Index: tcltest.test
===================================================================
RCS file: TclBase/src/tcl8.4.6/tests/tcltest.test,v
retrieving revision 1.1
diff -C3 -r1.1 tcltest.test
*** tcltest.test 30 Apr 2004 07:10:44 -0000 1.1
--- tcltest.test 14 May 2004 14:35:22 -0000
***************
*** 46,51 ****
--- 46,59 ----
exit
} test.tcl
+ ## BUG!! aotto1968.sf.net
+ ## if I start the test with "./tclsh ../tests/tcltest.test" from an other
+ ## directory as the "tests" directory the statement "::tcltest::testsDirectory"
+ ## points to the current directory and !not! to the "tests" directory
+ ## => tcltest-9.1 will fail
+
+ tcltest::configure -testdir [file dirname [file normalize [info script]]]
+
cd [temporaryDirectory]
testConstraint exec [llength [info commands exec]]
# test -help
