diff options
author | rmax <rmax> | 2010-09-28 15:13:54 (GMT) |
---|---|---|
committer | rmax <rmax> | 2010-09-28 15:13:54 (GMT) |
commit | 8de390107eb243b132d238c82d5dad142732ea6f (patch) | |
tree | 3c49ea8f056c9653ddd2cfed43ac4615cba322bb /tests/remote.tcl | |
parent | 76ae3756ac54d0957e5d6c430aec55b52ccc0bf3 (diff) | |
download | tcl-8de390107eb243b132d238c82d5dad142732ea6f.zip tcl-8de390107eb243b132d238c82d5dad142732ea6f.tar.gz tcl-8de390107eb243b132d238c82d5dad142732ea6f.tar.bz2 |
* doc/socket.n: Document the changes to the [socket] and
[fconfiguyre] commands.
* generic/tclInt.h: Introduce TclCreateSocketAddress() as a
* generic/tclIOSock.c: replacement for the platform-dependent
* unix/tclUnixSock.c: TclpCreateSocketAddress() functions.
* unix/tclUnixChan.c: Extend the [socket] and [fconfigure]
* unix/tclUnixPort.h: commands to behave as proposed in
* win/tclWinSock.c: TIP #162.
* win/tclWinPort.h:
* compat/fake-rfc2553.c: A compat implementation of the APIs
* compat/fake-rfc2553.h: defined in RFC-2553 (getaddrinfo() and
friends) on top of the existing
gethostbyname() etc.
* unix/configure.in: Test whether the fake-implementation is
* unix/tcl.m4: needed.
* unix/Makefile.in: Add a compile target for fake-rfc2553.
* win/configure.in: Allow cross-compilation by default
* tests/socket.test: Improve the test suite to make more use of
* tests/remote.tcl: randomized ports to reduce interference with
tests running in parallel or other services
on the machine.
Diffstat (limited to 'tests/remote.tcl')
-rw-r--r-- | tests/remote.tcl | 44 |
1 files changed, 16 insertions, 28 deletions
diff --git a/tests/remote.tcl b/tests/remote.tcl index 005f2df..fd50b51 100644 --- a/tests/remote.tcl +++ b/tests/remote.tcl @@ -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: remote.tcl,v 1.3 1999/04/16 00:47:33 stanton Exp $ +# RCS: @(#) $Id: remote.tcl,v 1.4 2010/09/28 15:13:55 rmax Exp $ # Initialize message delimitor @@ -32,11 +32,9 @@ proc __doCommands__ {l s} { puts "---" } set callerSocket $s - if {[catch {uplevel #0 $l} msg]} { - list error $msg - } else { - list success $msg - } + set ::errorInfo "" + set code [catch {uplevel "#0" $l} msg] + return [list $code $::errorInfo $msg] } proc __readAndExecute__ {s} { @@ -44,10 +42,9 @@ proc __readAndExecute__ {s} { set l [gets $s] if {[string compare $l "--Marker--Marker--Marker--"] == 0} { - if {[info exists command($s)]} { - puts $s [list error incomplete_command] - } + puts $s [__doCommands__ $command($s) $s] puts $s "--Marker--Marker--Marker--" + set command($s) "" return } if {[string compare $l ""] == 0} { @@ -59,28 +56,26 @@ proc __readAndExecute__ {s} { } return } - append command($s) $l "\n" - if {[info complete $command($s)]} { - set cmds $command($s) - unset command($s) - puts $s [__doCommands__ $cmds $s] - } if {[eof $s]} { if {$VERBOSE} { puts "Server closing $s, eof from client" } close $s + unset command($s) + return } + append command($s) $l "\n" } proc __accept__ {s a p} { - global VERBOSE + global command VERBOSE if {$VERBOSE} { puts "Server accepts new connection from $a:$p on $s" } - fileevent $s readable [list __readAndExecute__ $s] + set command($s) "" fconfigure $s -buffering line -translation crlf + fileevent $s readable [list __readAndExecute__ $s] } set serverIsSilent 0 @@ -153,20 +148,13 @@ if {$serverIsSilent == 0} { flush stdout } +proc getPort sock { + lindex [fconfigure $sock -sockname] 2 +} + if {[catch {set serverSocket \ [socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} { puts "Server on $serverAddress:$serverPort cannot start: $msg" } else { vwait __server_wait_variable__ } - - - - - - - - - - - |