- First version of instrument regression tests
- sinqcom is the first version of a communication testing program for instruments
This commit is contained in:
koennecke
116
insttest/amortest
Executable file
116
insttest/amortest
Executable file
@ -0,0 +1,116 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the AMOR instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source amorinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument amor
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#--------- remember soz position
|
||||||
|
set sozpos [SICSValue soz]
|
||||||
|
|
||||||
|
set notList [list chopperspeed chopper1phase chopper2phase ch1ph ch2ph chsp]
|
||||||
|
lappend notList aby pby
|
||||||
|
|
||||||
|
lappend commandList "counter setthreshold 1 0"
|
||||||
|
lappend commandList "count timer 20"
|
||||||
|
lappend commandList "cscan soz 0 .1 2 2"
|
||||||
|
lappend commandList "sscan soz 0. .1 3 2"
|
||||||
|
lappend commandList "repeat 2"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
lappend commandList "amorpar"
|
||||||
|
lappend commandList "amorstatus collapse"
|
||||||
|
lappend commandList "amorstatus singletof"
|
||||||
|
lappend commandList "amorstatus projectytof"
|
||||||
|
|
||||||
|
|
||||||
|
lappend varList [list "amorset chopper offset" 137.5 10]
|
||||||
|
lappend varList [list "amorset chopper scaleoffset" 0 1]
|
||||||
|
# TODO: slit1 when configured
|
||||||
|
lappend varList [list "amorset mono offset" 200.5 10]
|
||||||
|
lappend varList [list "amorset mono scaleoffset" 0 1]
|
||||||
|
lappend varList [list "amorset ds offset" -40 5]
|
||||||
|
lappend varList [list "amorset ds scaleoffset" 0 1]
|
||||||
|
lappend varList [list "amorset slit2 offset" 267. 5]
|
||||||
|
lappend varList [list "amorset ds scaleoffset" 0 1]
|
||||||
|
lappend varList [list "amorset slit3 offset" -53 5]
|
||||||
|
lappend varList [list "amorset slit3 scaleoffset" 0 1]
|
||||||
|
lappend varList [list "amorset slit4 offset" 270 5]
|
||||||
|
lappend varList [list "amorset slit4 scaleoffset" 0 1]
|
||||||
|
lappend varList [list "amorset sample offset" 308 5]
|
||||||
|
lappend varList [list "amorset sample scaleoffset" 0 1]
|
||||||
|
lappend varList [list "amorset slit5 offset" -54. 5]
|
||||||
|
lappend varList [list "amorset slit5 scaleoffset" 0 1]
|
||||||
|
lappend varList [list "amorset detector offset" 297 5]
|
||||||
|
lappend varList [list "amorset detector scaleoffset" 0 1]
|
||||||
|
lappend varList [list "amorset ana offset" 200 5]
|
||||||
|
lappend varList [list "amorset ana scaleoffset" 0 1]
|
||||||
|
lappend varList [list "d1b sign" -1 .1]
|
||||||
|
lappend varList [list "dbs sign" -1 .1]
|
||||||
|
lappend varList [list "d2b sign" -1 .1]
|
||||||
|
lappend varList [list "d3b sign" -1 .1]
|
||||||
|
lappend varList [list "d4b sign" -1 .1]
|
||||||
|
lappend varList [list "aom sign" -1 .1]
|
||||||
|
lappend varList [list "atz sign" -1 .1]
|
||||||
|
lappend varList [list "d5b sign" -1 .1]
|
||||||
|
lappend varList [list "com 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 "count timer 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- Test detection system
|
||||||
|
puts stdout "Testing detector"
|
||||||
|
set det 1
|
||||||
|
hm genbin 0 200000 2
|
||||||
|
hm init
|
||||||
|
count timer 600
|
||||||
|
set counts [SICSValue "hm sum 0 128 0 256"]
|
||||||
|
if {$counts <= 0} {
|
||||||
|
set det 0
|
||||||
|
}
|
||||||
|
if {$det == 1} {
|
||||||
|
puts stdout "Detector passed"
|
||||||
|
} else {
|
||||||
|
puts stdout "Check detector, found no noise after 10 minutes counting"
|
||||||
|
}
|
||||||
|
#--------- put detector back where it was
|
||||||
|
drive soz $sozpos
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
puts stdout "Chopper NOT tested!!"
|
||||||
|
|
||||||
73
insttest/analyzeinst
Executable file
73
insttest/analyzeinst
Executable file
@ -0,0 +1,73 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
# This script analyzes a given instrument. It connects to a running
|
||||||
|
# SICS server and queries it. From the query, a list of objects and
|
||||||
|
# drivables is output into a file in a format suitable to be
|
||||||
|
# included into a instrument testing script. These lists are then used
|
||||||
|
# to check the inventory of the SICS server and to check each motor.
|
||||||
|
# This can be extended to get even more lists of things to be checked
|
||||||
|
# automatically.
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
if {$argc < 1} {
|
||||||
|
puts stdout "Usage:\n\tanalyzeinst instrument"
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc writeInventory {out} {
|
||||||
|
set txt [sicscommand list]
|
||||||
|
set l [split $txt ,]
|
||||||
|
foreach obj $l {
|
||||||
|
if {[regexp {con[0-9]*} $obj] == 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
if {[string equal tt $obj] == 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
if {[string equal temperature $obj] == 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
if {[string first ENDLIST $obj] >= 0} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
if {[string equal sea $obj] == 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
if {[string equal tecs $obj] == 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
puts $out "lappend inventory $obj"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------------
|
||||||
|
proc writeMotors {out} {
|
||||||
|
set txt [sicscommand list interface drivable]
|
||||||
|
set l [split $txt ,]
|
||||||
|
foreach obj $l {
|
||||||
|
if {[string equal tt $obj] == 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
if {[string equal temperature $obj] == 1} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
if {[string first ENDLIST $obj] >= 0} {
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
puts $out "lappend motors $obj"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#======================= "MAIN" ======================================
|
||||||
|
set instrument [lindex $argv 0]
|
||||||
|
initSicsDebug $instrument
|
||||||
|
|
||||||
|
set filnam [format "%sinventory.tcl" $instrument]
|
||||||
|
set out [open $filnam w]
|
||||||
|
|
||||||
|
writeInventory $out
|
||||||
|
writeMotors $out
|
||||||
|
|
||||||
|
close $out
|
||||||
|
puts stdout Done
|
||||||
|
exit 0
|
||||||
80
insttest/dmctest
Executable file
80
insttest/dmctest
Executable file
@ -0,0 +1,80 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the DMC instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source dmcinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument dmc
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#---------- configuration
|
||||||
|
set notList [list nvs]
|
||||||
|
|
||||||
|
lappend commandList "counter setthreshold 1 0"
|
||||||
|
lappend commandList "count timer 2"
|
||||||
|
lappend commandList "repeat 2"
|
||||||
|
lappend commandList "counter setthreshold 1 2"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
|
||||||
|
lappend varList [list "mono dd" 3.3537 .1]
|
||||||
|
lappend varList [list "mono ss" 1 .1]
|
||||||
|
lappend varList [list "mono vk1" -.00259 .1]
|
||||||
|
lappend varList [list "mono vk2" 5.35166 .1]
|
||||||
|
|
||||||
|
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 "count timer 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
#---------- configure parameter array
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
set par(varList) $varList
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- Test detection system
|
||||||
|
puts stdout "Testing detector"
|
||||||
|
set det 1
|
||||||
|
count timer 600
|
||||||
|
set counts [SICSValue "banana sum 0 400"]
|
||||||
|
if {$counts <= 0} {
|
||||||
|
set det 0
|
||||||
|
}
|
||||||
|
if {$det == 1} {
|
||||||
|
puts stdout "Detector passed"
|
||||||
|
} else {
|
||||||
|
puts stdout "Check detector, found no noise after 10 minutes counting"
|
||||||
|
}
|
||||||
|
drive a3 $om
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
|
||||||
|
|
||||||
62
insttest/focustest
Executable file
62
insttest/focustest
Executable file
@ -0,0 +1,62 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the FOCUS instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source focusinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument focus
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#---------- configuration
|
||||||
|
set notList [list fermispeed diskspeed phase ratio intervall]
|
||||||
|
|
||||||
|
lappend commandList "count timer 2"
|
||||||
|
lappend commandList "repeat 2"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
lappend commandList "hm genbin 10 25 333"
|
||||||
|
lappend commandList "hm init"
|
||||||
|
|
||||||
|
lappend varList [list flightpathlength 3000 5]
|
||||||
|
lappend varList [list fermidist 3000 5]
|
||||||
|
lappend varList [list detectordist 2500 5]
|
||||||
|
lappend varList [list sampledist 499.7 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 "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
set par(varList) $varList
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
puts stdout "Chopper system NOT tested!!"
|
||||||
|
|
||||||
78
insttest/hrpttest
Executable file
78
insttest/hrpttest
Executable file
@ -0,0 +1,78 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the DMC instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source hrptinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument hrpt
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#---------- configuration
|
||||||
|
set notList [list nvs]
|
||||||
|
|
||||||
|
lappend commandList "counter setthreshold 1 0"
|
||||||
|
lappend commandList "count timer 2"
|
||||||
|
lappend commandList "repeat 2"
|
||||||
|
lappend commandList "counter setthreshold 1 3"
|
||||||
|
lappend commandList "radial start"
|
||||||
|
lappend commandList "radial stop"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
|
||||||
|
|
||||||
|
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 "count timer 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
#---------- configure parameter array
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- Test detection system
|
||||||
|
puts stdout "Testing detector"
|
||||||
|
set det 1
|
||||||
|
count timer 600
|
||||||
|
set counts [SICSValue "banana sum 0 1600"]
|
||||||
|
if {$counts <= 0} {
|
||||||
|
set det 0
|
||||||
|
}
|
||||||
|
if {$det == 1} {
|
||||||
|
puts stdout "Detector passed"
|
||||||
|
} else {
|
||||||
|
puts stdout "Check detector, found no noise after 10 minutes counting"
|
||||||
|
}
|
||||||
|
#---------- drive sample rotation back
|
||||||
|
drive a3 $om
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
|
||||||
|
|
||||||
264
insttest/insttestutil.tcl
Normal file
264
insttest/insttestutil.tcl
Normal file
@ -0,0 +1,264 @@
|
|||||||
|
#--------------------------------------------------------------------------
|
||||||
|
# This is a set of utilities for testing SICServers on instruments
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc testInventory {inventory} {
|
||||||
|
set txt [sicscommand list]
|
||||||
|
set objList [split $txt ,]
|
||||||
|
set missing 0
|
||||||
|
foreach obj $inventory {
|
||||||
|
if {[lsearch $objList $obj] < 0} {
|
||||||
|
incr missing
|
||||||
|
puts stdout "MISSING: $obj"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $missing
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc SICSValue {command} {
|
||||||
|
set txt [eval $command]
|
||||||
|
set l [split $txt =]
|
||||||
|
return [string trim [lindex $l 1]]
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc max {one two} {
|
||||||
|
if {$one > $two} {
|
||||||
|
return $one
|
||||||
|
} else {
|
||||||
|
return $two
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
# Test Motors. All are read: if they are not in the notList we will
|
||||||
|
# try driving them by 1 %. Drivecommand can either be drive of dr,
|
||||||
|
# depending on instrument
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc testMotors {drivecommand motorList notList} {
|
||||||
|
set failed 0
|
||||||
|
foreach mot $motorList {
|
||||||
|
if {[lsearch $notList $mot] < 0 } {
|
||||||
|
set rawVal [eval $mot]
|
||||||
|
if {[string first ERROR $rawVal] >= 0} {
|
||||||
|
puts stdout "MOTOR: failed to read $mot, error $rawVal"
|
||||||
|
incr failed
|
||||||
|
continue
|
||||||
|
}
|
||||||
|
set val [string trim [lindex [split $rawVal =] 1]]
|
||||||
|
#----------- test drive three times tolerance
|
||||||
|
set prec [SICSValue "$mot precision"]
|
||||||
|
set status [catch {set move [expr $prec * 3.]} msg]
|
||||||
|
#------- this fixes virtual motors which will not have a precision
|
||||||
|
if {$status != 0} {
|
||||||
|
set move 0.3
|
||||||
|
}
|
||||||
|
set newval [expr $val + $move]
|
||||||
|
set status [catch {eval $drivecommand $mot $newval} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
#------------ if we went into a limit, we try the other direction
|
||||||
|
if {[string first limit $msg] > 0} {
|
||||||
|
set newval [expr $val - $move]
|
||||||
|
set status [catch {eval $drivecommand $mot $newval} msg]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if {$status != 0} {
|
||||||
|
puts stdout "MOTOR: failed to drive $mot with $msg"
|
||||||
|
incr failed
|
||||||
|
}
|
||||||
|
#---------- drive back
|
||||||
|
set status [catch {eval $drivecommand $mot $val} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
puts stdout "MOTOR: failed to drive $mot with $msg"
|
||||||
|
incr failed
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $failed
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc testSaveAndRestore {dir} {
|
||||||
|
backup $dir/insttest.tcl
|
||||||
|
recover $dir/insttest.tcl
|
||||||
|
backup $dir/instdiff.tcl
|
||||||
|
set f1 [exe print $dir/insttest.tcl]
|
||||||
|
set f2 [exe print $dir/instdiff.tcl]
|
||||||
|
set out [open b1.tcl w]
|
||||||
|
puts $out $f1
|
||||||
|
close $out
|
||||||
|
set out [open b2.tcl w]
|
||||||
|
puts $out $f2
|
||||||
|
close $out
|
||||||
|
set status [catch {exec diff b1.tcl b2.tcl} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
puts stdout \
|
||||||
|
"BACKUP/RESTORE: Serious problem: differences in restored parameters"
|
||||||
|
puts stdout "BACKUP/RESTORE: look at diff between b1.tcl and b2.tcl"
|
||||||
|
} else {
|
||||||
|
file delete b1.tcl
|
||||||
|
file delete b2.tcl
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc testCommand args {
|
||||||
|
set command [join $args]
|
||||||
|
set status [catch {eval $command} txt]
|
||||||
|
if {$status != 0} {
|
||||||
|
puts stdout "COMMAND: Command $command returned with error $txt"
|
||||||
|
return 0
|
||||||
|
}
|
||||||
|
if {[string first ERROR $txt] >= 0} {
|
||||||
|
puts stdout "COMMAND: problem while executing command $command"
|
||||||
|
puts stdout "COMMAND: output is $txt"
|
||||||
|
return 0
|
||||||
|
}
|
||||||
|
if {[string first WARNING $txt] >= 0} {
|
||||||
|
puts stdout "COMMAND: warning while executing command $command"
|
||||||
|
puts stdout "COMMAND: output is: $txt"
|
||||||
|
}
|
||||||
|
return 1
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc testCommandList {commandList} {
|
||||||
|
set count 0
|
||||||
|
foreach command $commandList {
|
||||||
|
if {![testCommand $command]} {
|
||||||
|
incr count
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $count
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc testCommandInterrupt {command instrument user password} {
|
||||||
|
catch {exec ./interrupt.tcl $instrument $user $password &} msg
|
||||||
|
set txt1 [sicscommand $command]
|
||||||
|
set t1 [string match -nocase "*stop*" $txt1]
|
||||||
|
set txt2 [status]
|
||||||
|
set t2 [string match -nocase "*eager*" $txt2]
|
||||||
|
if {$t1 != 1 || $t2 != 1} {
|
||||||
|
puts stdout "INTERRUPT: Interrupting $command failed!"
|
||||||
|
puts stdout "INTERRUPT: message is $txt1"
|
||||||
|
puts stdout "INTERRUPT: status = $txt2"
|
||||||
|
puts stdout "Tests after this may fail!"
|
||||||
|
error "No interrupt"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc testInterruptList {comList instrument user password} {
|
||||||
|
set int 0
|
||||||
|
foreach com $comList {
|
||||||
|
set status \
|
||||||
|
[catch {testCommandInterrupt $com $instrument $user $password} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
incr int
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $int
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc testVarValue {command value {precision NA}} {
|
||||||
|
set txt [eval $command]
|
||||||
|
if {[string first ERROR $txt] >= 0} {
|
||||||
|
error "Failed to read variable $command"
|
||||||
|
}
|
||||||
|
if {[string first = $txt] > 0} {
|
||||||
|
set l [split $txt =]
|
||||||
|
set val [string trim [lindex $l 1]]
|
||||||
|
} else {
|
||||||
|
set val $txt
|
||||||
|
}
|
||||||
|
if {[string first NA $precision] >= 0} {
|
||||||
|
if {[string first $value $val] < 0} {
|
||||||
|
error "Value $value not found in response $txt"
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if {abs($value-$val) > $precision} {
|
||||||
|
error "Bad value $val, expected $value"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return OK
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
proc testVarList {varList} {
|
||||||
|
puts stdout "Testing variable values"
|
||||||
|
set count 0
|
||||||
|
foreach var $varList {
|
||||||
|
if {[llength $var] > 2} {
|
||||||
|
set status [catch {testVarValue [lindex $var 0] \
|
||||||
|
[lindex $var 1] [lindex $var 2]} msg]
|
||||||
|
} else {
|
||||||
|
set status [catch {testVarValue [lindex $var 0] \
|
||||||
|
[lindex $var 1]} msg]
|
||||||
|
}
|
||||||
|
if {$status != 0} {
|
||||||
|
set cmd [lindex $var 0]
|
||||||
|
puts stdout "$msg @ $cmd"
|
||||||
|
incr count
|
||||||
|
} else {
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $count
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc runStandardTests {parArray} {
|
||||||
|
upvar $parArray parameters
|
||||||
|
if { [info exists parameters(inventory)] } {
|
||||||
|
puts stdout "Testing Inventory.."
|
||||||
|
lappend counters [testInventory $parameters(inventory)]
|
||||||
|
} else {
|
||||||
|
lappend counters 0
|
||||||
|
}
|
||||||
|
|
||||||
|
if { [info exists parameters(driveCommand)] && \
|
||||||
|
[info exists parameters(motorList)] && \
|
||||||
|
[info exists parameters(notList)] } {
|
||||||
|
puts stdout "Testing motors... "
|
||||||
|
lappend counters [testMotors $parameters(driveCommand) \
|
||||||
|
$parameters(motorList) $parameters(notList)]
|
||||||
|
} else {
|
||||||
|
lappend counters 0
|
||||||
|
}
|
||||||
|
|
||||||
|
if { [info exists parameters(commandList)] } {
|
||||||
|
puts stdout "Testing a list of commands"
|
||||||
|
lappend counters [testCommandList $parameters(commandList)]
|
||||||
|
} else {
|
||||||
|
lappend counters 0
|
||||||
|
}
|
||||||
|
|
||||||
|
if { [info exists parameters(dir)] } {
|
||||||
|
puts stdout "Testing backup/recover.."
|
||||||
|
catch {testSaveAndRestore $parameters(dir)} msg
|
||||||
|
}
|
||||||
|
|
||||||
|
if { [info exists parameters(interruptList)] && \
|
||||||
|
[info exists parameters(instrument)] && \
|
||||||
|
[info exists parameters(user)] && \
|
||||||
|
[info exists parameters(password)] } {
|
||||||
|
puts stdout "Testing interrupting commands... "
|
||||||
|
lappend counters [testInterruptList $parameters(interruptList) \
|
||||||
|
$parameters(instrument) \
|
||||||
|
$parameters(user) $parameters(password)]
|
||||||
|
} else {
|
||||||
|
lappend counters 0
|
||||||
|
}
|
||||||
|
|
||||||
|
if {[info exists parameters(varList)]} {
|
||||||
|
lappend counters [testVarList $parameters(varList)]
|
||||||
|
} else {
|
||||||
|
lappend counters 0
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
proc printStandardSummary {counters} {
|
||||||
|
puts stdout [format "%d objects missing" [lindex $counters 0]]
|
||||||
|
puts stdout [format "%d motors failed to drive" [lindex $counters 1]]
|
||||||
|
puts stdout [format "%d commands failed" [lindex $counters 2]]
|
||||||
|
puts stdout [format "%d commands interrupts failed" [lindex $counters 3]]
|
||||||
|
puts stdout [format "%d variable values bad" [lindex $counters 4]]
|
||||||
|
}
|
||||||
|
#-----------------------------------------------------------------------
|
||||||
|
proc SICSValue {command} {
|
||||||
|
set txt [eval $command]
|
||||||
|
set l [split $txt =]
|
||||||
|
return [string trim [lindex $l 1]]
|
||||||
|
}
|
||||||
20
insttest/interrupt.tcl
Executable file
20
insttest/interrupt.tcl
Executable file
@ -0,0 +1,20 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#------------------------------------------------------------
|
||||||
|
# This is a little script which issues an interrupt to SICS
|
||||||
|
# after five seconds
|
||||||
|
#
|
||||||
|
# Mark Koennecke, October 2006
|
||||||
|
#------------------------------------------------------------
|
||||||
|
if {$argc < 3} {
|
||||||
|
puts stdout "Usage:\n\tinterrupt instrument username password"
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
initSicsDebug [lindex $argv 0]
|
||||||
|
config rights [lindex $argv 1] [lindex $argv 2]
|
||||||
|
exec sleep 5
|
||||||
|
puts $socke "INT1712 3"
|
||||||
|
exit 0
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
20
insttest/interrupt.tcl~
Executable file
20
insttest/interrupt.tcl~
Executable file
@ -0,0 +1,20 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#------------------------------------------------------------
|
||||||
|
# This is a little script which issues an interrupt to SICS
|
||||||
|
# after five seconds
|
||||||
|
#
|
||||||
|
# Mark Koennecke, October 2006
|
||||||
|
#------------------------------------------------------------
|
||||||
|
if {$argc < 4} {
|
||||||
|
puts stdout "Usage:\n\tinterrupt instrument localflag username password"
|
||||||
|
exit 1
|
||||||
|
}
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
initSicsDebug [lindex $argv 0] [lindex $argv 1]
|
||||||
|
config rights [lindex $argv 2] [lindex $argv 3]
|
||||||
|
exec sleep 1
|
||||||
|
puts $socke "INT1712 3"
|
||||||
|
exit 0
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
82
insttest/marstest
Executable file
82
insttest/marstest
Executable file
@ -0,0 +1,82 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the MARS instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source marsinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument mars
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
set th [SICSValue th01]
|
||||||
|
if {[string equal $instrument local]} {
|
||||||
|
colldr tf 12
|
||||||
|
}
|
||||||
|
|
||||||
|
#---------- configuration
|
||||||
|
lappend notList chopperspeed snailphase masterphase rabbitphase fourphase
|
||||||
|
lappend notList fivephase s1phase mphase s2phase s3phase s4phase mspeed
|
||||||
|
|
||||||
|
lappend commandList "count timer 2"
|
||||||
|
lappend commandList "repeat 2"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
lappend commandList "marsupdateinfo"
|
||||||
|
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 "count timer 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- Test detection system
|
||||||
|
puts stdout "Testing detector"
|
||||||
|
set det 1
|
||||||
|
count timer 600
|
||||||
|
set tf [SICSValue "hm notimebin"]
|
||||||
|
set counts [SICSValue "hm sum 0 24 0 $tf"]
|
||||||
|
if {$counts <= 0} {
|
||||||
|
set det 0
|
||||||
|
}
|
||||||
|
if {$det == 1} {
|
||||||
|
puts stdout "Detector passed"
|
||||||
|
} else {
|
||||||
|
puts stdout "Check detector, found no noise after 10 minutes counting"
|
||||||
|
}
|
||||||
|
#--------- put detector back where it was
|
||||||
|
colldr th $th
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
puts stdout "Choppers NOT tested!!"
|
||||||
|
|
||||||
66
insttest/morpheustest
Executable file
66
insttest/morpheustest
Executable file
@ -0,0 +1,66 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the MORPHEUS instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source morpheusinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument morpheus
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#--------- remember soz position
|
||||||
|
set sompos [SICSValue som]
|
||||||
|
|
||||||
|
set notList [list dil nv]
|
||||||
|
|
||||||
|
lappend commandList "counter setthreshold 1 0"
|
||||||
|
lappend commandList "cscan som 0 .1 2 2"
|
||||||
|
lappend commandList "sscan som 0. .1 3 2"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
|
||||||
|
lappend varList [list "mono dd" 3.354 .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 "co timer 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
set par(varList) $varList
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- put detector back where it was
|
||||||
|
drive som $sompos
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
|
||||||
|
|
||||||
61
insttest/narzisstest
Executable file
61
insttest/narzisstest
Executable file
@ -0,0 +1,61 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the NARZISS instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source narzissinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument narziss
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#--------- remember soz position
|
||||||
|
set sompos [SICSValue som]
|
||||||
|
|
||||||
|
set notList [list dil nv]
|
||||||
|
|
||||||
|
lappend commandList "counter setthreshold 1 0"
|
||||||
|
lappend commandList "cscan som 0 .1 2 2"
|
||||||
|
lappend commandList "sscan som 0. .1 3 2"
|
||||||
|
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 "co timer 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- put om
|
||||||
|
drive som $sompos
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
|
||||||
|
|
||||||
66
insttest/polditest
Executable file
66
insttest/polditest
Executable file
@ -0,0 +1,66 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the POLDI instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source poldiinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument poldi
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#---------- configuration
|
||||||
|
set notList [list chopperspeed]
|
||||||
|
|
||||||
|
lappend commandList "count timer 2"
|
||||||
|
lappend commandList "repeat 2"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
lappend commandList "hm genbin 10 25 333"
|
||||||
|
lappend commandList "hm init"
|
||||||
|
|
||||||
|
lappend varList [list flightpathlength 13870 5]
|
||||||
|
lappend varList [list chopper_dia1 8000 5]
|
||||||
|
lappend varList [list dia1_dia2 2200 5]
|
||||||
|
lappend varList [list chopper_sample 11870 1]
|
||||||
|
lappend varList [list dia2_sample 1670 .5]
|
||||||
|
lappend varList [list detectordist 2000 .5]
|
||||||
|
lappend varList [list x0_det -840 .5]
|
||||||
|
lappend varList [list y0_det -880 .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 "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
set par(varList) $varList
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
puts stdout "Chopper system NOT tested!!"
|
||||||
|
|
||||||
112
insttest/rita2test
Executable file
112
insttest/rita2test
Executable file
@ -0,0 +1,112 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the RITA2 instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source rita2inventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument rita2
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
set ompos [SICSValue a3]
|
||||||
|
backup beforetest.tcl
|
||||||
|
#---------- configuration
|
||||||
|
exe upload
|
||||||
|
exe append sc a3 0 da3 .1 np 2 ti 2
|
||||||
|
exe append drive a3 90
|
||||||
|
exe forcesave insttestbatch.tcl
|
||||||
|
|
||||||
|
set notList [list anticollision]
|
||||||
|
|
||||||
|
lappend commandList "sc a3 0 da3 .1 np 2 ti 2"
|
||||||
|
lappend commandList "statusinfo"
|
||||||
|
lappend commandList "hmframe 0"
|
||||||
|
lappend commandList "ritamode none"
|
||||||
|
lappend commandList "ritamode flat"
|
||||||
|
lappend commandList "ritamode focus"
|
||||||
|
lappend commandList "ritamode monoim"
|
||||||
|
lappend commandList "w5s"
|
||||||
|
lappend commandList "slits"
|
||||||
|
lappend commandList "blades"
|
||||||
|
lappend commandList "motors"
|
||||||
|
|
||||||
|
#--------- the TAS set...
|
||||||
|
lappend commandList "do insttestbatch.tcl"
|
||||||
|
lappend commandList "ou a4"
|
||||||
|
lappend commandList "fi a4"
|
||||||
|
lappend commandList "fix a4"
|
||||||
|
lappend commandList "cl a4"
|
||||||
|
lappend commandList "co ti 5"
|
||||||
|
lappend commandList "pr a3,a4"
|
||||||
|
lappend commandList "se title hugo"
|
||||||
|
lappend commandList "li"
|
||||||
|
|
||||||
|
#-------- the TASUB set
|
||||||
|
lappend commandList "ref clear"
|
||||||
|
lappend commandList "cell 3.844 3.844 20.086 90 90 90"
|
||||||
|
lappend commandList "ref 0 0 6 -158.52 -74.77 .11 -.13 5 5"
|
||||||
|
lappend commandList "ref 1 0 0 -63.06 -63.48 .11 -.13 5 5"
|
||||||
|
lappend commandList "makeub 1 2"
|
||||||
|
lappend commandList "dr qh 1 0 0 en .1"
|
||||||
|
lappend commandList "listub"
|
||||||
|
|
||||||
|
lappend interruptList "dr om 90"
|
||||||
|
lappend interruptList "co ti 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
lappend varList [list "tasub mono dd" 3.3546 .01]
|
||||||
|
lappend varList [list "tasub mono ss" 1 .01]
|
||||||
|
lappend varList [list "tasub ana dd" 3.3546 .01]
|
||||||
|
lappend varList [list "tasub ana ss" 1 .01]
|
||||||
|
lappend varList [list analyzerdistance 33.9 .1]
|
||||||
|
lappend varList [list sampledistance 120.699 .1]
|
||||||
|
lappend varList [list bladedistance 2.5 .1]
|
||||||
|
lappend varList [list detectordistance 2.5 .1]
|
||||||
|
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) dr
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
set par(varList) $varList
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- Test detection system
|
||||||
|
puts stdout "Testing detector"
|
||||||
|
set det 1
|
||||||
|
co ti 600
|
||||||
|
set counts [SICSValue "hm sum 0 128 0 128"]
|
||||||
|
if {$counts <= 0} {
|
||||||
|
set det 0
|
||||||
|
}
|
||||||
|
if {$det == 1} {
|
||||||
|
puts stdout "Detector passed"
|
||||||
|
} else {
|
||||||
|
puts stdout "Check detector, found no noise after 10 minutes counting"
|
||||||
|
}
|
||||||
|
#--------- put detector back where it was
|
||||||
|
recover beforetest.tcl
|
||||||
|
dr om $ompos
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
|
||||||
204
insttest/sansinventory.tcl
Normal file
204
insttest/sansinventory.tcl
Normal file
@ -0,0 +1,204 @@
|
|||||||
|
lappend inventory makeobject
|
||||||
|
lappend inventory removeobject
|
||||||
|
lappend inventory graph
|
||||||
|
lappend inventory statistics
|
||||||
|
lappend inventory exe
|
||||||
|
lappend inventory sics_exitus
|
||||||
|
lappend inventory fileeval
|
||||||
|
lappend inventory interneval
|
||||||
|
lappend inventory clientput
|
||||||
|
lappend inventory broadcast
|
||||||
|
lappend inventory transact
|
||||||
|
lappend inventory fulltransact
|
||||||
|
lappend inventory sicsprompt
|
||||||
|
lappend inventory publish
|
||||||
|
lappend inventory getlog
|
||||||
|
lappend inventory wait
|
||||||
|
lappend inventory status
|
||||||
|
lappend inventory resetserver
|
||||||
|
lappend inventory dir
|
||||||
|
lappend inventory backup
|
||||||
|
lappend inventory restore
|
||||||
|
lappend inventory setint
|
||||||
|
lappend inventory getint
|
||||||
|
lappend inventory sicstype
|
||||||
|
lappend inventory sicsbounds
|
||||||
|
lappend inventory sicsstatus
|
||||||
|
lappend inventory sicstime
|
||||||
|
lappend inventory sicsdescriptor
|
||||||
|
lappend inventory setstatus
|
||||||
|
lappend inventory db
|
||||||
|
lappend inventory evfactory
|
||||||
|
lappend inventory emon
|
||||||
|
lappend inventory commandlog
|
||||||
|
lappend inventory udpquieck
|
||||||
|
lappend inventory alias
|
||||||
|
lappend inventory sicscron
|
||||||
|
lappend inventory sicsdatafactory
|
||||||
|
lappend inventory scriptcallback
|
||||||
|
lappend inventory help
|
||||||
|
lappend inventory list
|
||||||
|
lappend inventory installhdb
|
||||||
|
lappend inventory stopexe
|
||||||
|
lappend inventory listexe
|
||||||
|
lappend inventory sicsidle
|
||||||
|
lappend inventory success
|
||||||
|
lappend inventory pause
|
||||||
|
lappend inventory devexec
|
||||||
|
lappend inventory makemulti
|
||||||
|
lappend inventory definealias
|
||||||
|
lappend inventory makeoptimise
|
||||||
|
lappend inventory kill_command
|
||||||
|
lappend inventory anticollisioninstall
|
||||||
|
lappend inventory tclreplacedrivable
|
||||||
|
lappend inventory drivableinvoke
|
||||||
|
lappend inventory makeswhpmotor
|
||||||
|
lappend inventory remob
|
||||||
|
lappend inventory token
|
||||||
|
lappend inventory instrument
|
||||||
|
lappend inventory title
|
||||||
|
lappend inventory user
|
||||||
|
lappend inventory subtitle
|
||||||
|
lappend inventory environment
|
||||||
|
lappend inventory comment
|
||||||
|
lappend inventory samplename
|
||||||
|
lappend inventory email
|
||||||
|
lappend inventory fax
|
||||||
|
lappend inventory phone
|
||||||
|
lappend inventory adress
|
||||||
|
lappend inventory sample
|
||||||
|
lappend inventory batchroot
|
||||||
|
lappend inventory starttime
|
||||||
|
lappend inventory selectedbeamstop
|
||||||
|
lappend inventory sicsdatapath
|
||||||
|
lappend inventory sicsdataprefix
|
||||||
|
lappend inventory sicsdatapostfix
|
||||||
|
lappend inventory sicsdatanumber
|
||||||
|
lappend inventory killfile
|
||||||
|
lappend inventory storedata
|
||||||
|
lappend inventory som
|
||||||
|
lappend inventory sax
|
||||||
|
lappend inventory say
|
||||||
|
lappend inventory saz
|
||||||
|
lappend inventory spos
|
||||||
|
lappend inventory mz
|
||||||
|
lappend inventory mom
|
||||||
|
lappend inventory gphi
|
||||||
|
lappend inventory gtheta
|
||||||
|
lappend inventory detectorx
|
||||||
|
lappend inventory detectory
|
||||||
|
lappend inventory detectorrotation
|
||||||
|
lappend inventory beamstopy
|
||||||
|
lappend inventory beamstopx
|
||||||
|
lappend inventory beamstopy2
|
||||||
|
lappend inventory tilt
|
||||||
|
lappend inventory nvs
|
||||||
|
lappend inventory nvswatch
|
||||||
|
lappend inventory lambda
|
||||||
|
lappend inventory drive
|
||||||
|
lappend inventory run
|
||||||
|
lappend inventory <EFBFBD>tag:
|
||||||
|
lappend inventory cryomagnetsampleholder
|
||||||
|
lappend inventory sampletable
|
||||||
|
lappend inventory detector
|
||||||
|
lappend inventory beamstop
|
||||||
|
lappend inventory bs
|
||||||
|
lappend inventory dt
|
||||||
|
lappend inventory st
|
||||||
|
lappend inventory cryo
|
||||||
|
lappend inventory counter
|
||||||
|
lappend inventory banana
|
||||||
|
lappend inventory serialport
|
||||||
|
lappend inventory p1
|
||||||
|
lappend inventory p2
|
||||||
|
lappend inventory p3
|
||||||
|
lappend inventory p4
|
||||||
|
lappend inventory p5
|
||||||
|
lappend inventory p11
|
||||||
|
lappend inventory p12
|
||||||
|
lappend inventory p13
|
||||||
|
lappend inventory p14
|
||||||
|
lappend inventory p15
|
||||||
|
lappend inventory buf
|
||||||
|
lappend inventory stack
|
||||||
|
lappend inventory sps2
|
||||||
|
lappend inventory xydata0
|
||||||
|
lappend inventory xydata1
|
||||||
|
lappend inventory xydata2
|
||||||
|
lappend inventory xydata3
|
||||||
|
lappend inventory xydata4
|
||||||
|
lappend inventory xydata5
|
||||||
|
lappend inventory xydata6
|
||||||
|
lappend inventory xydata7
|
||||||
|
lappend inventory xydata8
|
||||||
|
lappend inventory xydata9
|
||||||
|
lappend inventory xydata
|
||||||
|
lappend inventory nxscript
|
||||||
|
lappend inventory psdframe
|
||||||
|
lappend inventory sps1
|
||||||
|
lappend inventory inihaakearray
|
||||||
|
lappend inventory logbook
|
||||||
|
lappend inventory count
|
||||||
|
lappend inventory quickcount
|
||||||
|
lappend inventory turbocount
|
||||||
|
lappend inventory repeat
|
||||||
|
lappend inventory qrange
|
||||||
|
lappend inventory instrok
|
||||||
|
lappend inventory beam
|
||||||
|
lappend inventory detemp
|
||||||
|
lappend inventory temp2
|
||||||
|
lappend inventory temp3
|
||||||
|
lappend inventory temp4
|
||||||
|
lappend inventory bschange
|
||||||
|
lappend inventory bscfree
|
||||||
|
lappend inventory bsout
|
||||||
|
lappend inventory bsin
|
||||||
|
lappend inventory bscslot
|
||||||
|
lappend inventory shutter
|
||||||
|
lappend inventory batchrun
|
||||||
|
lappend inventory countinfo
|
||||||
|
lappend inventory coll
|
||||||
|
lappend inventory att
|
||||||
|
lappend inventory get_ready1
|
||||||
|
lappend inventory get_ready2
|
||||||
|
lappend inventory set_ready1
|
||||||
|
lappend inventory set_ready2
|
||||||
|
lappend inventory reset_ready
|
||||||
|
lappend inventory sansstore
|
||||||
|
lappend inventory turbostore
|
||||||
|
lappend inventory statusinfo
|
||||||
|
lappend inventory hmframe
|
||||||
|
lappend inventory fileframe
|
||||||
|
lappend inventory tofel
|
||||||
|
lappend inventory antitofel
|
||||||
|
lappend inventory gc
|
||||||
|
lappend inventory strobo
|
||||||
|
lappend inventory static
|
||||||
|
lappend inventory cyclic
|
||||||
|
lappend inventory wwwsics
|
||||||
|
lappend inventory collok
|
||||||
|
lappend inventory man
|
||||||
|
lappend inventory update_remob
|
||||||
|
lappend inventory samenv
|
||||||
|
lappend inventory cfgenv
|
||||||
|
lappend inventory flip
|
||||||
|
lappend inventory performance
|
||||||
|
lappend motors som
|
||||||
|
lappend motors sax
|
||||||
|
lappend motors say
|
||||||
|
lappend motors saz
|
||||||
|
lappend motors spos
|
||||||
|
lappend motors mz
|
||||||
|
lappend motors mom
|
||||||
|
lappend motors gphi
|
||||||
|
lappend motors gtheta
|
||||||
|
lappend motors detectorx
|
||||||
|
lappend motors detectory
|
||||||
|
lappend motors detectorrotation
|
||||||
|
lappend motors beamstopy
|
||||||
|
lappend motors beamstopx
|
||||||
|
lappend motors beamstopy2
|
||||||
|
lappend motors tilt
|
||||||
|
lappend motors nvs
|
||||||
|
lappend motors nvswatch
|
||||||
|
lappend motors lambda
|
||||||
88
insttest/sanstest
Executable file
88
insttest/sanstest
Executable file
@ -0,0 +1,88 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the SANS instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source sansinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument sans
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#--------- remember detector position...
|
||||||
|
set detpos [SICSValue detectorx]
|
||||||
|
bsin
|
||||||
|
drive detectorx 3.
|
||||||
|
|
||||||
|
#---------- configuration
|
||||||
|
set notList [list nvs nvswatch lambda]
|
||||||
|
|
||||||
|
lappend commandList "count timer 2"
|
||||||
|
lappend commandList "repeat 2"
|
||||||
|
lappend commandList "coll 3"
|
||||||
|
lappend commandList "testVarValue coll 3"
|
||||||
|
lappend commandList "coll 18"
|
||||||
|
lappend commandList "testVarValue coll 18"
|
||||||
|
lappend commandList "bsout"
|
||||||
|
lappend commandList "bsin"
|
||||||
|
lappend commandList "att 1"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
lappend commandList "statusinfo"
|
||||||
|
lappend commandList "hmframe 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 "count timer 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- Test detection system
|
||||||
|
puts stdout "Testing detector"
|
||||||
|
set det 1
|
||||||
|
count timer 600
|
||||||
|
set counts [SICSValue "banana sum 0 128 0 128"]
|
||||||
|
if {$counts <= 0} {
|
||||||
|
set det 0
|
||||||
|
}
|
||||||
|
if {$det == 1} {
|
||||||
|
puts stdout "Detector passed"
|
||||||
|
} else {
|
||||||
|
puts stdout "Check detector, found no noise after 10 minutes counting"
|
||||||
|
}
|
||||||
|
#--------- put detector back where it was
|
||||||
|
drive detectorx $detpos
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
puts stdout "Velocity selector NOT tested!!"
|
||||||
|
|
||||||
73
insttest/sicstcldebug.tcl
Normal file
73
insttest/sicstcldebug.tcl
Normal file
@ -0,0 +1,73 @@
|
|||||||
|
#------------------------------------------------------------------
|
||||||
|
# This is a helper file in order to debug SICS Tcl scripts. The idea
|
||||||
|
# is that a connection to a SICS interpreter at localhost:2911 is opened.
|
||||||
|
# Then unknown is reimplemented to send unknown commands (which must be
|
||||||
|
# SICS commands) to the SICS interpreter for evaluation. This is done
|
||||||
|
# with transact in order to figure out when SICS finished processing.
|
||||||
|
# Thus is should be possible to debug SICS Tcl scripts in a normal
|
||||||
|
# standalone interpreter without the overhead of restarting SICS
|
||||||
|
# all the time. It may even be possible to use one of the normal
|
||||||
|
# Tcl debuggers then....
|
||||||
|
#
|
||||||
|
# Mark Koennecke, February 2006
|
||||||
|
#
|
||||||
|
# Revamped for use in testing SICS instruments.
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
set host(amor) amor.psi.ch
|
||||||
|
set host(dmc) dmc.psi.ch
|
||||||
|
set host(focus) focus.psi.ch
|
||||||
|
set host(hrpt) hrpt.psi.ch
|
||||||
|
set host(mars) mars.psi.ch
|
||||||
|
set host(morpheus) morpheus.psi.ch
|
||||||
|
set host(narziss) narziss.psi.ch
|
||||||
|
set host(poldi) poldi.psi.ch
|
||||||
|
set host(rita2) rita2.psi.ch
|
||||||
|
set host(sans) sans.psi.ch
|
||||||
|
set host(sansli) sans2.psi.ch
|
||||||
|
set host(tasp) tasp.psi.ch
|
||||||
|
set host(trics) trics.psi.ch
|
||||||
|
set host(local) localhost
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
# initialize the socket before debugging. If local == 1, then a
|
||||||
|
# connection to localhost is built
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc initSicsDebug {instrument} {
|
||||||
|
global socke host
|
||||||
|
catch {close $socke}
|
||||||
|
set status [catch {set compi $host($instrument)} msg]
|
||||||
|
if {$status != 0} {
|
||||||
|
error "Host for $instrument not found"
|
||||||
|
}
|
||||||
|
set socke [socket $compi 2911]
|
||||||
|
gets $socke
|
||||||
|
puts $socke "Spy 007"
|
||||||
|
flush $socke
|
||||||
|
gets $socke
|
||||||
|
}
|
||||||
|
#----------------------------------------------------------------
|
||||||
|
proc sicscommand args {
|
||||||
|
global socke
|
||||||
|
append com "transact " [join $args]
|
||||||
|
puts $socke $com
|
||||||
|
flush $socke
|
||||||
|
set reply ""
|
||||||
|
while {1} {
|
||||||
|
set line [gets $socke]
|
||||||
|
if {[string first TRANSACTIONFINISHED $line] >= 0} {
|
||||||
|
return $reply
|
||||||
|
} else {
|
||||||
|
append reply $line "\n"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc unknown args {
|
||||||
|
return [sicscommand $args]
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
|
proc clientput args {
|
||||||
|
puts stdout [join $args]
|
||||||
|
}
|
||||||
|
#------------------------------------------------------------------
|
||||||
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
|
||||||
94
insttest/tasptest
Executable file
94
insttest/tasptest
Executable file
@ -0,0 +1,94 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the TASP instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source taspinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument tasp
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
set ompos [SICSValue a3]
|
||||||
|
backup beforetest.tcl
|
||||||
|
#---------- configuration
|
||||||
|
exe upload
|
||||||
|
exe append sc a3 0 da3 .1 np 2 ti 2
|
||||||
|
exe append drive a3 90
|
||||||
|
exe forcesave insttestbatch.tcl
|
||||||
|
|
||||||
|
set notList [list forceqe dil mf nv]
|
||||||
|
|
||||||
|
lappend commandList "sc a3 0 da3 .1 np 2 ti 2"
|
||||||
|
#--------- the TAS set...
|
||||||
|
lappend commandList "do insttestbatch.tcl"
|
||||||
|
lappend commandList "ou a4"
|
||||||
|
lappend commandList "fi a4"
|
||||||
|
lappend commandList "fix a4"
|
||||||
|
lappend commandList "cl a4"
|
||||||
|
lappend commandList "co ti 5"
|
||||||
|
lappend commandList "pr a3,a4"
|
||||||
|
lappend commandList "se title hugo"
|
||||||
|
lappend commandList "li"
|
||||||
|
|
||||||
|
#---------- The MAD set ...
|
||||||
|
lappend commandList "se as 4.558 bs 4.558 cs 4.558 bb 90 cc 90 aa 90"
|
||||||
|
lappend commandList "se ax 1 ay 1 az 0"
|
||||||
|
lappend commandList "se bx 0 by 0 bz 1"
|
||||||
|
lappend commandList "se ss 1 sa -1"
|
||||||
|
lappend commandList "se fx 2"
|
||||||
|
lappend commandList "dr ei 7.8"
|
||||||
|
lappend commandList "dr ef 8. "
|
||||||
|
lappend commandList "dr qh 1 1 1"
|
||||||
|
lappend commandList "testVarValue ei 7.8 .1"
|
||||||
|
lappend commandList "testVarValue ef 8.0 .1"
|
||||||
|
lappend commandList "testVarValue en .2 .1"
|
||||||
|
lappend commandList "testVarValue a1 -28.86 .1"
|
||||||
|
lappend commandList "testVarValue a2 -57.73 .1"
|
||||||
|
lappend commandList "testVarValue a3 -88.04 .1"
|
||||||
|
lappend commandList "testVarValue a4 75.37 .1"
|
||||||
|
lappend commandList "testVarValue a5 -28.47 .1"
|
||||||
|
lappend commandList "testVarValue a6 -56.94 .1"
|
||||||
|
lappend commandList "testVarValue qm 2.38 .1"
|
||||||
|
|
||||||
|
lappend interruptList "dr om 90"
|
||||||
|
lappend interruptList "co ti 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
lappend varList [list "da" 3.3546 .01]
|
||||||
|
lappend varList [list "sm" -1 .01]
|
||||||
|
lappend varList [list "dm" 3.3546 .01]
|
||||||
|
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) dr
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
set par(varList) $varList
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- put detector back where it was
|
||||||
|
recover beforetest.tcl
|
||||||
|
dr a3 $ompos
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
|
||||||
94
insttest/tricstest
Executable file
94
insttest/tricstest
Executable file
@ -0,0 +1,94 @@
|
|||||||
|
#!/usr/bin/tclsh
|
||||||
|
#-------------------------------------------------------------------------
|
||||||
|
# This is the regression test for SICS on the TRICS instrument
|
||||||
|
#
|
||||||
|
# Mark Koennecke, November 2006
|
||||||
|
#------------------------------------------------------------------------
|
||||||
|
source sicstcldebug.tcl
|
||||||
|
source insttestutil.tcl
|
||||||
|
source tricsinventory.tcl
|
||||||
|
|
||||||
|
#------ If there is another argument, test at localhost: for debugging...
|
||||||
|
if {$argc > 0} {
|
||||||
|
set instrument local
|
||||||
|
} else {
|
||||||
|
set instrument trics
|
||||||
|
}
|
||||||
|
|
||||||
|
initSicsDebug $instrument
|
||||||
|
config rights lnsmanager lnsSICSlns
|
||||||
|
|
||||||
|
#--------- remember soz position
|
||||||
|
set sompos [SICSValue om]
|
||||||
|
backup beforetest.tcl
|
||||||
|
|
||||||
|
set notList [list dil nv cone]
|
||||||
|
|
||||||
|
lappend commandList "counter setthreshold 1 0"
|
||||||
|
lappend commandList "scan1d"
|
||||||
|
lappend commandList "cscan om 0 .1 2 2"
|
||||||
|
lappend commandList "sscan om 0. .1 3 2"
|
||||||
|
lappend commandList "scan2d"
|
||||||
|
lappend commandList "cscan om 0 .1 2 2"
|
||||||
|
lappend commandList "sscan om 0. .1 3 2"
|
||||||
|
lappend commandList "scan1d"
|
||||||
|
lappend commandList "wwwsics"
|
||||||
|
lappend commandList "wwwhm"
|
||||||
|
|
||||||
|
# TODO: add tests for the real four circle stuff. This is as of now
|
||||||
|
# deferred until the TRICS software has been reorganized.
|
||||||
|
# Most of the four circle tests should go into the regression
|
||||||
|
# test for the SICServer anyway.
|
||||||
|
|
||||||
|
lappend varList [list xscale1 0.74 .1]
|
||||||
|
lappend varList [list xscale2 0.74 .1]
|
||||||
|
lappend varList [list xscale3 -0.74 .1]
|
||||||
|
lappend varList [list zscale1 1.486 .1]
|
||||||
|
lappend varList [list zscale2 1.486 .1]
|
||||||
|
lappend varList [list zscale3 1.486 .1]
|
||||||
|
lappend varList [list xnull1 128 5]
|
||||||
|
lappend varList [list xnull2 128 5]
|
||||||
|
lappend varList [list xnull2 128 5]
|
||||||
|
lappend varList [list znull1 128 5]
|
||||||
|
lappend varList [list znull2 64 5]
|
||||||
|
lappend varList [list znull3 128 5]
|
||||||
|
lappend varList [list sttoffset1 0 .5]
|
||||||
|
lappend varList [list sttoffset2 8 .5]
|
||||||
|
lappend varList [list sttoffset3 1.4 .5]
|
||||||
|
lappend varList [list dist2 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 "count timer 120"
|
||||||
|
lappend interruptList "exe insttestbatch.tcl"
|
||||||
|
|
||||||
|
set par(inventory) $inventory
|
||||||
|
set par(driveCommand) drive
|
||||||
|
set par(motorList) $motors
|
||||||
|
set par(notList) $notList
|
||||||
|
set par(commandList) $commandList
|
||||||
|
set par(interruptList) $interruptList
|
||||||
|
set par(instrument) $instrument
|
||||||
|
set par(user) lnsmanager
|
||||||
|
set par(password) lnsSICSlns
|
||||||
|
set par(varList) $varList
|
||||||
|
|
||||||
|
#================= actually test =====================================
|
||||||
|
set counters [runStandardTests par]
|
||||||
|
|
||||||
|
#--------- put om back where it was
|
||||||
|
drive om $sompos
|
||||||
|
recover beforetest.tcl
|
||||||
|
|
||||||
|
#------------ print a summary
|
||||||
|
set inst [string toupper $instrument]
|
||||||
|
puts stdout "Test Summary for $inst"
|
||||||
|
printStandardSummary $counters
|
||||||
|
|
||||||
|
|
||||||
Reference in New Issue
Block a user