summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2001-06-28 09:54:31 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2001-06-28 09:54:31 (GMT)
commitad089734d46b752197f9573a90e85d67b6870083 (patch)
treee86e9ff43e66a18c1244cb07d3406ec0f14aa00e
parent293dbdc050e3bd444292641282727a0bd24eef27 (diff)
downloadtcl-ad089734d46b752197f9573a90e85d67b6870083.zip
tcl-ad089734d46b752197f9573a90e85d67b6870083.tar.gz
tcl-ad089734d46b752197f9573a90e85d67b6870083.tar.bz2
Removed requirement for local echo service; thanks Jeff for pointing
out this flaw.
-rw-r--r--ChangeLog6
-rw-r--r--tests/unixInit.test43
2 files changed, 40 insertions, 9 deletions
diff --git a/ChangeLog b/ChangeLog
index 20ab5f0..6a26b46 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2001-06-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/unixInit.test (unixInit-1.2): Modified so as not to
+ require a local echo service, which fails on many systems which
+ have that turned off for security reasons...
+
2001-06-27 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclInt.h:
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 4c11741..4d62f86 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.15 2001/06/18 13:13:23 dkf Exp $
+# RCS: @(#) $Id: unixInit.test,v 1.16 2001/06/28 09:54:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -63,14 +63,39 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
# channels are set up as part of initialisation of the interpreter so
# the test seems to me to fit here as well as anywhere else.
test unixInit-1.2 {initialisation: channel type deduction} {unixOnly installedTcl} {
- set sock [socket localhost echo]
- set pipe [open |[list $::tcltest::tcltest >@$sock] w]
- puts $pipe {puts [fconfigure stdout -peername]; exit}
- close $pipe
- gets $sock channeltype
- close $sock
- set channeltype
-} {127.0.0.1 localhost 7}
+ set pipe1 [open |[list $::tcltest::tcltest] r+]
+ puts $pipe1 {
+ proc accept {channel host port} {
+ puts $channel {
+ puts [fconfigure stdin -peername]
+ flush stdout
+ exit
+ }
+ flush $channel
+ close $channel
+ exit
+ }
+ set server [socket -server accept 0]
+ puts stdout [fconfigure $server -sockname]
+ flush stdout
+ update
+ vwait forever \
+ }
+ flush $pipe1
+ set port [lindex [gets $pipe1] 2]
+ set sock [socket localhost $port]
+ set pipe2 [open |[list $::tcltest::tcltest <@$sock] r]
+ set result [gets $pipe2]
+ close $pipe2
+ close $pipe1
+ catch {close $sock}
+ set expected [list 127.0.0.1 localhost $port]
+ if {[string equal $expected $result]} {
+ subst "OK"
+ } else {
+ subst "Expected: $expected, Got $result"
+ }
+} {OK}
proc getlibpath "{program [list $::tcltest::tcltest]}" {
set f [open "|$program" w+]