From 340868fd3f2d722a372e568c9f9ba2f2dadcd36f Mon Sep 17 00:00:00 2001 From: koennecke Date: Mon, 9 Mar 2009 08:31:34 +0000 Subject: [PATCH] - Test for TRICS - Implemented testoll which can log a SICS session and create a test from it --- test/DataNumber | 2 +- test/sicsstat.tcl | 2 - test/testini.tcl | 2 +- test/testrics | 94 +++++++++++++++++++++ test/testsics | 23 ++--- test/testsinglex.tcl | 67 +++++++++++++++ test/testtool | 183 ++++++++++++++++++++++++++++++++++++++++ test/testtricslist.tcl | 185 +++++++++++++++++++++++++++++++++++++++++ test/testtricsvar.tcl | 173 ++++++++++++++++++++++++++++++++++++++ 9 files changed, 716 insertions(+), 15 deletions(-) create mode 100755 test/testrics create mode 100755 test/testtool create mode 100644 test/testtricslist.tcl create mode 100644 test/testtricsvar.tcl diff --git a/test/DataNumber b/test/DataNumber index 24bf9512..fa8b1573 100644 --- a/test/DataNumber +++ b/test/DataNumber @@ -1,3 +1,3 @@ - 247 + 255 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/sicsstat.tcl b/test/sicsstat.tcl index 0bb20e9f..e48ef1b5 100644 --- a/test/sicsstat.tcl +++ b/test/sicsstat.tcl @@ -242,5 +242,3 @@ cone qscale 1 cone center unknown simidx sttlim 0.2 simidx anglim 0.5 -elli preset 10 -elli mode timer diff --git a/test/testini.tcl b/test/testini.tcl index f10ce788..c4020814 100644 --- a/test/testini.tcl +++ b/test/testini.tcl @@ -547,7 +547,7 @@ if {$astrium == 1} { source ../tcl/astrium.tcl } -set el737sec 1 +set el737sec 0 if {$el737sec == 1} { diff --git a/test/testrics b/test/testrics new file mode 100755 index 00000000..960b5a9c --- /dev/null +++ b/test/testrics @@ -0,0 +1,94 @@ +#!/usr/bin/tclsh +#------------------------------------------------------------------------------ +# This is a regression test for TRICS Before this can be used a SICServer must +# have been started with: SICServer trics(n).tcl This file uses the +# tcltest package which comes with SICS for tests. I assume that the SICServer +# already stands the genral test. +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, February 2009 +#------------------------------------------------------------------------------ +# as of now we have tcl8.3 which has an outdated version of tcltest. We use +# a better version in a local file. Once tcl8.4 has made it into the distro +# I use, use the line below. We need tcltest 2.+ +# package require tcltest +source tcltest.tcl +namespace import tcltest::* +source testutil.tcl +source sicstcldebug.tcl + +#------------ test SingleX +source testsinglex.tcl + +#------------- test variables +source testtricsvar.tcl + +#------------ test lists +source testtricslist.tcl + +#---------- test data collection +proc compareCollectLists {islist shouldlist} { + set count 0 + for {set i 0} {$i < [llength $islist]} {incr i} { + set is [string trim [lindex $islist $i]] + set should [lindex $shouldlist $i] + if {[string first "Now Scanning" $is] >= 0} { + set idx [string first "star data" $is] + set is [string range $is 0 $idx] + set should [string range $should 0 $idx] + if {[string compare $is $should] != 0} { + error "Mismatch in collect line, is $is, should $should" + } + set count 0 + continue + } + if {[string first WARNING $is] >= 0} { + if {[string compare $is $should] != 0} { + error "Mismatch in collect line, is $is, should $should" + } + set count 1 + continue + } + if {$count == 1} { + set count 2 + } + if {$count == 2} { + set len [string length $is] + set len [expr $len -20] + set is [string range $is 0 $len] + set should [string range $should 0 $len] + if {[string compare $is $should] != 0} { + error "Mismatch in collect line, is $is, should $should" + } + set count 3 + continue + } + if {$count == 3} { + set count 4 + continue + } + if {$count == 4} { + set count 4 + continue + } + if {[string compare $is $should] != 0} { + error "Mismatchi in collect line, is $is, should $should" + } + } +} +config rights Mugger Mugger +detmode single +mode bi +cell 5.32 5.4 13.18 90 90 90 +stt softzero 0 +stt softupperlim 60 +stt softlowerlim -20 + +puts stdout "Testing TRICS Data Collection " + +source testtricscollect.tcl + +#------------ print test summary +cleanupTests +exit 1 diff --git a/test/testsics b/test/testsics index f80eed96..2f374c8b 100755 --- a/test/testsics +++ b/test/testsics @@ -7,6 +7,7 @@ # copyright: see file COPYRIGHT # # Started: Mark Koennecke, July 2006 +# Mark Koennecke, February 2009 #------------------------------------------------------------------------------ # as of now we have tcl8.3 which has an outdated version of tcltest. We use # a better version in a local file. Once tcl8.4 has made it into the distro @@ -18,41 +19,41 @@ source testutil.tcl source sicstcldebug.tcl #--------------- Test Miscellaneous stuff -source testmisc.tcl +#source testmisc.tcl #-------------- Test for motors -source mottest.tcl +#source mottest.tcl #-------------- Test Counter set countername aba set errorname aba -source countertest.tcl +#source countertest.tcl #-------------- Test Multi Counter set countername multi -source countertest.tcl +#source countertest.tcl #-------------- Test batch processing -source batchtest.tcl +#source batchtest.tcl #-------------- Test scans -source scantest.tcl +#source scantest.tcl #------------ Test peak optimization -source optitest.tcl +#source optitest.tcl #----------- test histogram memory -source histtest.tcl +#source histtest.tcl #----------- test sics data -source testsicsdata.tcl +#source testsicsdata.tcl #----------- test nxscript -source nxscripttest.tcl +#source nxscripttest.tcl #------------ test SANS MultiMotor -source testmumo.tcl +#source testmumo.tcl #------------ test SingleX source testsinglex.tcl diff --git a/test/testsinglex.tcl b/test/testsinglex.tcl index 5b94cc21..b43b71ca 100644 --- a/test/testsinglex.tcl +++ b/test/testsinglex.tcl @@ -8,6 +8,7 @@ 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." +singlex mode bi #--------------------------------------------------------------- proc testReflection {ref} { drive h [lindex $ref 0] k [lindex $ref 1] l [lindex $ref 2] @@ -113,3 +114,69 @@ test singlex-1.8 {Cell from UB} -body { return OK } -result OK +#------------------------------------------------------------- +# more tests for NB mode +#------------------------------------------------------------- +config rights Mugger Mugger +singlex mode nb +config rights User User + +singlex ub 0.0228379 0.0773564 0.0476423 -0.1007840 0.0437923 0.0051331 -0.0213284 -0.0568516 0.0940093 +singlex cell 9.663 9.663 9.663 81.496 81.496 81.496 +ref clear +ref addax 1 -2 -1 17.889732 -123.9175 -0.1104 +ref addax 1 1 1 10.621792 -14.005692 0.804147 +ref addax -1 2 1 17.8897 56.069 -.154 + +proc testNBReflection {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 nu [SICSValue nu] + compareValue $nu [lindex $ref 5] +} +#-------------------------------------------------------------- +proc testNBAng {ref} { + set stt [SICSValue a4] + compareValue $stt [lindex $ref 0] + set om [SICSValue a3] + compareValue $om [lindex $ref 1] + set nu [SICSValue nu] + compareValue $nu [lindex $ref 2] +} + +test singlex-1.9 {Driving NB Reflection} -body { + set ref [list 1 -2 -1 17.889 -123.9175 -0.1104] + testNBReflection $ref + return OK +} -result OK + + +test singlex-1.10 {Driving NB- Reflection though hkl} -body { + hkl drive 1 -2 -1 + set ref [list 17.889 -123.9175 -0.1104] + testNBAng $ref + return OK +} -result OK + +test singlex-1.6 {UB Calculation,NB, 2 Reflections, Cell} -body { + ubcalc ub2ref 0000 0001 + ubcalc activate + set ubr [SICSValue "singlex ub"] + compareMultiValue $ubr $testub + return OK +} -result OK + +test singlex-1.7 {UB Calculation,NB, 3 Reflections} -body { + ubcalc ub3ref 0000 0001 0002 + ubcalc activate + set ubr [SICSValue "singlex ub"] + compareMultiValue $ubr $testub + return OK +} -result OK + +config rights Mugger Mugger +singlex mode bi +config rights User User diff --git a/test/testtool b/test/testtool new file mode 100755 index 00000000..b09a688f --- /dev/null +++ b/test/testtool @@ -0,0 +1,183 @@ +#!/usr/bin/tclsh +#------------------------------------------------------------- +# This is a tool for generating tests for SICS. In collect mode +# it will log the I/O goint to and from SICS into a file, +# testtool.log. In generate mode it will parse that file, +# and create a set of tcl unit tests from the log. In this way +# one can go from normal SICS testing through issuing commands +# to an automated test suite easily. If there is stuff you do +# not want in in the log, do not despair: the file is editable, +# the format simple, just delete that what is not required. +# +# The log file format: Line content is deduced from the first +# character: +# Lines starying with > are input to SICS +# Lines starting with < are output from SICS. +# Each sequence of input and the output till the next input will +# constitute a single unit test. +# +# Usage instructions: +# 1a) Generate a testlog by starting with testtool collect +# 1b) Issue the SICS commands to be tested. +# 1c) Edit and save the generated testloog.log file to a +# safe place. But leave it there as testtool.log +# 2) Generate the testsuite by issuing testtool generate prefix. +# Prefix is a choosen name which charcaterizes the tests. Generate +# reads testtool.log only and writes to stdout. +# 3) If later the tests fail but you verified that the change is only +# in the output you can: +# - Run testool regenerate on the saved logfile from 1c +# - Run testtool gnerate again to recreate the unit tests +# +# Mark Koennecke, February 2009 +#---------------------------------------------------------------- + +#------------------------------------------------------------------ +# Automatically operate on localhost +# This is derived from the code of sicstcldebug.tcl +#------------------------------------------------------------------- +set socke [socket localhost 2911] +gets $socke +puts $socke "Spy Spy" +flush $socke +gets $socke +set out stdout +#------------------------------------------------------------------ +proc unknown args { + global out + global socke + set comm [join $args] + append com "transact " $comm + if {[string first testexit $comm] >= 0} { + close $out + close $socke + puts stdout "Test Exited" + exit 0 + } + puts $socke $com + flush $socke + puts $out ">$comm" + set reply "" + while {1} { + set line [gets $socke] + if {[string first TRANSACTIONFINISHED $line] >= 0} { + return $reply + } else { + puts $out "<$line" + append reply $line "\n" + } + } +} +#------------------------------------------------------------------ +proc clientput args { + puts stdout [join $args] +} +#------------------------------------------------------------------ +proc repl {} { + global out + set out [open testtool.log w] + while {1} { + gets stdin line + catch {eval $line} msg + puts stdout $msg + } +} +#----------------------------------------------------------------- +proc outputTest {prefix command outlist} { + global count + puts stdout "test $prefix-$count {$prefix $count} -body {" + puts stdout " set shouldlist \[list $outlist\]" + puts stdout " catch {$command} reply" + puts stdout " set islist \[split \$reply \"\\n\"\]" + puts stdout " for {set i 0} {\$i < \[llength \$islist\]} {incr i} {" + puts stdout " set is \[lindex \$islist \$i\]" + puts stdout " set should \[string trim \[lindex \$shouldlist \$i\]\]" + puts stdout " if {\[string compare \$is \$should\] != 0 } {" + puts stdout " error \"Mismatch in test: is \$is, should: \$should\" " + puts stdout " }" + puts stdout " }" + puts stdout " return OK" + puts stdout "} -result OK" +} +#----------------------------------------------------------------- +proc generate {prefix} { + global count + set count 0 + set status [catch {open testtool.log r} in] + if {$status != 0} { + puts stdout "File testtool.log not found, run testtool collect first" + exit 1 + } + while {[gets $in line] > 0} { + if {[string compare [string index $line 0] ">"] == 0} { + if {[info exists outlist] == 1} { + outputTest $prefix $command $outlist + } + catch {unset outlist} + incr count + set command [string trim [string range $line 1 end]] + } + if {[string compare [string index $line 0] "<"] == 0} { + lappend outlist [string trim [string range $line 1 end]] + } + } + if {[info exists outlist] == 1} { + outputTest $prefix $command $outlist + } + close $in +} +#----------------------------------------------------------------- +proc regenerate {infile} { + global out + set status [catch {open testtool.log w} out] + if {$status != 0} { + puts stdout "Failed to open testool.log" + exit 1 + } + set status [catch {open $infile r} in] + if {$status != 0} { + puts stdout "Failed to open $infile" + exit 1 + } + while {[gets $in line] > 0} { + if {[string compare [string index $line 0] ">"] == 0} { + set command [string trim [string range $line 1 end]] + eval $command + } + } + close $in + close $out +} +#=================================================================== +# Main, ach wie gemein! +#================================================================== +if {[llength $argv] < 1} { + puts stdout "Usage:\n\ttestool collect\n\ttesttool generate prefix\n\ttesttool regnerate logfile" + exit 1 +} + +set key [string trim [lindex $argv 0]] +switch $key { + collect { + repl + } + generate { + if {[llength $argv] < 2} { + puts stdout "Usage:\n\ttestool generate prefix\n" + exit 1 + } + generate [lindex $argv 1] + } + regenerate { + if {[llength $argv] < 2} { + puts stdout "Usage:\n\ttestool regenerate logfile\n" + exit 1 + } + regenerate [lindex $argv 1] + } + default { + puts stdout "No action for key $key" + exit 1 + } +} + diff --git a/test/testtricslist.tcl b/test/testtricslist.tcl new file mode 100644 index 00000000..dc6520db --- /dev/null +++ b/test/testtricslist.tcl @@ -0,0 +1,185 @@ +#--------------------------------------------------------- +# This tests TRICS list operations. Tests will be performed +# by using various list configuration commands and +# saving the list to a file. This file will be compared +# with a known good one. Thus a failed test just means that +# the text generated changed. This may or may not be critical, +# a further examination with tkdiff will reveal if this needs +# to be fixed or if the generated file has simply to be +# renamed to become the comparison file. +# +# Mark Koennecke, February 2009 +#-------------------------------------------------------------- + +puts stdout "Testing TRICS List Processing" +config rights Mugger Mugger +mode bi +config rights User User +set testcell "5.4202 5.4202 12.3228 90. 90. 90." +cell $testcell + +proc configureBiList {} { + refclear + refadd ang 12 6 120.3 321.77 + refadd idx 2 0 0 + refadd idxang 1 0 0 11 5.5 77.8 167.56 + refdel 0001 + refadd idx 3 0 0 + refadd idx 4 0 0 + refadd idx 5 0 0 + refadd idx 6 0 0 + refhkl 0004 7 1 1 + refang 0005 22.2 12.3 77.8 129.8 +} + +test tricslist-1.0 {Test Reflectionlist Bisecting} -body { + configureBiList + configureBiList + refsave test/test.dat + set status [catch {exec diff test.dat testbi.ref} msg] + if {$status != 0} { + error "Differences found in reflection list for bisecting, investigate!" + } + return OK +} -result OK + +config rights Mugger Mugger +mode nb +config rights User User + +proc configureNBList {} { + refclear + refadd ang 12 70 10.3 + refadd idx 2 0 0 + refadd idxang 1 0 0 11 5.5 77.8 + refdel 0001 + refadd idx 3 0 0 + refadd idx 4 0 0 + refadd idx 5 0 0 + refadd idx 6 0 0 + refhkl 0004 7 1 1 + refang 0005 22.2 72.3 77.8 +} + +test tricslist-1.1 {Test Reflectionlist Normal Beam} -body { + configureNBList + configureNBList + refsave test/test.dat + set status [catch {exec diff test.dat testnb.ref} msg] + if {$status != 0} { + error "Differences found in reflection list for normal beam, investigate!" + } + return OK +} -result OK + + +config rights Mugger Mugger +mode tas +config rights User User + +proc configureTASList {} { + refclear + refadd ang 12 70 3.5 7.8 + refadd idx 2 0 0 + refadd idxang 1 0 0 11 7.5 7.2 11. + refdel 0001 + refadd idx 3 0 0 + refadd idx 4 0 0 + refadd idx 5 0 0 + refadd idx 6 0 0 + refhkl 0004 7 1 1 + refang 0005 22.2 7.8 8.1 2.1 +} + +test tricslist-1.2 {Test Reflectionlist TAS} -body { + configureTASList + configureTASList + refsave test/test.dat + set status [catch {exec diff test.dat testtas.ref} msg] + if {$status != 0} { + error "Differences found in reflection list for TAS, investigate!" + } + return OK +} -result OK + + +config rights Mugger Mugger +mode bi +config rights User User + + +proc configureDCList {} { + tabclear + tabadd 30 om .1 10 10000 + tabadd 50 om .2 12 20000 + tabadd 60 o2t .1 20 30000 +} + + 30.000 om 0.100 10 10000.000 + 50.000 om 0.200 12 20000.000 + 60.000 o2t 0.100 20 30000.000 + +test tricslist-1.4 {Test Data Collection Configuration } -body { + set should "30.000 om 0.100 10 10000.000\n 50.000 om 0.200 12 20000.000\n 60.000 o2t 0.100 20 30000.000" + configureDCList + configureDCList + set msg [string trim [tablist]] + if {[string compare [string trim $msg] $should] != 0} { + error "Received $msg, should have been $should" + } + return OK +} -result OK + +hkllimit -3 -3 -3 6 8 8 7 35. +spgrp P4 + +test tricslist-1.5 {Test Data Collection List Bisecting } -body { + hklgen sup + indw .3 0 .3 + indsort + indsave test/test.dat + set status [catch {exec diff test.dat dcbi.ref} msg] + if {$status != 0} { + error "Differences found in data collection list for bisecting, investigate!" + } + return OK +} -result OK + +config rights Mugger Mugger +mode nb +config rights User User + + +test tricslist-1.6 {Test Data Collection List Normal Beam } -body { + hklgen sup + indw .3 0 .3 + indsort + indsave test/test.dat + set status [catch {exec diff test.dat dcbi.ref} msg] + if {$status != 0} { + error "Differences found in data collection for normal beam, investigate!" + } + return OK +} -result OK + +config rights Mugger Mugger +mode tas +config rights User User + +test tricslist-1.7 {Test Data Collection List TAS} -body { + hklgen sup + indw .3 0 .3 + indsort + indsave test/test.dat + set status [catch {exec diff test.dat dctas.ref} msg] + if {$status != 0} { + error "Differences found in reflection list for TAS, investigate!" + } + return OK +} -result OK + + +config rights Mugger Mugger +mode bi +config rights User User + diff --git a/test/testtricsvar.tcl b/test/testtricsvar.tcl new file mode 100644 index 00000000..e0a9f275 --- /dev/null +++ b/test/testtricsvar.tcl @@ -0,0 +1,173 @@ +#------------------------------------------------------------ +# This is part of the regression test suite for TRICS. This +# test the existence and proper operation of several variables. +# +# Mark Koennecke, February 2009 +#-------------------------------------------------------------- +puts stdout "Testing TRICS variables " +set testub "0.1215666 -0.138694 -0.0021278 -0.1386887 -0.1216454 0.0010515 -0.0049867 0.0020612 -0.081156" + +test tricsvar-1.0 {Test projectdir} -body { + testPar projectdir /home/user/batch User + return OK +} -result OK + +test tricsvar-1.1 {Test title} -body { + testPar title Oksanaoxid User + return OK +} -result OK + +test tricsvar-1.2 {Test user} -body { + testPar User "Willi Wuergehals" User + return OK +} -result OK + +test tricsvar-1.3 {Test phone} -body { + testPar phone +41-56-3102512 User + return OK +} -result OK + +test tricsvar-1.4 {Test address} -body { + testPar address "Kurkenstrasse 27" User + return OK +} -result OK + +test tricsvar-1.5 {Test sample} -body { + testPar sample GurkenSulfid User + return OK +} -result OK + +test tricsvar-1.6 {Test lambda} -body { + testPar lambda 1.179 User + return OK +} -result OK + +test tricsvar-1.7 {Test spacegroup} -body { + testPar spgrp P4 User + return OK +} -result OK + +test tricsvar-1.8 {Test mode} -body { + testPar mode bi Mugger + testPar mode nb Mugger + testPar mode tas Mugger + return OK +} -result OK + +test tricsvar-1.9 {Test detmode} -body { + testPar detmode single Mugger + testPar detmode area Mugger + return OK +} -result OK + +test tricsvar-1.10 {Test cell} -body { + testPar cell "1 2 3 90 120 90" User + return OK +} -result OK + + +test tricsvar-1.11 {Test ub } -body { + testMultiPar ub "$testub" User + return OK +} -result OK + +config rights User User + + +test tricsvar-1.12 {Test confsearch } -body { + set should "min2t = 5,step2t = 2,max2t = 10,stepchi = 10,stepphi = 1,chimin = 90,chimax = 180,phimin = 0,phimax = 180" + set status [catch {confsearch 5 2 10 10 1 90 180 0 180} msg] + if {$status != 0} { + error $msg + } + set status [catch {confsearch} msg] + if {$status != 0} { + error $msg + } + if {[string compare [string trim $msg] $should] != 0} { + error "Received $msg, should have been $should" + } + return OK +} -result OK + +test tricsvar-1.13 {Test confsearchnb } -body { + set should "min2t = 5,step2t = 2,max2t = 10,stepom = 2,stepnu = 2" + set status [catch {confsearchnb 5 2 10 2 2} msg] + if {$status != 0} { + error $msg + } + set status [catch {confsearchnb} msg] + if {$status != 0} { + error $msg + } + if {[string compare [string trim $msg] $should] != 0} { + error "Received $msg, should have been $should" + } + return OK +} -result OK + +test tricsvar-1.14 {Test coneconf} -body { + set should "coneconf = 0001 1 1 1 1" + set status [catch {coneconf 0001 1 1 1} msg] + if {$status != 0} { + error $msg + } + set status [catch {coneconf} msg] + if {$status != 0} { + error $msg + } + if {[string compare [string trim $msg] $should] != 0} { + error "Received $msg, should have been $should" + } + return OK +} -result OK + + +test tricsvar-1.15 {Test indexconf} -body { + set should "simidxconf = 0.3, 0.5" + set status [catch {indexconf .3 .5} msg] + if {$status != 0} { + error $msg + } + set status [catch {indexconf} msg] + if {$status != 0} { + error $msg + } + if {[string compare [string trim $msg] $should] != 0} { + error "Received $msg, should have been $should" + } + return OK +} -result OK + +test tricsvar-1.16 {Test hkllimit} -body { + set should "indconf = 0 0 0 6 6 6 5 40" + set status [catch {hkllimit 0 0 0 6 6 6 5 40} msg] + if {$status != 0} { + error $msg + } + set status [catch {hkllimit} msg] + if {$status != 0} { + error $msg + } + if {[string compare [string trim $msg] $should] != 0} { + error "Received $msg, should have been $should" + } + return OK +} -result OK + + +test tricsvar-1.17 {Test collconf} -body { + set should "timer 1 100" + set status [catch {collconf timer 1 100} msg] + if {$status != 0} { + error $msg + } + set status [catch {collconf} msg] + if {$status != 0} { + error $msg + } + if {[string compare [string trim $msg] $should] != 0} { + error "Received $msg, should have been $should" + } + return OK +} -result OK