- 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
2007-04-26 14:34:58 +00:00
parent 524dac0fbf
commit a24f56e7fb
14 changed files with 303 additions and 122 deletions

View File

@ -21,6 +21,8 @@ config rights lnsmanager lnsSICSlns
#--------- remember soz position #--------- remember soz position
set sozpos [SICSValue soz] set sozpos [SICSValue soz]
standardPrelude $instrument count
set notList [list chopperspeed chopper1phase chopper2phase ch1ph ch2ph chsp] set notList [list chopperspeed chopper1phase chopper2phase ch1ph ch2ph chsp]
lappend notList aby pby lappend notList aby pby
@ -68,10 +70,6 @@ lappend varList [list "d5b sign" -1 .1]
lappend varList [list "com sign" -1 .1] lappend varList [list "com sign" -1 .1]
lappend varList [list "cox sign" -1 .1] lappend varList [list "cox sign" -1 .1]
exe upload
exe append counter setthreshold 1 0
exe append count timer 120
exe forcesave insttestbatch.tcl
lappend interruptList "drive soz 90" lappend interruptList "drive soz 90"
lappend interruptList "count timer 120" lappend interruptList "count timer 120"
@ -107,6 +105,7 @@ if {$det == 1} {
} }
#--------- put detector back where it was #--------- put detector back where it was
drive soz $sozpos drive soz $sozpos
standardRestore
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]
@ -114,3 +113,4 @@ puts stdout "Test Summary for $inst"
printStandardSummary $counters printStandardSummary $counters
puts stdout "Chopper NOT tested!!" puts stdout "Chopper NOT tested!!"
exit

View File

@ -19,12 +19,12 @@ initSicsDebug $instrument
config rights lnsmanager lnsSICSlns config rights lnsmanager lnsSICSlns
#---------- configuration #---------- configuration
set notList [list nvs]
lappend commandList "counter setthreshold 1 0" standardPrelude $instrument count
lappend notList ""
lappend commandList "count timer 2" lappend commandList "count timer 2"
lappend commandList "repeat 2" lappend commandList "repeat 2"
lappend commandList "counter setthreshold 1 2"
lappend commandList "wwwsics" lappend commandList "wwwsics"
lappend varList [list "mono dd" 3.3537 .1] lappend varList [list "mono dd" 3.3537 .1]
@ -33,12 +33,8 @@ lappend varList [list "mono vk1" -.00259 .1]
lappend varList [list "mono vk2" 5.35166 .1] lappend varList [list "mono vk2" 5.35166 .1]
set om [SICSValue a3] set om [SICSValue a3]
exe upload
exe append drive a3 180.
exe append drive a3 $om
exe forcesave insttestbatch.tcl
lappend interruptList "drive a3 180" lappend interruptList "drive a3 20"
lappend interruptList "count timer 120" lappend interruptList "count timer 120"
lappend interruptList "exe insttestbatch.tcl" lappend interruptList "exe insttestbatch.tcl"
@ -72,6 +68,8 @@ if {$det == 1} {
} }
drive a3 $om drive a3 $om
standardRestore
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]
puts stdout "Test Summary for $inst" puts stdout "Test Summary for $inst"

View File

