PSI update

r1464 | ffr | 2007-02-12 12:20:21 +1100 (Mon, 12 Feb 2007) | 2 lines

test/testutil.tcl

@@ -0,0 +1,165 @@
+#------------------------------------------------------------------------------
+# utility routines for testing SICS
+#
+# copyright: see file COPYRIGHT
+#
+# Mark Koennecke, July 2006
+#------------------------------------------------------------------------------
+proc SICSValue {command} {
+	set txt [eval $command]
+	set l [split $txt =]
+	return [string trim [lindex $l 1]]
+}
+#-----------------------------------------------------------------------------
+proc compareValue {is should} {
+	if {[string is double $is] == 1} {
+		if {abs($should - $is) > .01} {
+			error "Bad compare is: $is, should $should"
+		}
+	} else {
+		if {[string compare $is $should] != 0} {
+			error "Bad compare is: $is, should $should"
+		}
+	}
+	return OK
+}
+#------------------------------------------------------------------------------
+proc testPar {name testval priv } {
+	config rights Spy Spy
+	set value [SICSValue $name]
+	set res [eval $name $testval]
+	if {[string first ERROR $res] < 0} {
+		error "Managed to set parameter even if not allowed"
+	}
+	config rights $priv $priv
+	set res [eval $name $testval]
+	if {[string first ERROR $res] >= 0} {
+		error "Setting parameter failed with $res"
+	}
+	set readback [SICSValue $name]
+	compareValue $readback $testval
+	eval $name $value
+	return "OK"
+}
+#-------------------------------------------------------------------------------
+proc testROPar {name val} {
+	config rights Mugger Mugger
+	set value [SICSValue $name]
+	compareValue $value $val
+	catch {$name [expr $val + 1]} msg
+	set value [SICSValue $name]
+	compareValue $value $val
+	config rights Spy Spy
+	return OK
+}
+#------------------------------------------------------------------------------
+proc testDrive {name value priv} {
+	config rights Spy Spy
+	set ans [eval drive $name $value]
+	if {[string first ERROR $ans] < 0} {
+		error "Protection on drivable does not work"
+	}
+	config rights $priv $priv
+	set ans [eval drive $name $value]
+	if { [string first sucessfully $ans] < 0} {
+		error "Driving $name failed: $ans"
+	}
+	set readback [SICSValue $name]
+	compareValue $readback $value
+	config rights Spy Spy
+	return OK	
+}
+#------------------------------------------------------------------------------
+proc testDriveInterrupt {name value} {
+    global socke
+	config rights Mugger Mugger
+	run $name $value
+	puts $socke "INT1712 3"
+	flush $socke
+	set ans [eval status]
+	config rights Spy Spy
+	if {[string first Interrupt $ans] < 0} {
+		puts stdout $ans
+		error "Failed to abort driving"
+	}
+	if { [string first Eager $ans] < 0} {
+		error "Failed to finish driving"
+	} 
+	return OK
+}
+#---------------------------------------------------------------------
+proc testNBCounting {startCommand waitTime} {
+        set res [$startCommand]
+	if {[string first ERROR $res] >= 0} {
+		error "Starting count failed with $res"
+	}
+        exec sleep 1
+        set res [SICSValue status]
+        if {[string first "Count" $res] < 0} {
+	    error "Status does not say counting"
+        }
+        exec sleep $waitTime
+        set res [SICSValue status]
+        if {[string first "Eager" $res] < 0} {
+	    error "Counting did not stop"
+        }
+	return "OK"
+}
+#----------------------------------------------------------------
+proc testBlockCounting {startCommand waitTime} {
+        set res [$startCommand]
+	if {[string first ERROR $res] >= 0} {
+		error "Starting count failed with $res"
+	}
+        exec sleep $waitTime
+        set res [SICSValue status]
+        if {[string first "Eager" $res] < 0} {
+	    error "Counting did not stop"
+        }
+	return "OK"
+}
+#---------------------------------------------------------------
+proc testInterruptedCount {startCommand} {
+        global socke
+        set res [$startCommand]
+	if {[string first ERROR $res] >= 0} {
+		error "Starting count failed with $res"
+	}
+	puts $socke "INT1712 3"
+	flush $socke
+        exec sleep 10
+	set ans [eval status]
+	config rights Spy Spy
+	if {[string first Interrupt $ans] < 0} {
+		puts stdout $ans
+		error "Failed to abort counting"
+	}
+	if { [string first Eager $ans] < 0} {
+		error "Failed to finish counting"
+	} 
+	return OK
+}
+#------------------------------------------------------------------------
+proc testOK {command} {
+    set test [eval $command]
+    if {[string first OK $test] < 0} {
+	error [format "Expected OK, got %s" $test]
+    }
+    return OK
+}
+#------------------------------------------------------------------------
+proc testNoError {command} {
+    set test [eval $command]
+    if {[string first ERROR $test] >= 0} {
+	error [format "Located Error:  %s" $test]
+    }
+    return OK
+}
+#------------------------------------------------------------------------
+proc testCommand {command response} {
+    set result [eval $command]
+    if {[string first $response $result] < 0} {
+	error "Expected $response, received $result"
+    }
+    return OK
+}