- First version of instrument regression tests
- sinqcom is the first version of a communication testing program for instruments
This commit is contained in:
koennecke
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]]
|
||||
}
|
||||
Reference in New Issue
Block a user