summaryrefslogtreecommitdiffstats
path: root/tests/unixInit.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/unixInit.test')
-rw-r--r--tests/unixInit.test47
1 files changed, 30 insertions, 17 deletions
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 8370d6a..d22c0d7 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.17 2001/07/02 20:57:02 dgp Exp $
+# RCS: @(#) $Id: unixInit.test,v 1.18 2001/07/03 10:26:48 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -62,38 +62,51 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
# This test is really a test of code in tclUnixChan.c, but the
# 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 pipe1 [open |[list $::tcltest::tcltest] r+]
+test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly installedTcl} {
+ # pipe1 is a connection to a server that reports what port it
+ # starts on, and delivers a constant string to the first client to
+ # connect to that port before exiting.
+ 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
+ puts $channel {puts [fconfigure stdin -peername]; exit}
close $channel
exit
}
- set server [socket -server accept 0]
- puts stdout [fconfigure $server -sockname]
- flush stdout
- update
+ puts [fconfigure [socket -server accept 0] -sockname]
vwait forever \
}
+ # Note the backslash above; this is important to make sure that the
+ # whole string is read before an [exit] can happen...
flush $pipe1
set port [lindex [gets $pipe1] 2]
set sock [socket localhost $port]
- set pipe2 [open |[list $::tcltest::tcltest <@$sock] r]
+ # pipe2 is a connection to a Tcl interpreter that takes its orders
+ # from the socket we hand it (i.e. the server we create above.)
+ # These orders will tell it to print out the details about the
+ # socket it is taking instructions from, hopefully identifying it
+ # as a socket. Which is what this test is all about.
+ set pipe2 [open "|[list $::tcltest::tcltest <@$sock]" r]
set result [gets $pipe2]
+
+ # Clear any pending data; stops certain kinds of (non-important) errors
+ fconfigure $pipe1 -blocking 0; gets $pipe1
+ fconfigure $pipe2 -blocking 0; gets $pipe2
+
+ # Close the pipes and the socket.
close $pipe2
close $pipe1
catch {close $sock}
- set expected [list 127.0.0.1 localhost $port]
- if {[string equal $expected $result]} {
+
+ # Can't use normal comparison, as hostname varies due to some
+ # installations having a messed up /etc/hosts file.
+ if {
+ [string equal 127.0.0.1 [lindex $result 0]] &&
+ [string equal $port [lindex $result 2]]
+ } then {
subst "OK"
} else {
- subst "Expected: $expected, Got $result"
+ subst "Expected: `[list 127.0.0.1 localhost $port]', Got `$result'"
}
} {OK}