90 lines
2.5 KiB
Tcl
90 lines
2.5 KiB
Tcl
#------------------------------------------------------------------------------
|
|
# 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 $rhould] != 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
|
|
}
|