Files
sics/test/testmumo.tcl

81 lines
2.6 KiB
Tcl

#-----------------------------------------------------------------------
# Some tests for SANS style MultiMotors. A MultiMotor with the name sa
# must have been initialized in the test initializaton file.
#
# Mark Koennecke, November 2006
#----------------------------------------------------------------------
puts stdout "Testing SANS MultiMotor Module..."
proc testMumoPosition {omPos sttPos} {
set txt [sa]
set luf [split $txt "\n"]
set l1 [lindex $luf 0]
if {[string first "Status listing" $l1] < 0} {
error "Bad first line on MultiMotor: $l1"
}
set l2 [lindex $luf 1]
set li2 [split $l2 =]
if {abs([lindex $li2 1] - $omPos) > .1} {
error "Bad omega position: $li2, expected $omPos"
}
set l2 [lindex $luf 2]
set li2 [split $l2 =]
if {abs([lindex $li2 1] - $sttPos) > .1} {
error "Bad stt position: $li2, expected $sttPos"
}
return OK
}
#---------------------------------------------------------------------
test mumo-1.0 {Test Reading} -body {
config rights Mugger Mugger
drive a3 0 a4 0
return [testMumoPosition .0 .0]
} -result OK
#----------------------------------------------------------------------
test mumo-1.1 {Test Named Position} -body {
sa noeff
return [testMumoPosition 24. 48.]
} -result OK
#---------------------------------------------------------------------
test mumo-1.2 {Test Back} -body {
sa back
return [testMumoPosition 0. 0.]
} -result OK
#----------------------------------------------------------------------
test mumo-1.3 {Test defpos} -body {
sa defpos fart om 10 stt 43
sa fart
return [testMumoPosition 10. 43.]
} -result OK
#-----------------------------------------------------------------------
test mumo-1.4 {Test individual driving} -body {
sa noeff
sa om 27
return [testMumoPosition 27 48.]
} -result OK
#-----------------------------------------------------------------------
test mumo-1.5 {Test pos definiton} -body {
sa pos gurke
sa back
sa gurke
return [testMumoPosition 27 48.]
} -result OK
#----------------------------------------------------------------------
test mumo-1.6 {Test dropping named position} -body {
sa drop fart
set txt [sa fart]
if {[string first ERROR $txt] < 0} {
error "Did not trigger error when trying to drive a dropped position"
}
return OK
} -result OK
#----------------------------------------------------------------------
test mumo-1.6 {Test Permission} -body {
config rights Spy Spy
set txt [sa neoff]
if {[string first ERROR $txt] < 0} {
error "Did not trigger error whithout permission"
}
return OK
} -result OK