diff options
Diffstat (limited to 'tests/remote.tcl')
| -rw-r--r-- | tests/remote.tcl | 43 |
1 files changed, 27 insertions, 16 deletions
diff --git a/tests/remote.tcl b/tests/remote.tcl index 097e41f..4ac3607 100644 --- a/tests/remote.tcl +++ b/tests/remote.tcl @@ -30,9 +30,11 @@ proc __doCommands__ {l s} { puts "---" } set callerSocket $s - set ::errorInfo "" - set code [catch {uplevel "#0" $l} msg] - return [list $code $::errorInfo $msg] + if {[catch {uplevel #0 $l} msg]} { + list error $msg + } else { + list success $msg + } } proc __readAndExecute__ {s} { @@ -40,9 +42,10 @@ proc __readAndExecute__ {s} { set l [gets $s] if {[string compare $l "--Marker--Marker--Marker--"] == 0} { - puts $s [__doCommands__ $command($s) $s] + if {[info exists command($s)]} { + puts $s [list error incomplete_command] + } puts $s "--Marker--Marker--Marker--" - set command($s) "" return } if {[string compare $l ""] == 0} { @@ -54,26 +57,28 @@ 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 command VERBOSE + global VERBOSE if {$VERBOSE} { puts "Server accepts new connection from $a:$p on $s" } - set command($s) "" - fconfigure $s -buffering line -translation crlf fileevent $s readable [list __readAndExecute__ $s] + fconfigure $s -buffering line -translation crlf } set serverIsSilent 0 @@ -146,14 +151,20 @@ 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 { - puts ready vwait __server_wait_variable__ } + + + + + + + + + + + |