summaryrefslogtreecommitdiffstats
path: root/tests/socket.test
diff options
context:
space:
mode:
authorjenn <jenn>1999-06-26 03:54:09 (GMT)
committerjenn <jenn>1999-06-26 03:54:09 (GMT)
commitc750824920529a5930ca3a8c4301a9cf9c45d6a4 (patch)
tree475011f75181f78a0a48f3360124d7e98188018e /tests/socket.test
parentf95999e4e240586c6002c721425f7b17e84f3637 (diff)
downloadtcl-c750824920529a5930ca3a8c4301a9cf9c45d6a4.zip
tcl-c750824920529a5930ca3a8c4301a9cf9c45d6a4.tar.gz
tcl-c750824920529a5930ca3a8c4301a9cf9c45d6a4.tar.bz2
Modified the tests to use the package tcltest
Diffstat (limited to 'tests/socket.test')
-rw-r--r--tests/socket.test59
1 files changed, 30 insertions, 29 deletions
diff --git a/tests/socket.test b/tests/socket.test
index dc8331c..36b3b44 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.9 1999/04/21 21:50:31 rjohnson Exp $
+# RCS: @(#) $Id: socket.test,v 1.10 1999/06/26 03:54:26 jenn Exp $
# Running socket tests with a remote server:
# ------------------------------------------
@@ -63,7 +63,8 @@
# using the remote server are not performed.
if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
+ package require tcltest
+ namespace import ::tcltest::*
}
# Some tests require the testthread command
@@ -123,7 +124,7 @@ if {$doTestsWithRemoteServer} {
set remoteServerIP 127.0.0.1
set remoteFile [file join [pwd] remote.tcl]
if {[catch {set remoteProcChan \
- [open "|[list $tcltest $remoteFile \
+ [open "|[list $::tcltest::tcltest $remoteFile \
-serverIsSilent \
-port $remoteServerPort \
-address $remoteServerIP]" \
@@ -138,7 +139,7 @@ if {$doTestsWithRemoteServer} {
set doTestsWithRemoteServer 0
}
} else {
- set noRemoteTestReason "$msg $tcltest"
+ set noRemoteTestReason "$msg $::tcltest::tcltest"
set doTestsWithRemoteServer 0
}
}
@@ -261,7 +262,7 @@ test socket-2.1 {tcp connection} {socket stdio} {
puts $x
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
if {[catch {socket 127.0.0.1 2828} msg]} {
set x $msg
@@ -297,7 +298,7 @@ test socket-2.2 {tcp connection with client port specified} {socket stdio} {
close $f
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
global port
if {[catch {socket -myport $port 127.0.0.1 2829} sock]} {
@@ -331,7 +332,7 @@ test socket-2.3 {tcp connection with client interface specified} {socket stdio}
close $f
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
set x $sock
@@ -362,7 +363,7 @@ test socket-2.4 {tcp connection with server interface specified} {socket stdio}
close $f
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
if {[catch {socket [info hostname] 2831} sock]} {
set x $sock
@@ -393,7 +394,7 @@ test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
close $f
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
if {[catch {socket 127.0.0.1 2832} sock]} {
set x $sock
@@ -443,7 +444,7 @@ test socket-2.7 {echo server, one line} {socket stdio} {
puts done
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
set s [socket 127.0.0.1 2834]
fconfigure $s -buffering line -translation lf
@@ -482,7 +483,7 @@ test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
close $f
puts "done $i"
} script
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
set s [socket 127.0.0.1 2835]
fconfigure $s -buffering line
@@ -503,7 +504,7 @@ test socket-2.9 {socket conflict} {socket stdio} {
set f [open script w]
puts -nonewline $f {socket -server accept 2828}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
after 100
set x [list [catch {close $f} msg] $msg]
@@ -575,7 +576,7 @@ test socket-3.1 {socket conflict} {socket stdio} {
close $f
}
close $f
- set f [open "|[list $tcltest script]" r+]
+ set f [open "|[list $::tcltest::tcltest script]" r+]
gets $f
set x [list [catch {socket -server accept 2828} msg] \
$msg]
@@ -617,7 +618,7 @@ test socket-3.2 {server with several clients} {socket stdio} {
puts $x
}
close $f
- set f [open "|[list $tcltest script]" r+]
+ set f [open "|[list $::tcltest::tcltest script]" r+]
set x [gets $f]
set s1 [socket 127.0.0.1 2828]
fconfigure $s1 -buffering line
@@ -657,11 +658,11 @@ test socket-4.1 {server with several clients} {socket stdio} {
gets stdin
}
close $f
- set p1 [open "|[list $tcltest script]" r+]
+ set p1 [open "|[list $::tcltest::tcltest script]" r+]
fconfigure $p1 -buffering line
- set p2 [open "|[list $tcltest script]" r+]
+ set p2 [open "|[list $::tcltest::tcltest script]" r+]
fconfigure $p2 -buffering line
- set p3 [open "|[list $tcltest script]" r+]
+ set p3 [open "|[list $::tcltest::tcltest script]" r+]
fconfigure $p3 -buffering line
proc accept {s a p} {
fconfigure $s -buffering line
@@ -748,7 +749,7 @@ test socket-6.1 {accept callback error} {socket stdio} {
socket 127.0.0.1 2848
}
close $f
- set f [open "|[list $tcltest script]" r+]
+ set f [open "|[list $::tcltest::tcltest script]" r+]
proc bgerror args {
global x
set x $args
@@ -780,7 +781,7 @@ test socket-7.1 {testing socket specific options} {socket stdio} {
after cancel $timer
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
set s [socket 127.0.0.1 2820]
set p [fconfigure $s -peername]
@@ -806,7 +807,7 @@ test socket-7.2 {testing socket specific options} {socket stdio} {
after cancel $timer
}
close $f
- set f [open "|[list $tcltest script]" r]
+ set f [open "|[list $::tcltest::tcltest script]" r]
gets $f
set s [socket 127.0.0.1 2821]
set p [fconfigure $s -sockname]
@@ -1382,13 +1383,13 @@ test socket-12.1 {testing inheritance of server sockets} \
# be closed unless script1 inherited it.
set f [open script2 w]
- puts $f [list set tcltest $tcltest]
+ puts $f [list set tcltest $::tcltest::tcltest]
puts $f {
set f [socket -server accept 2828]
proc accept { file addr port } {
close $file
}
- exec $tcltest script1 &
+ exec $::tcltest::tcltest script1 &
close $f
after 1000 exit
vwait forever
@@ -1397,7 +1398,7 @@ test socket-12.1 {testing inheritance of server sockets} \
# Launch script2 and wait 5 seconds
- exec $tcltest script2 &
+ exec $::tcltest::tcltest script2 &
after 5000 { set ok_to_proceed 1 }
vwait ok_to_proceed
@@ -1434,10 +1435,10 @@ test socket-12.2 {testing inheritance of client sockets} \
# client socket, the socket will still be open.
set f [open script2 w]
- puts $f [list set tcltest $tcltest]
+ puts $f [list set tcltest $::tcltest::tcltest]
puts $f {
set f [socket 127.0.0.1 2829]
- exec $tcltest script1 &
+ exec $::tcltest::tcltest script1 &
puts $f testing
flush $f
after 1000 exit
@@ -1490,7 +1491,7 @@ test socket-12.2 {testing inheritance of client sockets} \
# Launch the script2 process
- exec $tcltest script2 &
+ exec $::tcltest::tcltest script2 &
vwait x
if {!$failed} {
@@ -1513,13 +1514,13 @@ test socket-12.3 {testing inheritance of accepted sockets} \
close $f
set f [open script2 w]
- puts $f [list set tcltest $tcltest]
+ puts $f [list set tcltest $::tcltest::tcltest]
puts $f {
set server [socket -server accept 2930]
proc accept { file host port } {
global tcltest
puts $file {test data on socket}
- exec $tcltest script1 &
+ exec $::tcltest::tcltest script1 &
after 1000 exit
}
vwait forever
@@ -1529,7 +1530,7 @@ test socket-12.3 {testing inheritance of accepted sockets} \
# Launch the script2 process and connect to it. See how long
# the socket stays open
- exec $tcltest script2 &
+ exec $::tcltest::tcltest script2 &
after 1000 set ok_to_proceed 1
vwait ok_to_proceed