@ -16,10 +16,12 @@ if {$argc > 0} {
} }
initSicsDebug $instrument initSicsDebug $instrument
config rights lnsmanager lnsSICSlns config rights lnsmanager lnsFOCUSlns
standardPrelude $instrument count
#---------- configuration #---------- configuration
set notList [list fermispeed diskspeed phase ratio intervall] set notList [list fermispeed diskspeed phase ratio intervall ei mtt]
lappend commandList "count timer 2" lappend commandList "count timer 2"
lappend commandList "repeat 2" lappend commandList "repeat 2"
@ -27,16 +29,17 @@ lappend commandList "wwwsics"
lappend commandList "hm genbin 10 25 333" lappend commandList "hm genbin 10 25 333"
lappend commandList "hm init" lappend commandList "hm init"
catch {sicscommand "exe upload"} msg
catch {sicscommand "exe append counter setthreshold 1 0"} msg
catch {sicscommand "exe append count timer 120"} msg
catch {sicscommand "exe forcesave insttestbatch.tcl"} msg
lappend varList [list flightpathlength 3000 5] lappend varList [list flightpathlength 3000 5]
lappend varList [list fermidist 3000 5] lappend varList [list fermidist 3000 5]
lappend varList [list detectordist 2500 5] lappend varList [list detectordist 2500 5]
lappend varList [list sampledist 499.7 1] lappend varList [list sampledist 499.7 1]
lappend varList [list "mono dd" 3.355 .1] lappend varList [list "mono dd" 3.355 .1]
exe upload
exe append count timer 120
exe forcesave insttestbatch.tcl
lappend interruptList "count timer 120" lappend interruptList "count timer 120"
lappend interruptList "exe insttestbatch.tcl" lappend interruptList "exe insttestbatch.tcl"
@ -49,11 +52,14 @@ set par(commandList) $commandList
set par(interruptList) $interruptList set par(interruptList) $interruptList
set par(instrument) $instrument set par(instrument) $instrument
set par(user) lnsmanager set par(user) lnsmanager
set par(password) lnsSICSlns set par(password) lnsFOCUSlns
set par(varList) $varList set par(varList) $varList
#================= actually test ===================================== #================= actually test =====================================
set counters [runStandardTests par] set counters [runStandardTests par]
standardRestore
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]
puts stdout "Test Summary for $inst" puts stdout "Test Summary for $inst"

View File

@ -18,6 +18,8 @@ if {$argc > 0} {
initSicsDebug $instrument initSicsDebug $instrument
config rights lnsmanager lnsSICSlns config rights lnsmanager lnsSICSlns
standardPrelude $instrument count
#---------- configuration #---------- configuration
set notList [list nvs] set notList [list nvs]
@ -69,6 +71,7 @@ if {$det == 1} {
} }
#---------- drive sample rotation back #---------- drive sample rotation back
drive a3 $om drive a3 $om
standardRestore
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]

View File

