copy from other repository
This commit is contained in:
180
streamApp/tests/streamtestlib.tcl
Normal file
180
streamApp/tests/streamtestlib.tcl
Normal file
@ -0,0 +1,180 @@
|
||||
#
|
||||
# Usage
|
||||
# 1) source this file
|
||||
# 2) define variables records, protocol, starup
|
||||
# 3) call startioc
|
||||
# 4) use ioccmd, assure, receive, send,...
|
||||
# 5) call finish
|
||||
|
||||
set testname [file tail $argv0]
|
||||
|
||||
proc bgerror msg {
|
||||
error $::errorInfo
|
||||
}
|
||||
|
||||
set debug 0
|
||||
proc debugmsg {string} {
|
||||
global debug
|
||||
if $debug {puts $string}
|
||||
}
|
||||
|
||||
proc deviceconnect {s addr port} {
|
||||
debugmsg "incoming connenction"
|
||||
global sock
|
||||
set sock $s
|
||||
fconfigure $sock -blocking no -buffering none -translation binary
|
||||
fileevent $sock readable "receiveHandler $sock"
|
||||
}
|
||||
|
||||
set inputbuffer {}
|
||||
proc receiveHandler {sock} {
|
||||
global inputbuffer inputlog
|
||||
set input [read $sock]
|
||||
puts -nonewline $inputlog $input
|
||||
append inputbuffer $input
|
||||
debugmsg "receiving \"[escape $inputbuffer]\""
|
||||
if [eof $sock] {
|
||||
close $sock
|
||||
debugmsg "connection closed by ioc"
|
||||
return
|
||||
}
|
||||
}
|
||||
|
||||
proc startioc {} {
|
||||
global debug records protocol startup port sock ioc testname env
|
||||
set fd [open test.db w]
|
||||
puts $fd $records
|
||||
close $fd
|
||||
set fd [open test.proto w]
|
||||
puts $fd $protocol
|
||||
close $fd
|
||||
set fd [open test.cmd w 0777]
|
||||
puts $fd "#!../O.$env(EPICS_HOST_ARCH)/streamApp"
|
||||
puts $fd "dbLoadDatabase ../O.Common/streamApp.dbd"
|
||||
puts $fd "streamApp_registerRecordDeviceDriver"
|
||||
puts $fd "epicsEnvSet STREAM_PROTOCOL_PATH ."
|
||||
puts $fd "drvAsynIPPortConfigure device localhost:$port"
|
||||
puts $fd "dbLoadRecords test.db"
|
||||
puts $fd $startup
|
||||
puts $fd "iocInit"
|
||||
puts $fd "dbl"
|
||||
puts $fd "dbior stream 2"
|
||||
puts $fd "var streamDebug 1"
|
||||
close $fd
|
||||
set ioc [open "|../O.$env(EPICS_HOST_ARCH)/streamApp test.cmd >& $testname.ioclog 2>@stderr" w]
|
||||
fconfigure $ioc -blocking yes -buffering none
|
||||
debugmsg "waiting to connect"
|
||||
vwait sock
|
||||
}
|
||||
|
||||
set lastcommand ""
|
||||
set line 0
|
||||
proc ioccmd {command} {
|
||||
global ioc
|
||||
global lastcommand
|
||||
global line
|
||||
set lastcommand $command
|
||||
set line 0
|
||||
debugmsg "$command"
|
||||
puts $ioc $command
|
||||
}
|
||||
|
||||
proc send {string} {
|
||||
global sock
|
||||
debugmsg "sending \"[escape $string]\""
|
||||
puts -nonewline $sock $string
|
||||
}
|
||||
|
||||
set timeout 5000
|
||||
proc receive {} {
|
||||
global inputbuffer timeoutid timeout
|
||||
set timeoutid [after $timeout {
|
||||
set inputbuffer {}
|
||||
}]
|
||||
if {$inputbuffer == {}} { vwait inputbuffer }
|
||||
after cancel $timeoutid
|
||||
if {$inputbuffer == {}} {
|
||||
return -code error "Error in receive: timeout"
|
||||
}
|
||||
set index [string first "\n" $inputbuffer]
|
||||
if {$index > -1} {
|
||||
set input [string range $inputbuffer 0 $index]
|
||||
set inputbuffer [string range $inputbuffer [expr $index+1] end]
|
||||
} else {
|
||||
set input $inputbuffer
|
||||
set inputbuffer {}
|
||||
}
|
||||
return $input
|
||||
}
|
||||
|
||||
set faults 0
|
||||
proc assure {args} {
|
||||
global faults
|
||||
global lastcommand
|
||||
global line
|
||||
|
||||
incr line
|
||||
set input {}
|
||||
for {set i 0} {$i < [llength $args]} {incr i} {
|
||||
if [catch {lappend input [receive]} msg] {
|
||||
puts stderr $msg
|
||||
break
|
||||
}
|
||||
}
|
||||
set notfound {}
|
||||
foreach expected $args {
|
||||
set index [lsearch -exact $input $expected]
|
||||
if {$index > -1} {
|
||||
set input [lreplace $input $index $index]
|
||||
} else {
|
||||
lappend notfound $expected
|
||||
}
|
||||
}
|
||||
if {[llength $notfound] || [llength $input]} {
|
||||
puts stderr "In command \"$lastcommand\""
|
||||
}
|
||||
foreach string $notfound {
|
||||
puts stderr "Error in assure: line $line missing \"[escape $string]\""
|
||||
}
|
||||
foreach string $input {
|
||||
puts stderr "Error in assure: got unexpected \"[escape $string]\""
|
||||
}
|
||||
if {[llength $notfound] || [llength $input]} {incr faults}
|
||||
}
|
||||
|
||||
proc escape {string} {
|
||||
while {![string is print -failindex index $string]} {
|
||||
set char [string index $string $index]
|
||||
scan $char "%c" code
|
||||
switch $char {
|
||||
"\r" { set escaped "\\r" }
|
||||
"\n" { set escaped "\\n" }
|
||||
"\a" { set escaped "\\a" }
|
||||
"\t" { set escaped "\\t" }
|
||||
default { set escaped [format "<%02x>" $code] }
|
||||
}
|
||||
set string [string replace $string $index $index $escaped]
|
||||
}
|
||||
return $string
|
||||
}
|
||||
|
||||
proc finish {} {
|
||||
global ioc timeout testname faults
|
||||
set timeout 1000
|
||||
while {![catch {set string [receive]}]} {
|
||||
puts stderr "Error in finish: unexpected \"[escape $string]\""
|
||||
incr faults
|
||||
}
|
||||
after 100
|
||||
close $ioc
|
||||
if $faults {
|
||||
puts "Test failed."
|
||||
exit 1
|
||||
}
|
||||
puts "Test passed."
|
||||
eval file delete [glob -nocomplain test.*] StreamDebug.log $testname.ioclog
|
||||
}
|
||||
|
||||
set port 40123
|
||||
socket -server deviceconnect $port
|
||||
set inputlog [open "test.inputlog" w]
|
Reference in New Issue
Block a user