- Expanded test cases

2009-02-03 08:11:59 +00:00
parent 7663b4e88b
commit 9d4d09854e
7 changed files with 265 additions and 21 deletions
--- a/test/testsinglex.tcl
+++ b/test/testsinglex.tcl
@ -0,0 +1,115 @@
+#---------------------------------------------------------------
+# This is for testing the new coordinated single crystal stuff 
+# for SICS.
+#
+# Mark Koennecke, July - August 2008
+#---------------------------------------------------------------
+puts stdout "Testing Four Circle Codes"
+
+set testub ".1215666 -.138694 -.0021278 -.1386887 -.1216454 .0010515 -.0049867 .0020612 -.081156"
+set testcell "5.4202 5.4202 12.3228 90. 90. 90."
+#---------------------------------------------------------------
+proc testReflection {ref} {
+    drive h [lindex $ref 0] k [lindex $ref 1] l [lindex $ref 2]
+    set stt [SICSValue a4]
+    compareValue $stt [lindex $ref 3]
+    set om [SICSValue a3]
+    compareValue $om [lindex $ref 4]
+    set chi [SICSValue chi]
+    compareValue $chi [lindex $ref 5]
+    set phi [SICSValue phi]
+    compareValue $phi [lindex $ref 6]
+}
+#--------------------------------------------------------------
+proc testAng {ref} {
+    set stt [SICSValue a4]
+    compareValue $stt [lindex $ref 0]
+    set om [SICSValue a3]
+    compareValue $om [lindex $ref 1]
+    set chi [SICSValue chi]
+    compareValue $chi [lindex $ref 2]
+    set phi [SICSValue phi]
+    compareValue $phi [lindex $ref 3]
+}
+#======================= Tests =================================
+test singlex-1.0 {Testing Setting Lambda} -body {
+    testPar  "singlex lambda" 1.1785 User
+    return OK
+} -result OK
+
+test singlex-1.1 {Testing Mode Setting} -body {
+    testPar  "singlex mode" bi User
+    testPar  "singlex mode" nb User
+    testPar  "singlex mode" tas User
+    set test [catch {singlex mode shitty} msg]
+    if {$test == 0} {
+	if {[string first ERROR $msg] < 0} {
+	    error "Test for shitty mode failed"
+	}
+    }
+    return OK
+} -result OK
+
+test singlex-1.2 {Testing Setting Cell} -body {
+    testMultiPar "singlex cell" $testcell User
+    return OK
+} -result OK
+
+test singlex-1.3 {Testing Setting UB} -body {
+    testMultiPar "singlex ub" $testub User
+    return OK
+} -result OK
+
+config rights User User
+singlex ub $testub
+singlex lambda 1.178
+
+test singlex-1.4 {Driving Reflection} -body {
+    set ref [list 2 2 0 35.80 17.90 180.6425 86.229]
+    testReflection $ref
+    return OK
+} -result OK
+
+test singlex-1.5 {Driving Reflection though hkl} -body {
+    hkl drive 2 2 0
+    set ref [list 35.80 17.90 180.6425 86.229]
+    testAng $ref
+    return OK
+} -result OK
+
+
+test singlex-1.6 {UB Calculation, 2 Reflections, Cell} -body {
+    singlex cell $testcell
+    ref clear
+    ref addax 2 2 0 35.80 17.90 180.642 86.229
+    ref addax 0 0 3 16.498 8.249 268.331 333.714
+    ubcalc ub2ref 0000 0001
+    ubcalc activate
+    set ubr [SICSValue "singlex ub"]
+    compareMultiValue $ubr $testub
+    return OK
+} -result OK
+
+test singlex-1.7 {UB Calculation, 3 Reflections} -body {
+    ref clear
+    ref addax 2 2 0 35.80 17.90 180.642 86.229
+    ref addax 0 0 3 16.498 8.249 268.331 333.714
+    ref addax 1 0 0 12.478 6.239 181.549 131.232
+    ubcalc ub3ref 0000 0001 0002
+    ubcalc activate
+    set ubr [SICSValue "singlex ub"]
+    compareMultiValue $ubr $testub
+    return OK
+} -result OK
+
+test singlex-1.8 {Cell from UB} -body {
+    ref clear
+    ref addax 2 2 0 35.80 17.90 180.642 86.229
+    ref addax 0 0 3 16.498 8.249 268.331 333.714
+    ref addax 1 0 0 12.478 6.239 181.549 131.232
+    ubcalc ub3ref 0000 0001 0002
+    set cell [ubcalc cellub]
+    compareMultiValue $cell $testcell .03
+    return OK
+} -result OK
+