- Test for TRICS
- Implemented testoll which can log a SICS session and create a test from it
This commit is contained in:
koennecke
@ -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
|
||||
@ -242,5 +242,3 @@ cone qscale 1
|
||||
cone center unknown
|
||||
simidx sttlim 0.2
|
||||
simidx anglim 0.5
|
||||
elli preset 10
|
||||
elli mode timer
|
||||
|
||||
@ -547,7 +547,7 @@ if {$astrium == 1} {
|
||||
source ../tcl/astrium.tcl
|
||||
}
|
||||
|
||||
set el737sec 1
|
||||
set el737sec 0
|
||||
|
||||
|
||||
if {$el737sec == 1} {
|
||||
|
||||
94
test/testrics
Executable file
94
test/testrics
Executable file
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
183
test/testtool
Executable file
183
test/testtool
Executable file
@ -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
|
||||
}
|
||||
}
|
||||
|
||||
185
test/testtricslist.tcl
Normal file
185
test/testtricslist.tcl
Normal file
@ -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
|
||||
|
||||
173
test/testtricsvar.tcl
Normal file
173
test/testtricsvar.tcl
Normal file
@ -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
|
||||
Reference in New Issue
Block a user