diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | tests/event.test | 4 | ||||
| -rw-r--r-- | tests/io.test | 52 | ||||
| -rw-r--r-- | tests/ioCmd.test | 8 | ||||
| -rw-r--r-- | tests/iogt.test | 4 | ||||
| -rw-r--r-- | tests/socket.test | 114 | ||||
| -rw-r--r-- | tests/unixInit.test | 4 |
7 files changed, 98 insertions, 97 deletions
@@ -1,3 +1,12 @@ +2006-11-03 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * tests/event.test (event-11.5): Rewrote tests to stop Tcl from + * tests/io.test (multiple tests): opening sockets that are + * tests/ioCmd.test (iocmd-15.1,16,17): reachable from outside hosts + * tests/iogt.test (__echo_srv__.tcl): where not necessary. This is + * tests/socket.test (multiple tests): noticably annoying on some + * tests/unixInit.test (unixInit-1.2): systems (e.g., Windows). + 2006-11-02 Daniel Steffen <das@users.sourceforge.net> * macosx/Tcl.xcodeproj/project.pbxproj: check autoconf/autoheader exit diff --git a/tests/event.test b/tests/event.test index 5e8cc4c..0ac11cd 100644 --- a/tests/event.test +++ b/tests/event.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: event.test,v 1.21 2006/10/09 19:15:44 msofer Exp $ +# RCS: @(#) $Id: event.test,v 1.22 2006/11/03 11:45:33 dkf Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -407,7 +407,7 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc puts $s foobar close $s } - catch {set s1 [socket -server accept 0]} + catch {set s1 [socket -server accept -myaddr 127.0.0.1 0]} after 1000 catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]} close $s1 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] diff --git a/tests/ioCmd.test b/tests/ioCmd.test index cbe653e..e2d8327 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.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: ioCmd.test,v 1.29 2006/10/09 19:15:45 msofer Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.30 2006/11/03 11:45:34 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -273,7 +273,7 @@ test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup { - set srv [socket -server iocmdSRV 0] + 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] @@ -286,7 +286,7 @@ test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOr rename iocmdSRV {} } -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname} test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup { - set srv [socket -server iocmdSRV 0] + 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] @@ -299,7 +299,7 @@ test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup { rename iocmdSRV {} } -result 1 test iocmd-8.17 {fconfigure command / tcp channel} -constraints nonPortable -setup { - set srv [socket -server iocmdSRV 0] + 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] diff --git a/tests/iogt.test b/tests/iogt.test index 969e43c..c45d97d 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -10,7 +10,7 @@ # Copyright (c) 2000 Andreas Kupries. # All rights reserved. # -# RCS: @(#) $Id: iogt.test,v 1.15 2006/11/03 00:34:53 hobbs Exp $ +# RCS: @(#) $Id: iogt.test,v 1.16 2006/11/03 11:45:34 dkf Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." @@ -126,7 +126,7 @@ proc echoPut {c sock} { #fileevent stdin readable {exit ;#cut} # main -socket -server newconn $port +socket -server newconn -myaddr 127.0.0.1 $port vwait forever } __echo_srv__.tcl] diff --git a/tests/socket.test b/tests/socket.test index 0dea1d0..90dfcb1 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: socket.test,v 1.39 2006/03/16 00:38:54 andreas_kupries Exp $ +# RCS: @(#) $Id: socket.test,v 1.40 2006/11/03 11:45:34 dkf Exp $ # Running socket tests with a remote server: # ------------------------------------------ @@ -111,39 +111,37 @@ set remoteProcChan "" set commandSocket "" if {$doTestsWithRemoteServer} { catch {close $commandSocket} - if {[catch {set commandSocket [socket $remoteServerIP \ - $remoteServerPort]}] != 0} { - if {[info commands exec] == ""} { - set noRemoteTestReason "can't exec" - set doTestsWithRemoteServer 0 - } else { - set remoteServerIP 127.0.0.1 - # Be *extra* careful in case this file is sourced from - # a directory other than the current one... - set remoteFile [file join [pwd] [file dirname [info script]] \ - remote.tcl] - if {[catch {set remoteProcChan \ - [open "|[list [interpreter] $remoteFile \ - -serverIsSilent \ - -port $remoteServerPort \ - -address $remoteServerIP]" \ - w+]} \ - msg] == 0} { - after 1000 - if {[catch {set commandSocket [socket $remoteServerIP \ - $remoteServerPort]} msg] == 0} { - fconfigure $commandSocket -translation crlf -buffering line - } else { - set noRemoteTestReason $msg - set doTestsWithRemoteServer 0 - } + if {![catch { + set commandSocket [socket $remoteServerIP $remoteServerPort] + }]} then { + fconfigure $commandSocket -translation crlf -buffering line + } elseif {![testConstraint exec]} { + set noRemoteTestReason "can't exec" + set doTestsWithRemoteServer 0 + } else { + set remoteServerIP 127.0.0.1 + # Be *extra* careful in case this file is sourced from + # a directory other than the current one... + set remoteFile [file join [pwd] [file dirname [info script]] \ + remote.tcl] + if {![catch { + set remoteProcChan [open "|[list \ + [interpreter] $remoteFile -serverIsSilent \ + -port $remoteServerPort -address $remoteServerIP]" w+] + } msg]} then { + after 1000 + if {[catch { + set commandSocket [socket $remoteServerIP $remoteServerPort] + } msg] == 0} then { + fconfigure $commandSocket -translation crlf -buffering line } else { - set noRemoteTestReason "$msg [interpreter]" + set noRemoteTestReason $msg set doTestsWithRemoteServer 0 } + } else { + set noRemoteTestReason "$msg [interpreter]" + set doTestsWithRemoteServer 0 } - } else { - fconfigure $commandSocket -translation crlf -buffering line } } @@ -169,7 +167,6 @@ if {[testConstraint doTestsWithRemoteServer]} { if {[eof $commandSocket]} { error "remote server disappeared" } - if {[catch {puts $commandSocket $c} msg]} { error "remote server disappaered: $msg" } @@ -583,7 +580,7 @@ test socket-3.1 {socket conflict} {socket stdio} { file delete $path(script) set f [open $path(script) w] puts $f { - set f [socket -server accept 0] + set f [socket -server accept -myaddr 127.0.0.1 0] puts ready puts [lindex [fconfigure $f -sockname] 2] gets stdin @@ -593,7 +590,7 @@ test socket-3.1 {socket conflict} {socket stdio} { set f [open "|[list [interpreter] $path(script)]" r+] gets $f gets $f listen - set x [list [catch {socket -server accept $listen} msg] \ + set x [list [catch {socket -server accept -myaddr 127.0.0.1 $listen} msg] \ $msg] puts $f bye close $f @@ -607,7 +604,7 @@ test socket-3.2 {server with several clients} {socket stdio} { 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] + 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 @@ -698,7 +695,7 @@ test socket-4.1 {server with several clients} {socket stdio} { 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 s [socket -server accept -myaddr 127.0.0.1 0] set listen [lindex [fconfigure $s -sockname] 2] puts $p1 $listen puts $p2 $listen @@ -724,7 +721,7 @@ test socket-4.1 {server with several clients} {socket stdio} { } {{p1 bye done} {p2 bye done} {p3 bye done}} test socket-4.2 {byte order problems, socket numbers, htons} {socket} { set x ok - if {[catch {socket -server dodo 0x3000} msg]} { + if {[catch {socket -server dodo -myaddr 127.0.0.1 0x3000} msg]} { set x $msg } else { close $msg @@ -775,7 +772,7 @@ test socket-6.1 {accept callback error} -constraints {socket stdio} -setup { close $f set f [open "|[list [interpreter] $path(script)]" r+] proc accept {s a p} {expr 10 / 0} - set s [socket -server accept 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"] @@ -843,21 +840,21 @@ test socket-7.2 {testing socket specific options} {socket stdio} { [expr {[lindex $p 2] == $listen}] } {3 1 0} test socket-7.3 {testing socket specific options} {socket} { - set s [socket -server accept 0] + 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 0] + set s [socket -server accept -myaddr 127.0.0.1 0] proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s } set listen [lindex [fconfigure $s -sockname] 2] - set s1 [socket [info hostname] $listen] + set s1 [socket 127.0.0.1 $listen] set timer [after 10000 "set x timed_out"] vwait x after cancel $timer @@ -899,14 +896,14 @@ test socket-8.1 {testing -async flag on sockets} {socket} { # 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] + set s [socket -server accept -myaddr 127.0.0.1 0] proc accept {s a p} { global x puts $s bye close $s set x done } - set s1 [socket -async [info hostname] [lindex [fconfigure $s -sockname] 2]] + set s1 [socket -async 127.0.0.1 [lindex [fconfigure $s -sockname] 2]] vwait x set z [gets $s1] close $s @@ -936,8 +933,8 @@ test socket-9.1 {testing spurious events} {socket} { 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]] + set s [socket -server accept -myaddr 127.0.0.1 0] + set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]] puts -nonewline $c 01234567890123456789012345678901234567890123456789 close $c set timer [after 10000 "set done timed_out"] @@ -953,7 +950,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {socket} { for {set i 0} {$i < 16} {incr i} { set secondblock "b$secondblock$secondblock" } - set l [socket -server accept 0] + set l [socket -server accept -myaddr 127.0.0.1 0] proc accept {s a p} { fconfigure $s -blocking 0 -translation lf -buffersize 16384 \ -buffering line @@ -974,7 +971,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {socket} { puts -nonewline $s $secondblock close $s } - set s [socket [info hostname] [lindex [fconfigure $l -sockname] 2]] + set s [socket 127.0.0.1 [lindex [fconfigure $l -sockname] 2]] fconfigure $s -blocking 0 -trans lf -buffering line set count 0 puts $s hello @@ -1024,8 +1021,8 @@ test socket-9.3 {testing EOF stickyness} {socket} { 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]] + set s [socket -server accept -myaddr 127.0.0.1 0] + set c [socket 127.0.0.1 [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] @@ -1046,7 +1043,7 @@ test socket-10.1 {testing socket accept callback error handling} -constraints { set handler [interp bgerror {}] interp bgerror {} [namespace which myHandler] } -body { - set s [socket -server accept 0] + 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 @@ -1158,8 +1155,8 @@ test socket-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} { set cnt } 50 test socket-11.6 {socket conflict} {socket doTestsWithRemoteServer} { - set s1 [socket -server accept 2836] - if {[catch {set s2 [socket -server accept 2836]} msg]} { + set s1 [socket -server accept -myaddr 127.0.0.1 2836] + if {[catch {set s2 [socket -server accept -myaddr 127.0.0.1 2836]} msg]} { set result [list 1 $msg] } else { set result [list 0 [lindex [fconfigure $s2 -sockname] 2]] @@ -1310,7 +1307,6 @@ test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} { sendCommand {close $socket10_13_test_server} list $spurious $len $done } {0 2690 1} - test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} { set counter 0 set done 0 @@ -1344,7 +1340,6 @@ test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} { sendCommand {close $socket10_14_test_server} set done } {EOF is sticky} - test socket-11.13 {testing async write, async flush, async close} \ {socket doTestsWithRemoteServer} { proc readit {s} { @@ -1423,7 +1418,7 @@ test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} { set f [open $path(script2) w] puts $f [list set tcltest [interpreter]] puts -nonewline $f { - set f [socket -server accept 0] + set f [socket -server accept -myaddr 127.0.0.1 0] puts [lindex [fconfigure $f -sockname] 2] proc accept { file addr port } { close $file @@ -1493,7 +1488,7 @@ test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} { # Create the server socket - set server [socket -server accept 0] + 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 @@ -1559,7 +1554,7 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} { set f [open $path(script2) w] puts $f [list set tcltest [interpreter]] puts -nonewline $f { - set server [socket -server accept 0] + 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 \{ @@ -1629,11 +1624,9 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} { test socket-13.1 {Testing use of shared socket between two threads} \ -constraints {socket testthread} -setup { - threadReap - set path(script) [makeFile { - set f [socket -server accept 0] + 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] @@ -1654,11 +1647,9 @@ test socket-13.1 {Testing use of shared socket between two threads} \ set i 0 vwait x close $f - # thread cleans itself up. testthread exit } script] - } -body { # create a thread set serverthread [testthread create [list source $path(script) ] ] @@ -1683,7 +1674,6 @@ test socket-13.1 {Testing use of shared socket between two threads} \ removeFile script } -result {hello 1} - removeFile script1 removeFile script2 diff --git a/tests/unixInit.test b/tests/unixInit.test index 4c876c4..1f4dc7a 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixInit.test,v 1.49 2006/03/21 11:12:29 dkf Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.50 2006/11/03 11:45:35 dkf Exp $ package require tcltest 2.2 namespace import -force ::tcltest::* @@ -50,7 +50,7 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} close $channel exit } - puts [fconfigure [socket -server accept 0] -sockname] + puts [fconfigure [socket -server accept -myaddr 127.0.0.1 0] -sockname] vwait forever \ } # Note the backslash above; this is important to make sure that the |