- First version of instrument regression tests
- sinqcom is the first version of a communication testing program for instruments
This commit is contained in:
koennecke
314
insttest/sinqcom
Executable file
314
insttest/sinqcom
Executable file
@ -0,0 +1,314 @@
|
||||
#!/usr/bin/tclsh
|
||||
#-------------------------------------------------------------------------
|
||||
# This program tests the communication to the various devices
|
||||
# belonging to an instrument. For this to work, the SICServer
|
||||
# and all accociated process have to be off: monit stop all.
|
||||
#
|
||||
# Mark Koennecke, November 2006
|
||||
#------------------------------------------------------------------------
|
||||
set debug 1
|
||||
#-----------------------------------------------------------------------
|
||||
proc pingTest {host} {
|
||||
set status [catch {exec ping -c 5 $host} msg]
|
||||
if {$status == 0} {
|
||||
return OK
|
||||
} else {
|
||||
error "Ping failed for $host"
|
||||
}
|
||||
}
|
||||
#----------------------------------------------------------------------
|
||||
proc readReply {chan} {
|
||||
global replyData
|
||||
gets $chan replyData
|
||||
}
|
||||
#----------------------------------------------------------------------
|
||||
proc timeout {} {
|
||||
global replyData
|
||||
set replyData TIMEOUT
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
proc sendCommand {chan command} {
|
||||
global replyData debug
|
||||
puts $chan $command
|
||||
flush $chan
|
||||
if {$debug == 1} {
|
||||
puts stdout "Sent $command"
|
||||
}
|
||||
after 20000 timeout
|
||||
vwait replyData
|
||||
if {$debug == 1} {
|
||||
puts stdout "Received $replyData"
|
||||
}
|
||||
return $replyData
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
proc makeConnection {host port} {
|
||||
set socke [socket $host $port]
|
||||
fconfigure $socke -blocking 0
|
||||
fileevent $socke readable [list readReply $socke]
|
||||
return $socke
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testEL737 {host port} {
|
||||
puts stdout "Testing for EL737 counter at $host $port"
|
||||
if {[catch {pingTest $host} msg] != 0} {
|
||||
error $msg
|
||||
}
|
||||
set socke [makeConnection $host $port]
|
||||
sendCommand $socke "RMT 1\r\n"
|
||||
sendCommand $socke "RMT 1\r\n"
|
||||
sendCommand $socke "ECHO 0\r\n"
|
||||
sendCommand $socke "ECHO 0\r\n"
|
||||
for {set i 0} {$i < 3} {incr i} {
|
||||
set replyData [sendCommand $socke "ID\r\n"]
|
||||
if {[string first EL737 $replyData] >= 0} {
|
||||
close $socke
|
||||
return OK
|
||||
}
|
||||
}
|
||||
close $socke
|
||||
error "Bad reply $replyData from EL737"
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
proc testEL734 {host port} {
|
||||
puts stdout "Testing for EL734 motor controller at $host $port"
|
||||
if {[catch {pingTest $host} msg] != 0} {
|
||||
error $msg
|
||||
}
|
||||
set socke [makeConnection $host $port]
|
||||
sendCommand $socke "RMT 1\n"
|
||||
sendCommand $socke "ECHO 0\n"
|
||||
sendCommand $socke "RMT 1\n"
|
||||
sendCommand $socke "ECHO 0\n"
|
||||
for {set i 0} {$i < 10} {incr i} {
|
||||
set replyData [sendCommand $socke "ID\n"]
|
||||
if {[string first EL734 $replyData] >= 0} {
|
||||
close $socke
|
||||
return OK
|
||||
}
|
||||
}
|
||||
close $socke
|
||||
error "Bad reply $replyData from EL734"
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testSPS {host port} {
|
||||
puts stdout "Testing SPS not yet implemented"
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testVelo {host port} {
|
||||
puts stdout "Testing velocity selector not yet implemented"
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testChopper {host port} {
|
||||
puts stdout "Testing Choppers not yet implemented"
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testJuelich {host port} {
|
||||
puts stdout "Testing Juelich Choppers not yet implemented"
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testEmmenegger {host port} {
|
||||
puts stdout "Testing Emmenegger electronic not yet implemented"
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testMDIF {host port} {
|
||||
puts stdout "Testing MDIF electronic not yet implemented"
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
proc testHM {host} {
|
||||
if {[catch {pingTest $host} msg] != 0} {
|
||||
error $msg
|
||||
}
|
||||
set status [catch {exec sinqhm_ctrl -host $host status} msg]
|
||||
if {$status != 0} {
|
||||
error "HM $host failed with $msg"
|
||||
}
|
||||
set idx [string first Histogramming $msg]
|
||||
set idx2 [string first acquisition $msg]
|
||||
set idx3 [string first SinqHM $msg]
|
||||
if {$idx < 0 || $idx2 < 0 || $idx3 < 0} {
|
||||
puts stdout $msg
|
||||
error "Message does not seem to come from SinqHM"
|
||||
}
|
||||
return OK
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testHttpHM {host} {
|
||||
if {[catch {pingTest $host} msg] != 0} {
|
||||
error $msg
|
||||
}
|
||||
catch \
|
||||
{exec wget --user=spy --password=007 \
|
||||
http://$host/admin/status.egi >& wget.lis}
|
||||
set in [open wget.lis r]
|
||||
while {[gets $in line] >= 0} {
|
||||
append msg $line "\n"
|
||||
}
|
||||
close $in
|
||||
set idx [string first 200 $msg]
|
||||
set idx2 [string first OK $msg]
|
||||
set idx3 [string first status.egi $msg]
|
||||
if {$idx < 0 || $idx2 < 0 || $idx3 < 0} {
|
||||
puts stdout $msg
|
||||
error "Message does not seem to come from Sinq Http HM"
|
||||
}
|
||||
return OK
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
proc testList {testList} {
|
||||
foreach com $testList {
|
||||
catch {eval $com} msg
|
||||
puts stdout $msg
|
||||
}
|
||||
}
|
||||
#======================= Database Section ===============================
|
||||
set ts psts224
|
||||
lappend amor [list testPing amor.psi.ch]
|
||||
lappend amor [list testEL734 $ts 3002]
|
||||
lappend amor [list testEL734 $ts 3003]
|
||||
lappend amor [list testEL734 $ts 3004]
|
||||
lappend amor [list testEL737 $ts 3005]
|
||||
lappend amor [list testSPS $ts 3006]
|
||||
lappend amor [list testEmmenegger $ts 3007]
|
||||
lappend amor [list testChopper $ts 3014]
|
||||
lappend amor [list testMDIF $ts 3015]
|
||||
lappend amor [list testHttpHM lnse10]
|
||||
|
||||
set ts psts225
|
||||
lappend dmc [list testPing dmc.psi.ch]
|
||||
lappend dmc [list testEL734 $ts 3002]
|
||||
lappend dmc [list testEL737 $ts 3006]
|
||||
lappend dmc [list testHM lnse01]
|
||||
|
||||
set ts psts227
|
||||
lappend focus [list testPing focus.psi.ch]
|
||||
lappend focus [list testEL734 $ts 3002]
|
||||
lappend focus [list testEL734 $ts 3003]
|
||||
lappend focus [list testSPS $ts 3004]
|
||||
lappend focus [list testEL737 $ts 3005]
|
||||
lappend focus [list testEmmenegger $ts 3006]
|
||||
lappend focus [list testChopper $ts 3008]
|
||||
lappend focus [list testHM lnse04]
|
||||
lappend focus [list testHM lnse05.vme]
|
||||
lappend focus [list testHM lnse06.vme]
|
||||
# Missing 2D detector and MDIF
|
||||
|
||||
set ts psts229
|
||||
lappend hrpt [list testPing hrpt.psi.ch]
|
||||
lappend hrpt [list testEL734 $ts 3002]
|
||||
lappend hrpt [list testEL734 $ts 3003]
|
||||
lappend hrpt [list testEL734 $ts 3004]
|
||||
lappend hrpt [list testEL734 $ts 3005]
|
||||
lappend hrpt [list testEL737 $ts 3006]
|
||||
lappend hrpt [list testSPS $ts 3008]
|
||||
lappend hrpt [list testHM lnse03]
|
||||
|
||||
set ts psts235
|
||||
lappend mars [list testPing mars.psi.ch]
|
||||
lappend mars [list testEL734 $ts 3002]
|
||||
lappend mars [list testEL734 $ts 3003]
|
||||
lappend mars [list testEL734 $ts 3004]
|
||||
lappend mars [list testEL734 $ts 3005]
|
||||
lappend mars [list testEL734 $ts 3006]
|
||||
lappend mars [list testEL734 $ts 3007]
|
||||
lappend mars [list testEL737 $ts 3008]
|
||||
lappend mars [list testJuelich $ts 3009]
|
||||
lappend mars [list testMDIF $ts 3010]
|
||||
lappend mars [list testHttpHM lnse13]
|
||||
|
||||
set ts lnsts06
|
||||
lappend morpheus [list testPing morpheus.psi.ch]
|
||||
lappend morpheus [list testEL734 $ts 3002]
|
||||
lappend morpheus [list testEL734 $ts 3003]
|
||||
lappend morpheus [list testEL734 $ts 3004]
|
||||
lappend morpheus [list testEL737 $ts 3005]
|
||||
lappend morpheus [list testSPS $ts 3006]
|
||||
|
||||
set ts psts230
|
||||
#stimmt das noch? Ist da nicht dieser moxa drinne?
|
||||
lappend narziss [list testPing narziss.psi.ch]
|
||||
lappend narziss [list testEL734 $ts 3002]
|
||||
lappend narziss [list testEL737 $ts 3003]
|
||||
|
||||
|
||||
set ts psts240
|
||||
lappend poldi [list testPing poldi.psi.ch]
|
||||
lappend poldi [list testEL734 $ts 3002]
|
||||
lappend poldi [list testEL734 $ts 3003]
|
||||
lappend poldi [list testEL737 $ts 3004]
|
||||
lappend poldi [list testChopper $ts 3005]
|
||||
lappend poldi [list testHM lnse11]
|
||||
#------ missing TIWI electronic
|
||||
|
||||
set ts lnsts02
|
||||
lappend rita2 [list testPing rita2.psi.ch]
|
||||
lappend rita2 [list testPing lnsgpib01.psi.ch]
|
||||
lappend rita2 [list testEL734 $ts 3002]
|
||||
lappend rita2 [list testEL737 $ts 3005]
|
||||
#-------- can GPIB communication more sensibly be tested???
|
||||
|
||||
set ts psts223
|
||||
lappend sans [list testPing sans.psi.ch]
|
||||
lappend sans [list testEL734 $ts 3002]
|
||||
lappend sans [list testEL734 $ts 3003]
|
||||
lappend sans [list testEL734 $ts 3004]
|
||||
lappend sans [list testEL737 $ts 3005]
|
||||
lappend sans [list testVelo $ts 3006]
|
||||
lappend sans [list testSPS $ts 3009]
|
||||
lappend sans [list testSPS $ts 3010]
|
||||
#---------- another count of TIWI
|
||||
|
||||
set ts psts234
|
||||
lappend sansli [list testPing sans2.psi.ch]
|
||||
lappend sansli [list testEL734 $ts 3002]
|
||||
lappend sansli [list testEL734 $ts 3003]
|
||||
lappend sansli [list testVelo $ts 3004]
|
||||
lappend sansli [list testEL737 $ts 3009]
|
||||
|
||||
set ts psts231
|
||||
lappend tasp [list testPing tasp.psi.ch]
|
||||
lappend tasp [list testEL734 $ts 3002]
|
||||
lappend tasp [list testEL734 $ts 3003]
|
||||
lappend tasp [list testEL737 $ts 3004]
|
||||
|
||||
set ts lnsts05
|
||||
lappend trics [list testPing trics.psi.ch]
|
||||
lappend trics [list testEL734 $ts 3002]
|
||||
lappend trics [list testEL734 $ts 3003]
|
||||
lappend trics [list testEL734 $ts 3004]
|
||||
lappend trics [list testEL734 $ts 3005]
|
||||
lappend trics [list testEL734 $ts 3006]
|
||||
lappend trics [list testEL737 $ts 3007]
|
||||
lappend trics [list testHM lnse07]
|
||||
lappend trics [list testHM lnse08]
|
||||
lappend trics [list testHM lnse09]
|
||||
|
||||
#====================== "main" program ===================
|
||||
if {$argc < 1} {
|
||||
puts stdout "Usage:\n\tsinqcom instrument"
|
||||
exit 1
|
||||
}
|
||||
puts stdout "=== This program will fail if SICS ist still running! ==="
|
||||
puts stdout "=== This program will also fail if not run from a computer within the SINQ subnet ==="
|
||||
|
||||
switch [lindex $argv 0] {
|
||||
amor {testList $amor}
|
||||
dmc {testList $dmc}
|
||||
focus {testList $focus}
|
||||
hrpt {testList $hrpt}
|
||||
mars {testList $mars}
|
||||
morpheus {testList $morpheus}
|
||||
narziss {testList $narziss}
|
||||
poldi {testList $poldi}
|
||||
rita2 {testList $rita2}
|
||||
sans {testList $sans}
|
||||
sans2 {testList $sansli}
|
||||
sansli {testList $sansli}
|
||||
tasp {testList $tasp}
|
||||
trics {testList $trics}
|
||||
default {"Instrument not known"
|
||||
exit 1
|
||||
}
|
||||
}
|
||||
puts stdout "Done"
|
||||
exit 0
|
||||
Reference in New Issue
Block a user