@ -1,7 +1,7 @@
#-------------------------------------------------------------------------- #--------------------------------------------------------------------------
# This is a set of utilities for testing SICServers on instruments # This is a set of utilities for testing SICServers on instruments
# #
# Mark Koennecke, November 2006 # Mark Koennecke, November 2006, March 2007
#------------------------------------------------------------------------- #-------------------------------------------------------------------------
proc testInventory {inventory} { proc testInventory {inventory} {
set txt [sicscommand list] set txt [sicscommand list]
@ -38,6 +38,7 @@ proc testMotors {drivecommand motorList notList} {
set failed 0 set failed 0
foreach mot $motorList { foreach mot $motorList {
if {[lsearch $notList $mot] < 0 } { if {[lsearch $notList $mot] < 0 } {
puts stdout "Testing $mot"
set rawVal [eval $mot] set rawVal [eval $mot]
if {[string first ERROR $rawVal] >= 0} { if {[string first ERROR $rawVal] >= 0} {
puts stdout "MOTOR: failed to read $mot, error $rawVal" puts stdout "MOTOR: failed to read $mot, error $rawVal"
@ -54,21 +55,22 @@ proc testMotors {drivecommand motorList notList} {
} }
set newval [expr $val + $move] set newval [expr $val + $move]
set status [catch {eval $drivecommand $mot $newval} msg] set status [catch {eval $drivecommand $mot $newval} msg]
if {$status != 0} { if {[string first ERROR $msg] >= 0 } {
#------------ if we went into a limit, we try the other direction #------------ if we went into a limit, we try the other direction
if {[string first limit $msg] > 0} { if {[string first limit $msg] > 0} {
set newval [expr $val - $move] set newval [expr $val - $move]
set status [catch {eval $drivecommand $mot $newval} msg] set status [catch {eval $drivecommand $mot $newval} msg]
} }
} }
if {$status != 0} { if {[string first ERROR $msg] >= 0} {
puts stdout "MOTOR: failed to drive $mot with $msg" puts stdout "MOTOR: failed to drive $mot with $msg"
incr failed incr failed
continue
} }
#---------- drive back #---------- drive back
set status [catch {eval $drivecommand $mot $val} msg] set status [catch {eval $drivecommand $mot $val} msg]
if {$status != 0} { if {[string first ERROR $msg] >= 0 } {
puts stdout "MOTOR: failed to drive $mot with $msg" puts stdout "MOTOR: failed to drive $mot back with $msg"
incr failed incr failed
} }
} }
@ -121,6 +123,7 @@ proc testCommand args {
proc testCommandList {commandList} { proc testCommandList {commandList} {
set count 0 set count 0
foreach command $commandList { foreach command $commandList {
puts stdout "Testing $command"
if {![testCommand $command]} { if {![testCommand $command]} {
incr count incr count
} }
@ -262,3 +265,29 @@ proc SICSValue {command} {
set l [split $txt =] set l [split $txt =]
return [string trim [lindex $l 1]] return [string trim [lindex $l 1]]
} }
#----------------------------------------------------------------------
proc standardPrelude {inst {count co}} {
global __threshold __batchpath
set __threshold [SICSValue "counter getthreshold 1"]
set __batchpath [SICSValue "exe batchpath"]
if {[string compare $inst local] == 0} {
catch {sicscommand "exe batchpath /$env(HOME)/tmp"} msg
} else {
catch {sicscommand "exe batchpath /home/$inst/tmp"} msg
}
catch {sicscommand "scan mode timer"} msg
catch {sicscommand "counter setmode timer"} msg
catch {sicscommand "counter setthreshold 1 0"} msg
catch {sicscommand "exe upload"} msg
catch {sicscommand "exe append counter setthreshold 1 0"} msg
catch {sicscommand "exe append $count timer 120"} msg
catch {sicscommand "exe forcesave insttestbatch.tcl"} msg
}
#----------------------------------------------------------------------
proc standardRestore {} {
global __threshold __batchpath
catch {sicscommand "exe batchpath $__batchpath"} msg
catch {sicscommand "scan mode monitor"} msg
catch {sicscommand "counter setmode monitor"} msg
catch {sicscommand "counter setthreshold 1 $__threshold"} msg
}

View File

@ -12,8 +12,15 @@ if {$argc < 3} {
source sicstcldebug.tcl source sicstcldebug.tcl
initSicsDebug [lindex $argv 0] initSicsDebug [lindex $argv 0]
config rights [lindex $argv 1] [lindex $argv 2] config rights [lindex $argv 1] [lindex $argv 2]
for {set i 0} {$i < 5} {incr i} {
exec sleep 5 exec sleep 5
set txt [sicscommand status]
if {[string first Eager $txt] < 0} {
puts $socke "INT1712 3" puts $socke "INT1712 3"
break
}
}
sicscommand logoff
exit 0 exit 0

View File

@ -16,16 +16,20 @@ if {$argc > 0} {
} }
initSicsDebug $instrument initSicsDebug $instrument
config rights lnsmanager lnsSICSlns config rights lnsmanager lnsMARSlns
set th [SICSValue th01] set th [SICSValue th01]
if {[string equal $instrument local]} { if {[string equal $instrument local]} {
colldr tf 12 colldr tf 12
} }
standardPrelude $instrument count
set thresh [SICSValue "el737 getthrehold 1"]
#---------- configuration #---------- configuration
lappend notList chopperspeed snailphase masterphase rabbitphase fourphase lappend notList chopperspeed snailphase masterphase rabbitphase fourphase
lappend notList fivephase s1phase mphase s2phase s3phase s4phase mspeed lappend notList fivephase s1phase mphase s2phase s3phase s4phase mspeed
lappend notList masterspeed
lappend commandList "count timer 2" lappend commandList "count timer 2"
lappend commandList "repeat 2" lappend commandList "repeat 2"
@ -34,11 +38,6 @@ lappend commandList "marsupdateinfo"
lappend commandList "colldr th 86." lappend commandList "colldr th 86."
exe upload
exe append count timer 120
exe append count timer 120
exe forcesave insttestbatch.tcl
lappend interruptList "colldr th 77." lappend interruptList "colldr th 77."
lappend interruptList "count timer 120" lappend interruptList "count timer 120"
lappend interruptList "exe insttestbatch.tcl" lappend interruptList "exe insttestbatch.tcl"
@ -74,9 +73,13 @@ if {$det == 1} {
#--------- put detector back where it was #--------- put detector back where it was
colldr th $th colldr th $th
standardRestore
el737 setthreshold 1 $thresh
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]
puts stdout "Test Summary for $inst" puts stdout "Test Summary for $inst"
printStandardSummary $counters printStandardSummary $counters
puts stdout "Choppers NOT tested!!" puts stdout "Choppers NOT tested!!"
exit

View File

@ -2,7 +2,7 @@
#------------------------------------------------------------------------- #-------------------------------------------------------------------------
# This is the regression test for SICS on the MORPHEUS instrument # This is the regression test for SICS on the MORPHEUS instrument
# #
# Mark Koennecke, November 2006 # Mark Koennecke, November 2006, March 2007
#------------------------------------------------------------------------ #------------------------------------------------------------------------
source sicstcldebug.tcl source sicstcldebug.tcl
source insttestutil.tcl source insttestutil.tcl
@ -20,10 +20,11 @@ config rights lnsmanager lnsSICSlns
#--------- remember soz position #--------- remember soz position
set sompos [SICSValue som] set sompos [SICSValue som]
standardPrelude $instrument
set notList [list dil nv] set notList [list dil nv h k l cone utz uty sgx sgy scx scy chi phi po1 po2 \
sch sph atx aty ana]
lappend commandList "counter setthreshold 1 0"
lappend commandList "cscan som 0 .1 2 2" lappend commandList "cscan som 0 .1 2 2"
lappend commandList "sscan som 0. .1 3 2" lappend commandList "sscan som 0. .1 3 2"
lappend commandList "wwwsics" lappend commandList "wwwsics"
@ -31,12 +32,6 @@ lappend commandList "wwwsics"
lappend varList [list "mono dd" 3.354 .1] lappend varList [list "mono dd" 3.354 .1]
lappend varList [list "mono ss" -1 .1] lappend varList [list "mono ss" -1 .1]
exe upload
exe append counter setthreshold 1 0
exe append co timer 120
exe forcesave insttestbatch.tcl
lappend interruptList "drive som 90" lappend interruptList "drive som 90"
lappend interruptList "co timer 120" lappend interruptList "co timer 120"
lappend interruptList "exe insttestbatch.tcl" lappend interruptList "exe insttestbatch.tcl"
@ -58,9 +53,12 @@ set counters [runStandardTests par]
#--------- put detector back where it was #--------- put detector back where it was
drive som $sompos drive som $sompos
standardRestore
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]
puts stdout "Test Summary for $inst" puts stdout "Test Summary for $inst"
printStandardSummary $counters printStandardSummary $counters
exit

View File

@ -2,7 +2,7 @@
#------------------------------------------------------------------------- #-------------------------------------------------------------------------
# This is the regression test for SICS on the NARZISS instrument # This is the regression test for SICS on the NARZISS instrument
# #
# Mark Koennecke, November 2006 # Mark Koennecke, November 2006, March 2007
#------------------------------------------------------------------------ #------------------------------------------------------------------------
source sicstcldebug.tcl source sicstcldebug.tcl
source insttestutil.tcl source insttestutil.tcl
@ -20,20 +20,16 @@ config rights lnsmanager lnsSICSlns
#--------- remember soz position #--------- remember soz position
set sompos [SICSValue som] set sompos [SICSValue som]
standardPrelude $instrument
set notList [list dil nv] set notList [list nv dil]
lappend commandList "counter setthreshold 1 0"
lappend commandList "cscan som 0 .1 2 2" lappend commandList "cscan som 0 .1 2 2"
lappend commandList "sscan som 0. .1 3 2" lappend commandList "sscan som 0. .1 3 2"
lappend commandList "wwwsics" lappend commandList "wwwsics"
exe upload
exe append counter setthreshold 1 0
exe append co timer 120
exe forcesave insttestbatch.tcl
lappend interruptList "drive som 90" lappend interruptList "drive som 15"
lappend interruptList "co timer 120" lappend interruptList "co timer 120"
lappend interruptList "exe insttestbatch.tcl" lappend interruptList "exe insttestbatch.tcl"
@ -53,9 +49,12 @@ set counters [runStandardTests par]
#--------- put om #--------- put om
drive som $sompos drive som $sompos
standardRestore
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]
puts stdout "Test Summary for $inst" puts stdout "Test Summary for $inst"
printStandardSummary $counters printStandardSummary $counters
exit

View File

@ -18,6 +18,8 @@ if {$argc > 0} {
initSicsDebug $instrument initSicsDebug $instrument
config rights lnsmanager lnsSICSlns config rights lnsmanager lnsSICSlns
standardPreluse $instrument count
#---------- configuration #---------- configuration
set notList [list chopperspeed] set notList [list chopperspeed]
@ -37,10 +39,6 @@ lappend varList [list x0_det -840 .5]
lappend varList [list y0_det -880 .5] lappend varList [list y0_det -880 .5]
lappend varList [list det_size 1.25 .5] lappend varList [list det_size 1.25 .5]
exe upload
exe append count timer 120
exe forcesave insttestbatch.tcl
lappend interruptList "count timer 120" lappend interruptList "count timer 120"
lappend interruptList "exe insttestbatch.tcl" lappend interruptList "exe insttestbatch.tcl"
@ -58,6 +56,8 @@ set par(varList) $varList
#================= actually test ===================================== #================= actually test =====================================
set counters [runStandardTests par] set counters [runStandardTests par]
standardRestore
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]
puts stdout "Test Summary for $inst" puts stdout "Test Summary for $inst"

View File

@ -20,6 +20,9 @@ config rights lnsmanager lnsSICSlns
set ompos [SICSValue a3] set ompos [SICSValue a3]
backup beforetest.tcl backup beforetest.tcl
standardPrelude $instrument
#---------- configuration #---------- configuration
exe upload exe upload
exe append sc a3 0 da3 .1 np 2 ti 2 exe append sc a3 0 da3 .1 np 2 ti 2
@ -102,6 +105,7 @@ if {$det == 1} {
puts stdout "Check detector, found no noise after 10 minutes counting" puts stdout "Check detector, found no noise after 10 minutes counting"
} }
#--------- put detector back where it was #--------- put detector back where it was
standardRestore
recover beforetest.tcl recover beforetest.tcl
dr om $ompos dr om $ompos

View File

@ -18,6 +18,8 @@ if {$argc > 0} {
initSicsDebug $instrument initSicsDebug $instrument
config rights lnsmanager lnsSICSlns config rights lnsmanager lnsSICSlns
standradPrelude $instrument count
#--------- remember detector position... #--------- remember detector position...
set detpos [SICSValue detectorx] set detpos [SICSValue detectorx]
bsin bsin
@ -41,11 +43,6 @@ lappend commandList "hmframe 0"
lappend commandList "fileframe 0 0" lappend commandList "fileframe 0 0"
exe upload
exe append drive detectorx 3.
exe append drive detectorx 18.
exe forcesave insttestbatch.tcl
lappend interruptList "drive detectorx 18." lappend interruptList "drive detectorx 18."
lappend interruptList "count timer 120" lappend interruptList "count timer 120"
lappend interruptList "exe insttestbatch.tcl" lappend interruptList "exe insttestbatch.tcl"
@ -79,6 +76,7 @@ if {$det == 1} {
} }
#--------- put detector back where it was #--------- put detector back where it was
drive detectorx $detpos drive detectorx $detpos
standardRestore
#------------ print a summary #------------ print a summary
set inst [string toupper $instrument] set inst [string toupper $instrument]

View File

@ -1,4 +1,4 @@
##!/usr/bin/tclsh #!/usr/bin/tclsh
#------------------------------------------------------------------------- #-------------------------------------------------------------------------
# This program tests the communication to the various devices # This program tests the communication to the various devices
# belonging to an instrument. For this to work, the SICServer # belonging to an instrument. For this to work, the SICServer
@ -6,7 +6,7 @@
# #
# Mark Koennecke, November 2006 # Mark Koennecke, November 2006
#------------------------------------------------------------------------ #------------------------------------------------------------------------
set debug 1 set debug 0
#----------------------------------------------------------------------- #-----------------------------------------------------------------------
proc pingTest {host} { proc pingTest {host} {
set status [catch {exec ping -c 5 $host} msg] set status [catch {exec ping -c 5 $host} msg]
@ -29,11 +29,12 @@ proc timeout {} {
#----------------------------------------------------------------------- #-----------------------------------------------------------------------
proc sendCommand {chan command} { proc sendCommand {chan command} {
global replyData debug global replyData debug
puts $chan $command puts -nonewline $chan $command
flush $chan flush $chan
if {$debug == 1} { if {$debug == 1} {
puts stdout "Sent $command" puts stdout "Sent $command"
} }
after 300
after 20000 timeout after 20000 timeout
vwait replyData vwait replyData
if {$debug == 1} { if {$debug == 1} {
@ -48,6 +49,12 @@ proc makeConnection {host port} {
fileevent $socke readable [list readReply $socke] fileevent $socke readable [list readReply $socke]
return $socke return $socke
} }
#-----------------------------------------------------------------------
proc makeJuelichConnection {host port} {
set socke [socket $host $port]
fconfigure $socke -blocking 0 -encoding binary
return $socke
}
#------------------------------------------------------------------------ #------------------------------------------------------------------------
proc testEL737 {host port} { proc testEL737 {host port} {
puts stdout "Testing for EL737 counter at $host $port" puts stdout "Testing for EL737 counter at $host $port"
@ -55,12 +62,12 @@ proc testEL737 {host port} {
error $msg error $msg
} }
set socke [makeConnection $host $port] set socke [makeConnection $host $port]
sendCommand $socke "RMT 1\r\n" sendCommand $socke "RMT 1\r"
sendCommand $socke "RMT 1\r\n" sendCommand $socke "ECHO 0\r"
sendCommand $socke "ECHO 0\r\n" sendCommand $socke "RMT 1\r"
sendCommand $socke "ECHO 0\r\n" sendCommand $socke "ECHO 0\r"
for {set i 0} {$i < 3} {incr i} { 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} { if {[string first EL737 $replyData] >= 0} {
close $socke close $socke
return OK return OK
@ -76,12 +83,12 @@ proc testEL734 {host port} {
error $msg error $msg
} }
set socke [makeConnection $host $port] set socke [makeConnection $host $port]
sendCommand $socke "RMT 1\n" sendCommand $socke "RMT 1\r"
sendCommand $socke "ECHO 0\n" sendCommand $socke "ECHO 0\r"
sendCommand $socke "RMT 1\n" sendCommand $socke "RMT 1\r"
sendCommand $socke "ECHO 0\n" sendCommand $socke "ECHO 0\r"
for {set i 0} {$i < 10} {incr i} { 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} { if {[string first EL734 $replyData] >= 0} {
close $socke close $socke
return OK return OK
@ -92,27 +99,147 @@ proc testEL734 {host port} {
} }
#------------------------------------------------------------------------ #------------------------------------------------------------------------
proc testSPS {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} { 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} { 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} { 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} { 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} { 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} { proc testHM {host} {
@ -134,6 +261,7 @@ proc testHM {host} {
} }
#------------------------------------------------------------------------ #------------------------------------------------------------------------
proc testHttpHM {host} { proc testHttpHM {host} {
puts stdout "Testing Http-HM at $host"
if {[catch {pingTest $host} msg] != 0} { if {[catch {pingTest $host} msg] != 0} {
error $msg error $msg
} }
@ -163,7 +291,7 @@ proc testList {testList} {
} }
#======================= Database Section =============================== #======================= Database Section ===============================
set ts psts224 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 3002]
lappend amor [list testEL734 $ts 3003] lappend amor [list testEL734 $ts 3003]
lappend amor [list testEL734 $ts 3004] lappend amor [list testEL734 $ts 3004]
@ -175,13 +303,13 @@ lappend amor [list testMDIF $ts 3015]
lappend amor [list testHttpHM lnse10] lappend amor [list testHttpHM lnse10]
set ts psts225 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 testEL734 $ts 3002]
lappend dmc [list testEL737 $ts 3006] lappend dmc [list testEL737 $ts 3006]
lappend dmc [list testHM lnse01] lappend dmc [list testHM lnse01]
set ts psts227 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 3002]
lappend focus [list testEL734 $ts 3003] lappend focus [list testEL734 $ts 3003]
lappend focus [list testSPS $ts 3004] lappend focus [list testSPS $ts 3004]
@ -194,7 +322,7 @@ lappend focus [list testHM lnse06.vme]
# Missing 2D detector and MDIF # Missing 2D detector and MDIF
set ts psts229 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 3002]
lappend hrpt [list testEL734 $ts 3003] lappend hrpt [list testEL734 $ts 3003]
lappend hrpt [list testEL734 $ts 3004] lappend hrpt [list testEL734 $ts 3004]
@ -204,7 +332,7 @@ lappend hrpt [list testSPS $ts 3008]
lappend hrpt [list testHM lnse03] lappend hrpt [list testHM lnse03]
set ts psts235 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 3002]
lappend mars [list testEL734 $ts 3003] lappend mars [list testEL734 $ts 3003]
lappend mars [list testEL734 $ts 3004] lappend mars [list testEL734 $ts 3004]
@ -217,7 +345,7 @@ lappend mars [list testMDIF $ts 3010]
lappend mars [list testHttpHM lnse13] lappend mars [list testHttpHM lnse13]
set ts lnsts06 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 3002]
lappend morpheus [list testEL734 $ts 3003] lappend morpheus [list testEL734 $ts 3003]
lappend morpheus [list testEL734 $ts 3004] lappend morpheus [list testEL734 $ts 3004]
@ -226,13 +354,13 @@ lappend morpheus [list testSPS $ts 3006]
set ts psts230 set ts psts230
#stimmt das noch? Ist da nicht dieser moxa drinne? #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 testEL734 $ts 3002]
lappend narziss [list testEL737 $ts 3003] lappend narziss [list testEL737 $ts 3003]
set ts psts240 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 3002]
lappend poldi [list testEL734 $ts 3003] lappend poldi [list testEL734 $ts 3003]
lappend poldi [list testEL737 $ts 3004] lappend poldi [list testEL737 $ts 3004]
@ -241,38 +369,38 @@ lappend poldi [list testHM lnse11]
#------ missing TIWI electronic #------ missing TIWI electronic
set ts lnsts02 set ts lnsts02
lappend rita2 [list testPing rita2.psi.ch] lappend rita2 [list pingTest rita2.psi.ch]
lappend rita2 [list testPing lnsgpib01.psi.ch] lappend rita2 [list pingTest lnsgpib01.psi.ch]
lappend rita2 [list testEL734 $ts 3002] lappend rita2 [list testEL734 $ts 3002]
lappend rita2 [list testEL737 $ts 3005] lappend rita2 [list testEL737 $ts 3005]
#-------- can GPIB communication more sensibly be tested??? #-------- can GPIB communication more sensibly be tested???
set ts psts223 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 3002]
lappend sans [list testEL734 $ts 3003] lappend sans [list testEL734 $ts 3003]
lappend sans [list testEL734 $ts 3004] lappend sans [list testEL734 $ts 3016]
lappend sans [list testEL737 $ts 3005] lappend sans [list testEL737 $ts 3004]
lappend sans [list testVelo $ts 3006] lappend sans [list testVelo $ts 3006]
lappend sans [list testSPS $ts 3009] lappend sans [list testSPS $ts 3009]
lappend sans [list testSPS $ts 3010] lappend sans [list testSPS $ts 3010]
#---------- another count of TIWI #---------- another count of TIWI
set ts psts234 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 3002]
lappend sansli [list testEL734 $ts 3003] lappend sansli [list testEL734 $ts 3003]
lappend sansli [list testVelo $ts 3004] lappend sansli [list testVelo $ts 3004]
lappend sansli [list testEL737 $ts 3009] lappend sansli [list testEL737 $ts 3009]
set ts psts231 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 3002]
lappend tasp [list testEL734 $ts 3003] lappend tasp [list testEL734 $ts 3003]
lappend tasp [list testEL737 $ts 3004] lappend tasp [list testEL737 $ts 3004]
set ts lnsts05 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 3002]
lappend trics [list testEL734 $ts 3003] lappend trics [list testEL734 $ts 3003]
lappend trics [list testEL734 $ts 3004] lappend trics [list testEL734 $ts 3004]
@ -283,15 +411,15 @@ lappend trics [list testHM lnse07]
lappend trics [list testHM lnse08] lappend trics [list testHM lnse08]
lappend trics [list testHM lnse09] lappend trics [list testHM lnse09]
#====================== "main" program =================== #--------------------------------------------------------
if {$argc < 1} { proc exitus {no} {
puts stdout "Usage:\n\tsinqcom instrument" exit $no
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 ===" proc testInstrument {inst} {
global amor dmc focus hrpt mars narziss poldi rita2
switch [lindex $argv 0] { global sans sansli tasp trics
switch $inst {
amor {testList $amor} amor {testList $amor}
dmc {testList $dmc} dmc {testList $dmc}
focus {testList $focus} focus {testList $focus}
@ -307,8 +435,20 @@ switch [lindex $argv 0] {
tasp {testList $tasp} tasp {testList $tasp}
trics {testList $trics} trics {testList $trics}
default {"Instrument not known" default {"Instrument not known"
exit 1 exitus 1
} }
} }
}
#====================== "main" program ===================
if {$argc < 1} {
puts stdout "Usage:\n\tsinqcom instrument"
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 ==="
puts stdout "=== computer within the SINQ subnet ==="
testInstrument [lindex $argv 0]
puts stdout "Done" puts stdout "Done"
exit 0 exitus 0

View File

@ -21,6 +21,7 @@ config rights lnsmanager lnsSICSlns
#--------- remember soz position #--------- remember soz position
set sompos [SICSValue om] set sompos [SICSValue om]
backup beforetest.tcl backup beforetest.tcl
standardPrelude $instrument count
set notList [list dil nv cone] set notList [list dil nv cone]
@ -58,12 +59,6 @@ lappend varList [list sttoffset3 1.4 .5]
lappend varList [list dist2 550 120] lappend varList [list dist2 550 120]
lappend varList [list dist3 550 120] lappend varList [list dist3 550 120]
exe upload
exe append counter setthreshold 1 0
exe append count timer 120
exe forcesave insttestbatch.tcl
lappend interruptList "drive om 90" lappend interruptList "drive om 90"
lappend interruptList "count timer 120" lappend interruptList "count timer 120"
lappend interruptList "exe insttestbatch.tcl" lappend interruptList "exe insttestbatch.tcl"
@ -84,6 +79,7 @@ set counters [runStandardTests par]
#--------- put om back where it was #--------- put om back where it was
drive om $sompos drive om $sompos
standardRestore
recover beforetest.tcl recover beforetest.tcl
#------------ print a summary #------------ print a summary