- Added many more regression tests for the SICServer
This commit is contained in:
koennecke
265
test/testtasub.tcl
Normal file
265
test/testtasub.tcl
Normal file
@ -0,0 +1,265 @@
|
||||
#----------------------------------------------------------------------
|
||||
# This is a set of regression tests for the tasub module.
|
||||
# This module does the UB matrix algorithm as described by Mark Lumsden
|
||||
# triple axis spectrometers.
|
||||
#
|
||||
# Mark Koennecke, November 2006
|
||||
#----------------------------------------------------------------------
|
||||
puts stdout "Testing Tasub"
|
||||
#----------------------------------------------------------------------
|
||||
# testTasubCalculation tests the tasub calculation. The input is a list
|
||||
# containg the cell constants and two lists denoting reflections.
|
||||
# For each reflection the list must hold:
|
||||
# 0 1 2 3 4 5 6 7 8 9 10 11 12
|
||||
# qh qk ql ei ef a1 a2 a3 a4 sgu sgl a5 a6
|
||||
# testTasubCalculation then inputs the cell and the reflections into
|
||||
# tasub and calculates a UB from that. Then it tries to drive to the
|
||||
# QE positions given for the reflections and checks if the angles are right
|
||||
# It also checks QE positions in order to check if they have been properly
|
||||
# updated.
|
||||
# This then can be used with various inputs to check various configurations
|
||||
# of the instrument.
|
||||
#----------------------------------------------------------------------
|
||||
proc testTasubCalculation {cell ref1 ref2} {
|
||||
if {[llength $cell] < 6} {
|
||||
error "Not enough cell parameters"
|
||||
}
|
||||
if {[llength $ref1] < 13} {
|
||||
error "Not enough parameters for reflection 1"
|
||||
}
|
||||
if {[llength $ref2] < 13} {
|
||||
error "Not enough parameters for reflection 2"
|
||||
}
|
||||
checkSettingCell $cell
|
||||
checkMakeUB $ref1 $ref2
|
||||
checkDrivingReflection $ref1
|
||||
checkDrivingReflection $ref2
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc checkSettingCell {cell} {
|
||||
config rights Mugger Mugger
|
||||
append cmd "tasub cell " [join $cell]
|
||||
testOK $cmd
|
||||
set readback [string trim [SICSValue "tasub cell"]]
|
||||
set l [split $readback]
|
||||
for {set i 0} {$i < [llength $cell]} {incr i} {
|
||||
set ori [lindex $cell $i]
|
||||
set val [lindex $l $i]
|
||||
if {abs($ori - $val) > .01} {
|
||||
error "Bad cell readback, in $cell, back $readback"
|
||||
}
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------------------
|
||||
proc checkMakeUB {ref1 ref2} {
|
||||
checkOK "tasub clear"
|
||||
set cmd [format "tasub addref %f %f %f %f %f %f %f %f %f" \
|
||||
[lindex $ref1 0] [lindex $ref1 1] [lindex $ref1 2] \
|
||||
[lindex $ref1 7] [lindex $ref1 8] [lindex $ref1 9] \
|
||||
[lindex $ref1 10] \
|
||||
[lindex $ref1 3] [lindex $ref1 4]]
|
||||
eval $cmd
|
||||
set cmd [format "tasub addref %f %f %f %f %f %f %f %f %f" \
|
||||
[lindex $ref2 0] [lindex $ref2 1] [lindex $ref2 2] \
|
||||
[lindex $ref2 7] [lindex $ref2 8] [lindex $ref2 9] \
|
||||
[lindex $ref2 10] \
|
||||
[lindex $ref2 3] [lindex $ref2 4]]
|
||||
eval $cmd
|
||||
set test [tasub makeub 1 2]
|
||||
if {[string first ERROR $test] > 0} {
|
||||
error "Problem calculating UB: $test"
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc checkDrivingReflection {ref} {
|
||||
set cmd [format "drive qh %f qk %f ql %f ei %f ef %f" \
|
||||
[lindex $ref 0] [lindex $ref 1] [lindex $ref 2] \
|
||||
[lindex $ref 3] [lindex $ref 4]]
|
||||
set test [eval $cmd]
|
||||
puts $cmd
|
||||
if {[string first ERROR $test] >= 0} {
|
||||
error "Failed to drive reflection: $test"
|
||||
}
|
||||
set a1 [SICSValue a1]
|
||||
set a1soll [lindex $ref 5]
|
||||
if {abs($a1soll - $a1) >.01} {
|
||||
error "Bad a1 position, should $a1soll, is $a1"
|
||||
}
|
||||
set a1 [SICSValue a1]
|
||||
set a1soll [lindex $ref 5]
|
||||
if {abs($a1soll - $a1) >.01} {
|
||||
error "Bad a1 position, should $a1soll, is $a1"
|
||||
}
|
||||
set a2 [SICSValue a2]
|
||||
set a2soll [lindex $ref 6]
|
||||
if {abs($a2soll - $a2) >.01} {
|
||||
error "Bad a2 position, should $a2soll, is $a2"
|
||||
}
|
||||
set a3 [SICSValue a3]
|
||||
set a3soll [lindex $ref 7]
|
||||
if {abs($a3soll - $a3) >.01} {
|
||||
error "Bad a3 position, should $a3soll, is $a3"
|
||||
}
|
||||
set a4 [SICSValue a4]
|
||||
set a4soll [lindex $ref 8]
|
||||
if {abs($a4soll - $a4) >.01} {
|
||||
error "Bad a4 position, should $a4soll, is $a4"
|
||||
}
|
||||
set sgu [SICSValue sgu]
|
||||
set sgusoll [lindex $ref 9]
|
||||
if {abs($sgusoll - $sgu) >.01} {
|
||||
error "Bad sgu position, should $sgusoll, is $sgu"
|
||||
}
|
||||
set sgl [SICSValue sgl]
|
||||
set sglsoll [lindex $ref 10]
|
||||
if {abs($sglsoll - $sgl) >.01} {
|
||||
error "Bad sgl position, should $sglsoll, is $sgl"
|
||||
}
|
||||
set a5 [SICSValue a5]
|
||||
set a5soll [lindex $ref 11]
|
||||
if {abs($a5soll - $a5) >.01} {
|
||||
error "Bad a5 position, should $a5soll, is $a5"
|
||||
}
|
||||
set a6 [SICSValue a6]
|
||||
set a6soll [lindex $ref 12]
|
||||
if {abs($a6soll - $a6) >.01} {
|
||||
error "Bad a6 position, should $a6soll, is $a6"
|
||||
}
|
||||
|
||||
set qh [SICSValue qh]
|
||||
set qhsoll [lindex $ref 0]
|
||||
if {abs($qhsoll - $qh) >.01} {
|
||||
error "Bad qh position, should $qhsoll, is $qh"
|
||||
}
|
||||
set qk [SICSValue qk]
|
||||
set qksoll [lindex $ref 1]
|
||||
if {abs($qksoll - $qk) >.01} {
|
||||
error "Bad qk position, should $qksoll, is $qk"
|
||||
}
|
||||
set ql [SICSValue ql]
|
||||
set qlsoll [lindex $ref 2]
|
||||
if {abs($qlsoll - $ql) >.01} {
|
||||
error "Bad ql position, should $qlsoll, is $ql"
|
||||
}
|
||||
|
||||
set ei [SICSValue ei]
|
||||
set eisoll [lindex $ref 3]
|
||||
if {abs($eisoll - $ei) >.01} {
|
||||
error "Bad ei position, should $eisoll, is $ei"
|
||||
}
|
||||
set ef [SICSValue ef]
|
||||
set efsoll [lindex $ref 4]
|
||||
if {abs($efsoll - $ef) >.01} {
|
||||
error "Bad ef position, should $efsoll, is $ef"
|
||||
}
|
||||
}
|
||||
#===================== tests =========================================
|
||||
test tasub-1.0 {Test setting dd} -body {
|
||||
testPar "tasub mono dd" 3.35461 Mugger
|
||||
testPar "tasub ana dd" 3.35461 Mugger
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
test tasub-1.1 {Test setting ss} -body {
|
||||
testPar "tasub mono ss" 1 Mugger
|
||||
testPar "tasub ana ss" 1 Mugger
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
test tasub-1.2 {Test setting sample configuration} -body {
|
||||
testPar "tasub const" kf Mugger
|
||||
testPar "tasub ss" -1 Mugger
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
test tasub-1.3 {Test clearing tasub} -body {
|
||||
testOK "tasub clear"
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
test tasub-1.4 {Test setting cell} -body {
|
||||
checkSettingCell [list 7. 7. 7. 90. 90. 90.]
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
tasub mono dd 3.35461
|
||||
tasub ana dd 3.35461
|
||||
tasub mono ss 1
|
||||
tasub ana ss 1
|
||||
tasub const kf
|
||||
tasub ss -1
|
||||
|
||||
test tasub-1.5 {Basic calculation test} -body {
|
||||
set ref1 [list 1 0 0 5 5 37.075 74.150 168.27 -23.46 0 0 37.075 74.15]
|
||||
set ref2 [list 0 0 1 5 5 37.075 74.150 84.78 -10.44 0 0 37.075 74.15]
|
||||
set cell [list 9.95 9.95 22.24 90 90 90]
|
||||
testTasubCalculation $cell $ref1 $ref2
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
|
||||
test tasub-1.6 {Test driving ei} -body {
|
||||
drive ei 5.0
|
||||
set eit [SICSValue ei]
|
||||
set a1 [SICSValue a1]
|
||||
set a2 [SICSValue a2]
|
||||
if {abs(5 - $eit) > .001} {
|
||||
error "Readback of ei failed"
|
||||
}
|
||||
if {abs(37.07 - $a1) > .01} {
|
||||
error "Bad a1 value, is $a1, should 37.07"
|
||||
}
|
||||
if {abs(74.15 - $a2) > .01} {
|
||||
error "Bad a2 value, is $a2, should 74.15"
|
||||
}
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
test tasub-1.7 {Test driving ef} -body {
|
||||
drive ef 5.
|
||||
set eit [SICSValue ef]
|
||||
set a1 [SICSValue a5]
|
||||
set a2 [SICSValue a6]
|
||||
if {abs(5. - $eit) > .001} {
|
||||
error "Readback of ei failed"
|
||||
}
|
||||
if {abs(37.07 - $a1) > .01} {
|
||||
error "Bad a5 value, is $a1, should 37.07"
|
||||
}
|
||||
if {abs(74.15 - $a2) > .01} {
|
||||
error "Bad a6 value, is $a2, should 74.15"
|
||||
}
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
test tasub-1.8 {Test reading en} -body {
|
||||
drive ei 5. ef 3.7
|
||||
set en [SICSValue en]
|
||||
if {abs($en - 1.3) > .01} {
|
||||
error "Bad en value: should: 1.3, is $en"
|
||||
}
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
test tasub-1.9 {Test driving ef, different scattering sense} -body {
|
||||
tasub ana ss -1
|
||||
drive ef 5.0
|
||||
set eit [SICSValue ef]
|
||||
set a1 [SICSValue a5]
|
||||
set a2 [SICSValue a6]
|
||||
if {abs(5 - $eit) > .001} {
|
||||
error "Readback of ef failed"
|
||||
}
|
||||
if {abs(-37.07 - $a1) > .01} {
|
||||
error "Bad a5 value, is $a1, should -37.07"
|
||||
}
|
||||
if {abs(-74.15 - $a2) > .01} {
|
||||
error "Bad a6 value, is $a2, should -74.15"
|
||||
}
|
||||
return OK
|
||||
} -result OK
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user