- Most instrument test files have been tested
- sinqcom undwerwent extension to cover more devices and is now more or less finished
This commit is contained in:
koennecke
256
insttest/sinqcom
256
insttest/sinqcom
@ -1,4 +1,4 @@
|
||||
##!/usr/bin/tclsh
|
||||
#!/usr/bin/tclsh
|
||||
#-------------------------------------------------------------------------
|
||||
# This program tests the communication to the various devices
|
||||
# belonging to an instrument. For this to work, the SICServer
|
||||
@ -6,7 +6,7 @@
|
||||
#
|
||||
# Mark Koennecke, November 2006
|
||||
#------------------------------------------------------------------------
|
||||
set debug 1
|
||||
set debug 0
|
||||
#-----------------------------------------------------------------------
|
||||
proc pingTest {host} {
|
||||
set status [catch {exec ping -c 5 $host} msg]
|
||||
@ -29,11 +29,12 @@ proc timeout {} {
|
||||
#-----------------------------------------------------------------------
|
||||
proc sendCommand {chan command} {
|
||||
global replyData debug
|
||||
puts $chan $command
|
||||
puts -nonewline $chan $command
|
||||
flush $chan
|
||||
if {$debug == 1} {
|
||||
puts stdout "Sent $command"
|
||||
}
|
||||
after 300
|
||||
after 20000 timeout
|
||||
vwait replyData
|
||||
if {$debug == 1} {
|
||||
@ -48,6 +49,12 @@ proc makeConnection {host port} {
|
||||
fileevent $socke readable [list readReply $socke]
|
||||
return $socke
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
proc makeJuelichConnection {host port} {
|
||||
set socke [socket $host $port]
|
||||
fconfigure $socke -blocking 0 -encoding binary
|
||||
return $socke
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testEL737 {host port} {
|
||||
puts stdout "Testing for EL737 counter at $host $port"
|
||||
@ -55,12 +62,12 @@ proc testEL737 {host port} {
|
||||
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"
|
||||
sendCommand $socke "RMT 1\r"
|
||||
sendCommand $socke "ECHO 0\r"
|
||||
sendCommand $socke "RMT 1\r"
|
||||
sendCommand $socke "ECHO 0\r"
|
||||
for {set i 0} {$i < 3} {incr i} {
|
||||
set replyData [sendCommand $socke "ID\r\n"]
|
||||
set replyData [sendCommand $socke "ID\r"]
|
||||
if {[string first EL737 $replyData] >= 0} {
|
||||
close $socke
|
||||
return OK
|
||||
@ -76,12 +83,12 @@ proc testEL734 {host port} {
|
||||
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"
|
||||
sendCommand $socke "RMT 1\r"
|
||||
sendCommand $socke "ECHO 0\r"
|
||||
sendCommand $socke "RMT 1\r"
|
||||
sendCommand $socke "ECHO 0\r"
|
||||
for {set i 0} {$i < 10} {incr i} {
|
||||
set replyData [sendCommand $socke "ID\n"]
|
||||
set replyData [sendCommand $socke "ID\r"]
|
||||
if {[string first EL734 $replyData] >= 0} {
|
||||
close $socke
|
||||
return OK
|
||||
@ -92,27 +99,147 @@ proc testEL734 {host port} {
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testSPS {host port} {
|
||||
puts stdout "Testing SPS not yet implemented"
|
||||
puts stdout "Testing SPS at $host $port"
|
||||
set socke [makeConnection $host $port]
|
||||
set reply [sendCommand $socke "R\r\n"]
|
||||
close $socke
|
||||
if {![regexp {R [0-9]{3} [0-9]{3} [0-9]{3}} $reply]} {
|
||||
error "Bad reply $reply from SPS"
|
||||
}
|
||||
return OK
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testVelo {host port} {
|
||||
puts stdout "Testing velocity selector not yet implemented"
|
||||
global debug
|
||||
puts stdout "Testing velocity selector at $host, $port"
|
||||
set socke [socket $host $port]
|
||||
fconfigure $socke -blocking 0
|
||||
puts $socke "???\r\n"
|
||||
flush $socke
|
||||
set count 0
|
||||
for {set i 0} {$i < 20} {incr i} {
|
||||
after 1000
|
||||
set txt [gets $socke]
|
||||
if {[string length $txt] > 5} {
|
||||
set reply($count) $txt
|
||||
incr count
|
||||
}
|
||||
}
|
||||
close $socke
|
||||
if {$count < 1} {
|
||||
error "No reply from velocity selector"
|
||||
}
|
||||
if {[string first Status $reply(0)] < 0} {
|
||||
error "Bad velocity selector reply: $reply(0)"
|
||||
}
|
||||
if {[string first S_DREH $reply(0)] < 0} {
|
||||
error "Bad velocity selector reply: $reply(0)"
|
||||
}
|
||||
if {[string first I_DREH $reply(0)] < 0} {
|
||||
error "Bad velocity selector reply: $reply(0)"
|
||||
}
|
||||
if {$debug == 1} {
|
||||
puts stdout "$count lines received from chopper"
|
||||
for {set i 0} {$i < $count} {incr i} {
|
||||
puts stdout $reply($i)
|
||||
}
|
||||
}
|
||||
return OK
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testChopper {host port} {
|
||||
puts stdout "Testing Choppers not yet implemented"
|
||||
global debug
|
||||
puts stdout "Testing Dornier Chopper at $host, $port"
|
||||
set socke [socket $host $port]
|
||||
fconfigure $socke -blocking 0
|
||||
puts $socke "asyst 1\r\n"
|
||||
flush $socke
|
||||
set count 0
|
||||
for {set i 0} {$i < 20} {incr i} {
|
||||
after 1000
|
||||
set txt [gets $socke]
|
||||
if {[string length $txt] > 5} {
|
||||
set reply($count) $txt
|
||||
incr count
|
||||
}
|
||||
}
|
||||
close $socke
|
||||
if {$count < 2} {
|
||||
error "No or insufficient response from chopper"
|
||||
}
|
||||
if {[string first asyst $reply(0)] < 0} {
|
||||
error "Bad reply from chopper: $reply(0)"
|
||||
}
|
||||
if {[string first "..valid" $reply(0)] < 0} {
|
||||
error "Bad reply from chopper: $reply(0)"
|
||||
}
|
||||
if {[string first "chopp_1" $reply(1)] < 0} {
|
||||
error "Bad reply from chopper: $reply(1)"
|
||||
}
|
||||
if {$debug == 1} {
|
||||
puts stdout "$count lines received from chopper"
|
||||
for {set i 0} {$i < $count} {incr i} {
|
||||
puts stdout $reply($i)
|
||||
}
|
||||
}
|
||||
return OK
|
||||
}
|
||||
#----------------------------------------------------------------------
|
||||
proc juelichCheckSum {txt} {
|
||||
set checkSum 0
|
||||
for {set i 1} {$i < [string length $txt]} {incr i} {
|
||||
set c [scan [string index $txt $i] %c]
|
||||
set checkSum [expr $checkSum + $c]
|
||||
}
|
||||
return $checkSum
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testJuelich {host port} {
|
||||
puts stdout "Testing Juelich Choppers not yet implemented"
|
||||
puts stdout "Testing Juelich Choppers at $host $port"
|
||||
set ans "None"
|
||||
set checksum [juelichCheckSum "#RAS"]
|
||||
set command [format "#RAS{%d}$" $checksum]
|
||||
set sock [makeJuelichConnection $host $port]
|
||||
puts -nonewline $sock $command
|
||||
flush $sock
|
||||
for {set i 0} {$i < 3} {incr i} {
|
||||
after 1000
|
||||
set ans [read $sock 120]
|
||||
puts stdout $ans
|
||||
set stat [catch { \
|
||||
scan $ans "#RAS:%d:%d:%d:%d:%d{%d}" c1 c2 c3 c4 c5 check} num]
|
||||
if {$stat == 0} {
|
||||
if {$num == 6} {
|
||||
close $sock
|
||||
return OK
|
||||
}
|
||||
}
|
||||
}
|
||||
close $sock
|
||||
return "ERROR: did not get reply from Juelich, possibles ans: $ans"
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testEmmenegger {host port} {
|
||||
puts stdout "Testing Emmenegger electronic not yet implemented"
|
||||
puts stdout "Testing Emmenegger electronic at $host, $port"
|
||||
set sock [makeConnection $host $port]
|
||||
sendCommand $sock "D\r"
|
||||
set rep [sendCommand $sock "D\r"]
|
||||
close $sock
|
||||
if {![string is double $rep]} {
|
||||
error "Unexpected reply $rep from Emmenegger"
|
||||
}
|
||||
return OK
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testMDIF {host port} {
|
||||
puts stdout "Testing MDIF electronic not yet implemented"
|
||||
puts stdout "Testing MDIF at $host, $port"
|
||||
set sock [makeConnection $host $port]
|
||||
set rep [sendCommand $sock "TD\r"]
|
||||
close $sock
|
||||
if {[string first TD $rep] < 0} {
|
||||
error "Unexpected reply $rep from MDIF"
|
||||
}
|
||||
return 0K
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
proc testHM {host} {
|
||||
@ -134,6 +261,7 @@ proc testHM {host} {
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc testHttpHM {host} {
|
||||
puts stdout "Testing Http-HM at $host"
|
||||
if {[catch {pingTest $host} msg] != 0} {
|
||||
error $msg
|
||||
}
|
||||
@ -163,7 +291,7 @@ proc testList {testList} {
|
||||
}
|
||||
#======================= Database Section ===============================
|
||||
set ts psts224
|
||||
lappend amor [list testPing amor.psi.ch]
|
||||
lappend amor [list pingTest amor.psi.ch]
|
||||
lappend amor [list testEL734 $ts 3002]
|
||||
lappend amor [list testEL734 $ts 3003]
|
||||
lappend amor [list testEL734 $ts 3004]
|
||||
@ -175,13 +303,13 @@ lappend amor [list testMDIF $ts 3015]
|
||||
lappend amor [list testHttpHM lnse10]
|
||||
|
||||
set ts psts225
|
||||
lappend dmc [list testPing dmc.psi.ch]
|
||||
lappend dmc [list pingTest 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 pingTest focus.psi.ch]
|
||||
lappend focus [list testEL734 $ts 3002]
|
||||
lappend focus [list testEL734 $ts 3003]
|
||||
lappend focus [list testSPS $ts 3004]
|
||||
@ -194,7 +322,7 @@ lappend focus [list testHM lnse06.vme]
|
||||
# Missing 2D detector and MDIF
|
||||
|
||||
set ts psts229
|
||||
lappend hrpt [list testPing hrpt.psi.ch]
|
||||
lappend hrpt [list pingTest hrpt.psi.ch]
|
||||
lappend hrpt [list testEL734 $ts 3002]
|
||||
lappend hrpt [list testEL734 $ts 3003]
|
||||
lappend hrpt [list testEL734 $ts 3004]
|
||||
@ -204,7 +332,7 @@ lappend hrpt [list testSPS $ts 3008]
|
||||
lappend hrpt [list testHM lnse03]
|
||||
|
||||
set ts psts235
|
||||
lappend mars [list testPing mars.psi.ch]
|
||||
lappend mars [list pingTest mars.psi.ch]
|
||||
lappend mars [list testEL734 $ts 3002]
|
||||
lappend mars [list testEL734 $ts 3003]
|
||||
lappend mars [list testEL734 $ts 3004]
|
||||
@ -217,7 +345,7 @@ lappend mars [list testMDIF $ts 3010]
|
||||
lappend mars [list testHttpHM lnse13]
|
||||
|
||||
set ts lnsts06
|
||||
lappend morpheus [list testPing morpheus.psi.ch]
|
||||
lappend morpheus [list pingTest morpheus.psi.ch]
|
||||
lappend morpheus [list testEL734 $ts 3002]
|
||||
lappend morpheus [list testEL734 $ts 3003]
|
||||
lappend morpheus [list testEL734 $ts 3004]
|
||||
@ -226,13 +354,13 @@ 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 pingTest 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 pingTest poldi.psi.ch]
|
||||
lappend poldi [list testEL734 $ts 3002]
|
||||
lappend poldi [list testEL734 $ts 3003]
|
||||
lappend poldi [list testEL737 $ts 3004]
|
||||
@ -241,38 +369,38 @@ 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 pingTest rita2.psi.ch]
|
||||
lappend rita2 [list pingTest 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 pingTest 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 testEL734 $ts 3016]
|
||||
lappend sans [list testEL737 $ts 3004]
|
||||
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 pingTest 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 pingTest 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 pingTest trics.psi.ch]
|
||||
lappend trics [list testEL734 $ts 3002]
|
||||
lappend trics [list testEL734 $ts 3003]
|
||||
lappend trics [list testEL734 $ts 3004]
|
||||
@ -283,32 +411,44 @@ lappend trics [list testHM lnse07]
|
||||
lappend trics [list testHM lnse08]
|
||||
lappend trics [list testHM lnse09]
|
||||
|
||||
#--------------------------------------------------------
|
||||
proc exitus {no} {
|
||||
exit $no
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc testInstrument {inst} {
|
||||
global amor dmc focus hrpt mars narziss poldi rita2
|
||||
global sans sansli tasp trics
|
||||
switch $inst {
|
||||
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"
|
||||
exitus 1
|
||||
}
|
||||
}
|
||||
}
|
||||
#====================== "main" program ===================
|
||||
if {$argc < 1} {
|
||||
puts stdout "Usage:\n\tsinqcom instrument"
|
||||
exit 1
|
||||
exitus 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 ==="
|
||||
puts stdout "=== This program will fail if SICS ist still running! ==="
|
||||
puts stdout "=== This program will also fail if not run from a ==="
|
||||
puts stdout "=== computer within the SINQ subnet ==="
|
||||
|
||||
testInstrument [lindex $argv 0]
|
||||
|
||||
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
|
||||
exitus 0
|
||||
|
||||
Reference in New Issue
Block a user