- Added many more regression tests for the SICServer

test/testmumo.tcl

@@ -0,0 +1,80 @@
+#-----------------------------------------------------------------------
+# 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