From dca149c242312b589e06dc5276ecb78bda4677ce Mon Sep 17 00:00:00 2001 From: koennecke Date: Fri, 24 Nov 2006 15:57:41 +0000 Subject: [PATCH] - Added many more regression tests for the SICServer --- test/DataNumber | 2 +- test/histtest.tcl | 14 ++- test/nxscripttest.tcl | 106 +++++++++++++++++ test/sicsdatasoll.dat | 23 ++++ test/sicsstat.tcl | 125 ++++++++++++++++++-- test/test.dic | 31 +++++ test/testini.tcl | 46 ++++++++ test/testmumo.tcl | 80 +++++++++++++ test/testsics | 14 ++- test/testsicsdata.tcl | 218 ++++++++++++++++++++++++++++++++++ test/testsoll.xml | 79 +++++++++++++ test/testtasub.tcl | 265 ++++++++++++++++++++++++++++++++++++++++++ test/testutil.tcl | 9 ++ 13 files changed, 995 insertions(+), 17 deletions(-) create mode 100644 test/nxscripttest.tcl create mode 100644 test/sicsdatasoll.dat create mode 100644 test/test.dic create mode 100644 test/testmumo.tcl create mode 100644 test/testsicsdata.tcl create mode 100644 test/testsoll.xml create mode 100644 test/testtasub.tcl diff --git a/test/DataNumber b/test/DataNumber index 533c5153..10d06faf 100644 --- a/test/DataNumber +++ b/test/DataNumber @@ -1,3 +1,3 @@ - 41 + 52 NEVER, EVER modify or delete this file You'll risk eternal damnation and a reincarnation as a cockroach!|n \ No newline at end of file diff --git a/test/histtest.tcl b/test/histtest.tcl index 94dc6900..c48f48ba 100644 --- a/test/histtest.tcl +++ b/test/histtest.tcl @@ -284,7 +284,7 @@ test hm-1.14 {Test Setting Time Binning} -body { return OK } -result OK #------------------------------------------------------------------------- -test hm-1.14 {Test Reading Time Binning} -body { +test hm-1.15 {Test Reading Time Binning} -body { set tst [SICSValue "tof notimebin"] if {$tst != 70} { error "NTOF bad, expected 70, got $tst" @@ -310,7 +310,7 @@ test hm-1.14 {Test Reading Time Binning} -body { tof countmode timer tof preset 2 tof countblock -test hm-1.14 {Test Reading TOF Data} -body { +test hm-1.16 {Test Reading TOF Data} -body { set ntof [SICSValue "tof notimebin"] set dim [SICSValue "tof configure dim0"] set alldata [expr $ntof*$dim] @@ -330,3 +330,13 @@ test hm-1.14 {Test Reading TOF Data} -body { } return OK } -result OK +#---------------------------------------------------------------------- +tof initval 1 +test hm-1.16 {Test TOF Sum} -body { + set val [SICSValue "tof sum 2 3 0 20"] + if {$val != 20 } { + error " tof sum failed, expected 20 received $val" + } + return OK +} -result OK + diff --git a/test/nxscripttest.tcl b/test/nxscripttest.tcl new file mode 100644 index 00000000..6421d087 --- /dev/null +++ b/test/nxscripttest.tcl @@ -0,0 +1,106 @@ +#--------------------------------------------------------------------------- +# Regression tests for the SICS nxscript module. +# +# Mark Koennecke, November 2006 +#--------------------------------------------------------------------------- + +puts stdout "Testing NXScript" + +test nxscript-1.0 {Test opening file} -body { + config rights Spy Spy + testCommand "nxscript createxml test.xml test.dic" ERROR + config rights User User + testOK "nxscript createxml test.xml test.dic" +} -result OK + +test nxscript-1.1 {Write text} -body { + testNoError "nxscript puttext text Hugo ist eine Nassnase" +} -result OK + +test nxscript-1.2 {Write float} -body { + testNoError "nxscript putfloat testfloat 27.8" +} -result OK + +test nxscript-1.3 {Write int} -body { + testNoError "nxscript putint testint 177" +} -result OK + +drive a4 15 +a4 softzer0 1. + +test nxscript-1.4 {Write motor} -body { + testNoError "nxscript putmot testmot a4" +} -result OK + +aba count 10 +test nxscript-1.5 {Write counter} -body { + testNoError "nxscript putcounter testcter aba" +} -result OK + +hm initval 55 +test nxscript-1.6 {Write HM} -body { + testNoError "nxscript puthm testhm hm" +} -result OK + +config rights Mugger Mugger +tof genbin 500 300 20 +tof init +config rights User User + +test nxscript-1.7 {Write time binning} -body { + testNoError "nxscript puttimebinning testhmtb tof" +} -result OK + + +test nxscript-1.8 {Write array } -body { + makearray + set t [nxscript putarray testar ar 10] + if {[string first ERROR $t] >= 0 || [string first WARNING $t] >= 0} { + error "Failed to write array with: $t" + } + return OK +} -result OK + +test nxscript-1.9 {Write int array } -body { + makeintarray + set t [nxscript putintarray testintar ar 10] + if {[string first ERROR $t] >= 0 || [string first WARNING $t] >= 0} { + error "Failed to write intarray with: $t" + } + return OK +} -result OK + +test nxscript-1.10 {Write global } -body { + testNoError "nxscript putglobal Instrument Washmaschine" +} -result OK + +test nxscript-1.11 {Write attribute } -body { + testNoError "nxscript putattribute testhm signal 1" +} -result OK + +test nxscript-1.12 {Writing link } -body { + testNoError "nxscript makelink testlink text" +} -result OK + +test nxscript-1.13 {Writing sicsdata } -body { + hm initval 23 + data clear + data copyhm 0 hm + testNoError "nxscript putsicsdata testsd data" +} -result OK + +test nxscript-1.20 {Close file} -body { + testOK "nxscript close" +} -result OK + +test nxscript-1.21 {Testing file content } -body { + set status [catch {exec diff --ignore-matching-lines=file_time test.xml testsoll.xml} msg] + if {$status != 0} { + error "Difference in NXSCRIP-XML file: $msg" + } + return OK +} -result OK + + + + \ No newline at end of file diff --git a/test/sicsdatasoll.dat b/test/sicsdatasoll.dat new file mode 100644 index 00000000..b5406ef2 --- /dev/null +++ b/test/sicsdatasoll.dat @@ -0,0 +1,23 @@ + 0 32 + 1 32 + 2 32 + 3 32 + 4 32 + 5 32 + 6 32 + 7 32 + 8 32 + 9 32 + 10 32 + 11 32 + 12 32 + 13 32 + 14 32 + 15 32 + 16 32 + 17 32 + 18 32 + 19 32 + 20 32 + 21 32 + 22 32 diff --git a/test/sicsstat.tcl b/test/sicsstat.tcl index 7206b843..3a5b7d91 100644 --- a/test/sicsstat.tcl +++ b/test/sicsstat.tcl @@ -9,7 +9,7 @@ brumm SoftLowerLim -180.000000 brumm SoftUpperLim 180.000000 brumm Fixed -1.000000 brumm InterruptMode 0.000000 -brumm precision 0.100000 +brumm precision 0.010000 brumm ignorefault 0.000000 brumm AccessCode 2.000000 brumm movecount 10.000000 @@ -20,22 +20,55 @@ miau SoftLowerLim -180.000000 miau SoftUpperLim 180.000000 miau Fixed -1.000000 miau InterruptMode 0.000000 -miau precision 0.100000 +miau precision 0.010000 miau ignorefault 0.000000 miau AccessCode 2.000000 miau movecount 10.000000 # Counter aba -aba SetPreset 2.000000 +aba SetPreset 10.000000 aba SetMode Timer # Counter hugo -hugo SetPreset 10.000000 +hugo SetPreset 1000.000000 hugo SetMode Timer # Counter lieselotte -lieselotte SetPreset 10.000000 +lieselotte SetPreset 1000.000000 lieselotte SetMode Timer # Counter multi -multi SetPreset 10.000000 +multi SetPreset 0.000000 multi SetMode Timer +# Motor a1 +a1 sign 1.000000 +a1 SoftZero 0.000000 +a1 SoftLowerLim -2.000000 +a1 SoftUpperLim 180.000000 +a1 Fixed -1.000000 +a1 InterruptMode 0.000000 +a1 precision 0.010000 +a1 ignorefault 0.000000 +a1 AccessCode 2.000000 +a1 movecount 10.000000 +# Motor a2 +a2 sign 1.000000 +a2 SoftZero 0.000000 +a2 SoftLowerLim 30.000000 +a2 SoftUpperLim 150.000000 +a2 Fixed -1.000000 +a2 InterruptMode 0.000000 +a2 precision 0.010000 +a2 ignorefault 0.000000 +a2 AccessCode 2.000000 +a2 movecount 10.000000 +# Motor a3 +a3 sign 1.000000 +a3 SoftZero 0.000000 +a3 SoftLowerLim -360.000000 +a3 SoftUpperLim 360.000000 +a3 Fixed -1.000000 +a3 InterruptMode 0.000000 +a3 precision 0.010000 +a3 ignorefault 0.000000 +a3 AccessCode 2.000000 +a3 movecount 10.000000 # Motor a4 a4 sign 1.000000 a4 SoftZero 0.000000 @@ -47,14 +80,82 @@ a4 precision 0.010000 a4 ignorefault 0.000000 a4 AccessCode 2.000000 a4 movecount 10.000000 +# Motor a5 +a5 sign 1.000000 +a5 SoftZero 0.000000 +a5 SoftLowerLim -180.000000 +a5 SoftUpperLim 180.000000 +a5 Fixed -1.000000 +a5 InterruptMode 0.000000 +a5 precision 0.010000 +a5 ignorefault 0.000000 +a5 AccessCode 2.000000 +a5 movecount 10.000000 +# Motor a6 +a6 sign 1.000000 +a6 SoftZero 0.000000 +a6 SoftLowerLim -180.000000 +a6 SoftUpperLim 180.000000 +a6 Fixed -1.000000 +a6 InterruptMode 0.000000 +a6 precision 0.010000 +a6 ignorefault 0.000000 +a6 AccessCode 2.000000 +a6 movecount 10.000000 +# Motor sgu +sgu sign 1.000000 +sgu SoftZero 0.000000 +sgu SoftLowerLim -20.000000 +sgu SoftUpperLim 20.000000 +sgu Fixed -1.000000 +sgu InterruptMode 0.000000 +sgu precision 0.010000 +sgu ignorefault 0.000000 +sgu AccessCode 2.000000 +sgu movecount 10.000000 +# Motor sgl +sgl sign 1.000000 +sgl SoftZero 0.000000 +sgl SoftLowerLim -20.000000 +sgl SoftUpperLim 20.000000 +sgl Fixed -1.000000 +sgl InterruptMode 0.000000 +sgl precision 0.010000 +sgl ignorefault 0.000000 +sgl AccessCode 2.000000 +sgl movecount 10.000000 # Counter scancter -scancter SetPreset 2.000000 +scancter SetPreset 0.000000 scancter SetMode Timer hm CountMode timer -hm preset 2.000000 -hm genbin 10.000000 20.000000 70 -hm init +hm preset 10.000000 tof CountMode timer -tof preset 2.000000 -tof genbin 50.000000 20.000000 70 +tof preset 10.000000 +tof genbin 500.000000 300.000000 20 tof init +#---- tasUB module tasub +tasub mono dd 3.354610 +tasub mono hb1 1.000000 +tasub mono hb2 1.000000 +tasub mono vb1 1.000000 +tasub mono vb2 1.000000 +tasub mono ss 1 +tasub ana dd 3.354610 +tasub ana hb1 1.000000 +tasub ana hb2 1.000000 +tasub ana vb1 1.000000 +tasub ana vb2 1.000000 +tasub ana ss -1 +tasub cell 9.950000 9.950000 22.240000 90.000000 90.000000 90.000000 +tasub clear +tasub addref 1.00 0.00 0.00 168.27 -23.46 0.00 0.00 5.00 5.00 +tasub addref 0.00 0.00 1.00 84.78 -10.44 0.00 0.00 5.00 5.00 +tasub outofplane 1 +tasub const kf +tasub ss -1 + tasub setub -0.100503 -0.000000 -0.000000 0.000000 -0.000000 -0.044964 0.000000 -0.100503 -0.000000 + tasub setnormal 0.000000 0.000000 1.000000 +tasub settarget 0.000000 0.000000 1.000000 0.000000 1.553424 1.553424 +tasub r1 1.00 0.00 0.00 168.27 -23.46 0.00 0.00 5.00 5.00 +tasub r2 0.00 0.00 1.00 84.78 -10.44 0.00 0.00 5.00 5.00 +tasub update diff --git a/test/test.dic b/test/test.dic new file mode 100644 index 00000000..34616f05 --- /dev/null +++ b/test/test.dic @@ -0,0 +1,31 @@ +##NXDICT-1.0 +#--------------------------------------------------------------------- +# Dictionary file for testing NXdict +# +# Mark Koennecke, November 2006 +#-------------------------------------------------------------------- +text=/entry1,NXentry/SDS testtext -type NX_CHAR +testfloat=/entry1,NXentry/SDS testfloat +testint=/entry1,NXentry/SDS testint -type NX_INT32 +testmot=/entry1,NXentry/SDS position +testmot_null=/entry1,NXentry/SDS position_zeropoint +testcter_preset=/entry1,NXentry/control,NXmonitor/SDS preset +testcter_mode=/entry1,NXentry/control,NXmonitor/SDS mode -type NX_CHAR +testcter_time=/entry1,NXentry/control,NXmonitor/SDS time +testcter_00=/entry1,NXentry/control,NXmonitor/SDS counts0 -type NX_INT32 +testcter_01=/entry1,NXentry/control,NXmonitor/SDS counts1 -type NX_INT32 +testcter_02=/entry1,NXentry/control,NXmonitor/SDS counts2 -type NX_INT32 +testcter_03=/entry1,NXentry/control,NXmonitor/SDS counts3 -type NX_INT32 +testcter_04=/entry1,NXentry/control,NXmonitor/SDS counts4 -type NX_INT32 +testhm=/entry1,NXentry/detector,NXdata/SDS hmdata -type NX_INT32 -rank 1 \ + -dim {$(dim0)} +testhmtb=/entry1,NXentry/detector,NXdata/SDS time_binning +testar=/entry1,NXentry/detector,NXdata/SDS x_axis +testintar=/entry1,NXentry/detector,NXdata/SDS y_axis -type NX_INT32 +testsd=/entry1,NXentry/detector,NXdata/SDS gurke -rank 1 \ + -type NX_INT32 -dim {$(dim0)} +testlink=/entry1,NXentry/detector,NXdata/NXVGROUP + + + + \ No newline at end of file diff --git a/test/testini.tcl b/test/testini.tcl index bf9c4ca5..b128f0cf 100644 --- a/test/testini.tcl +++ b/test/testini.tcl @@ -87,7 +87,14 @@ VarMake SicsDataPostFix Text Mugger SicsDataPostFix .dat SicsDataPostFix lock +Motor a1 SIM -2 180 -.1 10 +Motor a2 SIM 30 150 -.1 10 +Motor a3 SIM -360 360 -.1 10 Motor a4 SIM -180 180 -.1 10 +Motor a5 SIM -180 180 -.1 10 +Motor a6 SIM -180 180 -.1 10 +Motor sgu SIM -20 20 -.1 10 +Motor sgl SIM -20 20 -.1 10 MakeMultiCounter scanCter aba proc scantransfer {} { @@ -136,3 +143,42 @@ tof genbin 10 12 100 tof configure init 1 tof init +#------------------------------------------------------------------------- +# NXscript +#------------------------------------------------------------------------- +MakeNXScript +#------------------------------------------------------------------------- +proc makearray {} { + global ar + for { set i 10} {$i < 20} {incr i} { + set ar([expr $i - 10]) [expr $i*1.0] + } +} +#------------------------------------------------------------------------ +proc makeintarray {} { + global ar + for { set i 10} {$i < 20} {incr i} { + set ar([expr $i - 10]) $i + } +} +Publish makearray User +Publish makeintarray User +Publish parray User + +#------------------------------------------------------------------------ +# SicsData +#------------------------------------------------------------------------ +sicsdatafactory new data +sicsdatafactory new duta +#----------------------------------------------------------------------- +# tasub +#----------------------------------------------------------------------- +MakeTasUB tasub +#----------------------------------------------------------------------- +# MultiMotors +#---------------------------------------------------------------------- +MakeMulti sa +sa alias a3 om +sa alias a4 stt +sa pos noeff om 24 stt 48 +sa endconfig diff --git a/test/testmumo.tcl b/test/testmumo.tcl new file mode 100644 index 00000000..3a40d2e8 --- /dev/null +++ b/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 diff --git a/test/testsics b/test/testsics index 1d775ade..6b571844 100755 --- a/test/testsics +++ b/test/testsics @@ -18,7 +18,7 @@ source testutil.tcl source sicstcldebug.tcl #--------------- Test Miscellaneous stuff -source testmisc.tcl +#source testmisc.tcl #-------------- Test for motors #source mottest.tcl @@ -42,7 +42,17 @@ set countername multi #source optitest.tcl #----------- test histogram memory -source histtest.tcl +#source histtest.tcl + +#----------- test sics data +#source testsicsdata.tcl + + +#----------- test nxscript +#source nxscripttest.tcl + +#------------ test SANS MultiMotor +source testmumo.tcl #------------ print test summary cleanupTests diff --git a/test/testsicsdata.tcl b/test/testsicsdata.tcl new file mode 100644 index 00000000..c42b5fa9 --- /dev/null +++ b/test/testsicsdata.tcl @@ -0,0 +1,218 @@ +#------------------------------------------------------------------------- +# This is a regression test for the SICS data module +# +# Mark Koennecke, November 2006 +#------------------------------------------------------------------------- +puts stdout "Testing SicsData" +data clear + +test sicsdata-1.0 {Test writing int} -body { + config rights User User + for {set i 0} {$i < 5} { incr i} { + testOK "data putint $i $i" + } + for {set i 0} {$i < 5} { incr i} { + set val [SICSValue "data get $i"] + if {$val != $i} { + error "SicsData returned a bad value: expected $i received $val" + } + } + return OK +} -result OK + +test sicsdata-1.1 {Test writing float} -body { + for {set i 0} {$i < 5} { incr i} { + set v [expr $i * 1.0] + testOK "data putfloat $i $v" + } + for {set i 0} {$i < 5} { incr i} { + set val [SICSValue "data get $i"] + if {abs($val - $i) > .000001} { + error "SicsData returned a bad value: expected $i received $val" + } + } + return OK +} -result OK + +test sicsdata-1.2 {Test used} -body { + set val [SICSValue "data used"] + if {$val != 5} { + error "Expected data used to be 5, not $val" + } + return OK +} -result OK + +test sicsdata-1.3 {Test clear} -body { + testOK "data clear" + set val [SICSValue "data used"] + if {$val != 0} { + error "Expected data used to be 0, not $val" + } + return OK +} -result OK + +xxxscan clear +xxxscan add a4 2. .2 +xxxscan run 30 timer 2 + +test sicsdata-1.4 {Testing scancounts} -body { + testOK "data copyscancounts 0 xxxscan" + set val [SICSValue "data used"] + if {$val != 30} { + error "Expected data used to be 30, not $val" + } + set val [SICSValue "data get 0"] + if {$val != 10} { + error "Expected data 0 to be 10, not $val" + } + set val [SICSValue "data get 10"] + if {$val != 41} { + error "Expected data 10 to be 41, not $val" + } + set val [SICSValue "data get 20"] + if {$val != 171} { + error "Expected data 10 to be 171, not $val" + } + return OK +} -result OK + +test sicsdata-1.5 {Testing scanmonitor} -body { + testOK "data clear" + testOK "data copyscanmon 0 xxxscan 2" + set val [SICSValue "data used"] + if {$val != 30} { + error "Expected data used to be 30, not $val" + } + set val [SICSValue "data get 0"] + if {$val != 0} { + error "Expected data 0 to be 0, not $val" + } + return OK +} -result OK + +test sicsdata-1.6 {Testing scanvar} -body { + testOK "data copyscanvar 0 xxxscan 0" + set val [SICSValue "data used"] + if {$val != 30} { + error "Expected data used to be 30, not $val" + } + set val [SICSValue "data get 0"] + if {abs($val - 2.0) > .001} { + error "Expected data 0 to be 2.0, not $val" + } + set val [SICSValue "data get 20"] + if {abs($val - 6.0) > .001} { + error "Expected data 20 to be 6.0, not $val" + } + set val [SICSValue "data get 29"] + if {abs($val - 7.8) > .001} { + error "Expected data 29 to be 7.8, not $val" + } + return OK +} -result OK + +config rights Mugger Mugger +tof genbin 20 10 50 +tof init + +test sicsdata-1.7 {Testing timebin} -body { + testOK "data clear" + testOK "data copytimebin 0 tof" + set val [SICSValue "data used"] + if {$val != 50} { + error "Expected data used to be 50, not $val" + } + set val [SICSValue "data get 0"] + if {abs($val - 20.0) > .001} { + error "Expected data 0 to be 20.0, not $val" + } + set val [SICSValue "data get 49"] + if {abs($val - 510.0) > .001} { + error "Expected data 49 to be 510.0, not $val" + } + return OK +} -result OK + +hm initval 32 + +test sicsdata-1.8 {Testing hm} -body { + testOK "data clear" + testOK "data copyhm 0 hm" + set val [SICSValue "data used"] + if {$val != 23} { + error "Expected data used to be 23, not $val" + } + set val [SICSValue "data get 0"] + if {abs($val - 32.0) > .001} { + error "Expected data 0 to be 32.0, not $val" + } + set val [SICSValue "data get 22"] + if {abs($val - 32.0) > .001} { + error "Expected data 22 to be 32.0, not $val" + } + return OK +} -result OK + +test sicsdata-1.8 {Testing UU write} -body { + set text [data writeuu hugo] + if {[string first "begin 622" $text] < 0} { + error "Bad reply on uuwrite: $text" + } + return OK +} -result OK + +test sicsdata-1.9 {Testing file dump} -body { + data clear + data copyhm 0 hm + testOK "data dump test.dat" + set status [catch {exec diff test.dat sicsdatasoll.dat} msg] + if {$status != 0} { + error "Difference in dump file: $msg" + } + return OK +} -result OK + +test sicsdata-1.10 {Copying sicsdata} -body { + duta clear + data clear + data copyhm 0 hm + testNoError "duta copydata 0 data 0 23" + set val [SICSValue "duta used"] + if {$val != 23} { + error "Expected data used to be 23, not $val" + } + for {set i 0} {$i < 23} {incr i} { + set val [SICSValue "duta get $"] + if {abs($val - 32.0) > .001} { + error "Expected data $i to be 32.0, not $val" + } + } + return OK +} -result OK + +test sicsdata-1.11 {Division} -body { + + config rights Mugger Mugger + duta clear + data clear + hm initval 32 + data copyhm 0 hm + hm initval 16 + duta copyhm 0 hm + testNoError "data divideby duta" + set val [SICSValue "data used"] + if {$val != 23} { + error "Expected data used to be 23, not $val" + } + for {set i 0} {$i < 23} {incr i} { + set val [SICSValue "data get $"] + if {abs($val - 2.0) > .001} { + error "Expected data $i to be 2.0, not $val" + } + } + return OK +} -result OK + + + + diff --git a/test/testsoll.xml b/test/testsoll.xml new file mode 100644 index 00000000..3d0c0638 --- /dev/null +++ b/test/testsoll.xml @@ -0,0 +1,79 @@ + + + + Hugo ist eine Nassnase + + 27.8000 + + + 177 + + + 15.0000 + + + 0.0000 + + + + 10.0000 + + timer + + + 5 + + + 10 + + + 25 + + + 35 + + + 45 + + + + + 55 55 55 55 + 55 55 55 55 + 55 55 55 55 + 55 55 55 55 + 55 55 55 55 + 55 55 55 + + + 500.0000 800.0000 1100.0000 1400.0000 + 1700.0000 2000.0000 2300.0000 2600.0000 + 2900.0000 3200.0000 3500.0000 3800.0000 + 4100.0000 4400.0000 4700.0000 5000.0000 + 5300.0000 5600.0000 5900.0000 6200.0000 + + + 10.0000 11.0000 12.0000 13.0000 + 14.0000 15.0000 16.0000 17.0000 + 18.0000 19.0000 + + + 10 11 12 13 + 14 15 16 17 + 18 19 + + + + 23 23 23 23 + 23 23 23 23 + 23 23 23 23 + 23 23 23 23 + 23 23 23 23 + 23 23 23 + + + + diff --git a/test/testtasub.tcl b/test/testtasub.tcl new file mode 100644 index 00000000..486ac33e --- /dev/null +++ b/test/testtasub.tcl @@ -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 + + + + + \ No newline at end of file diff --git a/test/testutil.tcl b/test/testutil.tcl index 413354bd..c8b3d1c5 100644 --- a/test/testutil.tcl +++ b/test/testutil.tcl @@ -145,6 +145,15 @@ proc testOK {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} {