linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

merge and replace with PSI+site_ansto

Browse Source
This commit is contained in:
Douglas Clowes
2012-11-26 11:33:14 +11:00
parent 27b9f0aee0 4f560552c4
commit 9a1be5a80b
541 changed files with 131710 additions and 82841 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
test/DataNumber
View File

@ -1,3 +1,3 @@
131
348
NEVER, EVER modify or delete this file
You'll risk eternal damnation and a reincarnation as a cockroach!|n
You'll risk eternal damnation and a reincarnation as a cockroach!

11
test/mottest.tcl
View File

@ -52,11 +52,14 @@ test motorpar-1.8 {Test ignorefault} -body {
test motorpar-1.9 {Test movecount} -body {
testPar "brumm movecount" 12 Mugger } -result OK
test motorpar-1.10 {Test hardupper} -body {
testROPar "brumm hardupperlim" 180 } -result OK
#-------- This test always fails because the regression motor driver
# handles hard limits
#---------------------------------------------------------------
# test motorpar-1.10 {Test hardupper} -body {
# testPar "brumm hardupperlim" 180 Mugger} -result OK
test motorpar-1.11 {Test hardlower} -body {
testROPar "brumm hardlowerlim" -180 } -result OK
# test motorpar-1.11 {Test hardlower} -body {
# testPar "brumm hardlowerlim" -180 Mugger} -result OK
brumm recover 0
brumm errortype 0

2
test/object.tcl
View File

@ -1,5 +1,5 @@
#
# $Id: object.tcl,v 1.2 2007-02-12 01:15:03 ffr Exp $
# $Id$
#
# This software is copyright (C) 1995 by the Lawrence Berkeley Laboratory.
#

11390
test/samenv/tomato/07-20.log Normal file
View File

File diff suppressed because it is too large Load Diff

102
test/sicsstat.tcl
View File

@ -1,3 +1,4 @@
exe batchpath ./
exe syspath ./
@ -44,6 +45,12 @@ lieselotte SetMode Timer
# Counter multi
multi SetPreset 0.000000
multi SetMode Timer
sicsdatapath ./
sicsdatapath setAccess 1
sicsdataprefix regression
sicsdataprefix setAccess 1
sicsdatapostfix .dat
sicsdatapostfix setAccess 1
# Motor a1
a1 sign 1.000000
a1 SoftZero 0.000000
@ -148,9 +155,38 @@ sgl AccessCode 2.000000
sgl failafter 3.000000
sgl maxretry 3.000000
sgl movecount 10.000000
# Motor chi
chi sign 1.000000
chi SoftZero 0.000000
chi SoftLowerLim 0.000000
chi SoftUpperLim 360.000000
chi Fixed -1.000000
chi InterruptMode 0.000000
chi precision 0.010000
chi ignorefault 0.000000
chi AccessCode 2.000000
chi failafter 3.000000
chi maxretry 3.000000
chi movecount 10.000000
# Motor phi
phi sign 1.000000
phi SoftZero 0.000000
phi SoftLowerLim 0.000000
phi SoftUpperLim 360.000000
phi Fixed -1.000000
phi InterruptMode 0.000000
phi precision 0.010000
phi ignorefault 0.000000
phi AccessCode 2.000000
phi failafter 3.000000
phi maxretry 3.000000
phi movecount 10.000000
# Counter scancter
scancter SetPreset 0.000000
scancter SetMode Timer
# Counter counter
counter SetPreset 0.000000
counter SetMode Timer
hm CountMode timer
hm preset 10.000000
tof CountMode timer
@ -183,3 +219,69 @@ tasub r2 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
tasub update
#----- MultiMotor sa
sa recovernampos noeff a3 24 a4 48
ref anglesheader stt,om,chi,phi
ref clear
singlex cell { 0 0 0 0 0 0}
singlex oldub { 0 0 0 0 0 0 0 0 0}
singlex ub { 0 0 0 0 0 0 0 0 0}
singlex planenormal { 0 0 0}
singlex mode bi
singlex spacegroup P
singlex peaksearch {}
singlex peaksearch/min2t 5
singlex peaksearch/step2t 1
singlex peaksearch/max2t 15
singlex peaksearch/stepchi 2
singlex peaksearch/stepphi 0.5
singlex peaksearch/stepom 0.5
singlex peaksearch/stepnu 0.5
singlex peaksearch/phimin 0
singlex peaksearch/phimax 180
singlex peaksearch/chimin 90
singlex peaksearch/chimax 180
#HKL Settings
hkl scantolerance 2.500000
ubcalcint difftheta 0.300000
ubcalcint maxindex 5
ubcalcint maxlist 10
fmesstable clear
messref anglesheader stt,om,chi,phi
messref clear
fmess weak 0
fmess weakthreshold 20
fmess fast 0
fmess hkllim { -10 -10 10 10 10 10}
fmess sttlim { 5 180}
fmess table clear
cone target { 0 0 0}
cone qscale 1
cone center unknown
simidx sttlim 0.2
simidx anglim 0.5
simi preset 0
simi mode monitor
eva targetposition 5
eva sign -1
eva softzero -2
eva softlowerlim -38
eva softupperlim 38
eva fixed -1
eva interruptmode 0
eva precision 0.01
eva accesscode 2
eva failafter 3
eva maxretry 3
eva ignorefault 0
eva movecount 10
eva staticoffset -3

2
test/tcltest.tcl
View File

@ -16,7 +16,7 @@
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
#
# RCS: @(#) $Id: tcltest.tcl,v 1.2 2007-02-12 01:15:02 ffr Exp $
# RCS: @(#) $Id$
package require Tcl 8.3 ;# uses [glob -directory]
namespace eval tcltest {

337
test/testini.tcl
View File

@ -3,9 +3,12 @@
#
# Started: Dr. Mark Koennecke, July 2006
#---------------------------------------------------------------------------
# O P T I O N S
set home $env(HOME)/src/workspace/sics/test
# --------------- Initialize Tcl internals --------------------------------
protocol set all
#----------------------------------------------------------------------------
# O P T I O N S
# --------------- ----------------------------------------------------------
# first all the server options are set
@ -30,6 +33,7 @@ ServerOption InterruptPort 2913
# The UDP port where the server will wait for Interrupts from clients.
# Obviously, clients wishing to interrupt need to know this number.
ServerOption historylog $env(HOME)/src/workspace/sics/sim/tmp/comhistorytst.txt
#---------------------------------------------------------------------------
# U S E R S
@ -38,8 +42,8 @@ ServerOption InterruptPort 2913
# Syntax: SicsUser name password userRightsCode
SicsUser Mugger Mugger 1
SicsUser User User 2
#SicsUser Spy Spy 3
SicsUser Spy 007 1
SicsUser Spy Spy 3
#SicsUser Spy 007 1
#----------------- SICS Variable
VarMake lotte Text User
@ -95,7 +99,11 @@ 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
Motor chi SIM 0 360 -.1 10
Motor phi SIM 0 360 -.1 10
MakeMultiCounter scanCter aba
SicsAlias scanCter counter
proc scantransfer {} {
set FWHM 1.5
@ -114,6 +122,7 @@ proc scantransfer {} {
}
scancter transferscript scantransfer
rename scan stscan
MakeScanCommand xxxscan scancter test.hdd recover.bin
MakePeakCenter xxxscan
source scancommand.tcl
@ -186,7 +195,12 @@ sa endconfig
#-----------------------------------------------------------------------
# Hipadaba
#----------------------------------------------------------------------
InstallHdb
proc SplitReply { text } {
set l [split $text =]
return [string trim [lindex $l 1]]
}
#---------------------------------------------------------------------
source ../tcl/hdbutil.tcl
hmake /instrument spy none
hmake /instrument/sample spy none
hattach /instrument/sample a3 omega
@ -195,8 +209,54 @@ hmake /instrument/detector spy none
hattach /instrument/detector hm data
hattach /instrument lotte title
hfactory /target plain spy none
hfactory /target/ta3 plain internal float
hattach target a3 /target/ta3
restore
#==================================================
# ScriptContext testing
#==================================================
proc sendtest {} {
set test [catch {sct target} msg]
if {$test == 0} {
set data $msg
} else {
set data TestDuta
}
sct send $data
return testreply
}
#-------------------------------------------------
proc readtest {} {
set t [doubletime]
sct send "Read:$t"
return testreply
}
#-------------------------------------------------
proc testreply {} {
sct print [sct result]
sct update [sct result]
return idle
}
makesctcontroller testsct testprot
MakeSICSObj testnode Test spy text
hsetprop /sics/testnode read readtest
hsetprop /sics/testnode write sendtest
hsetprop /sics/testnode testreply testreply
proc testprio {} {
testsct queue /sics/testnode read read
testsct queue /sics/testnode read read
testsct queue /sics/testnode read read
testsct queue /sics/testnode halt write
testsct queue /sics/testnode read read
testsct queue /sics/testnode read read
return [testnode]
}
Publish testprio Spy
#-------------------------------------------------
proc farmFormat {par num} {
hsetprop /sics/farm/$par lastError none
@ -327,7 +387,7 @@ hsetprop /sics/farm/schneggecon readCommand schget
hsetprop /sics/farm/schneggecon replyCommand schreply
}
set farm 0
set farm 1
if {$farm == 1} {
#-------------- Test new async protocol controller
@ -414,7 +474,7 @@ farmser poll /sics/farm/schneggerunning
hfactory /sics/farm/stone plain spy int
hsetprop /sics/farm/stone read farmparcom stone
hsetprop /sics/farm/stone parread farmparread
#farmser poll /sics/farm/stone
farmser poll /sics/farm/stone
farmser debug -1
@ -457,7 +517,7 @@ makesctdriveobj schnecke /sics/farm/schnegge DriveAdapter farmser
}
#---------- test http
set httptest 1
set httptest 0
if {$httptest == 1} {
makesctcontroller amorhmsct sinqhttp amorhm data 180 spy 007
@ -510,4 +570,265 @@ amorhmsct poll /sics/amorhm/collapse 20
#source ../sim/mars/julcho.tcl
MakeSinqRedirect lnsl15 10500
MakeSingleX
singlex configure stt a4
singlex configure om a3
singlex configure chi chi
singlex configure phi phi
singlex configure lambda gfrth66jjjhh
singlex configure nu chi
singlex configure sgu chi
singlex configure sgl phi
singlex mode bi
set secMotortest 0
if {$secMotortest == 1} {
proc hdbReadOnly {} {
error "Parameter is READ ONLY"
}
source ../tcl/secsim.tcl
MakeSecSim mig3 -20 20 5
makesctcontroller pmac01 pmac ldm-elec-dev:1025 5
pmac01 debug 0
source ../tcl/deltatau.tcl
MakeDeltaTau mig15 pmac01 02
}
set astrium 0
if {$astrium == 1} {
source ../tcl/astrium.tcl
}
set el737sec 0
if {$el737sec == 1} {
source ../tcl/el737sec.tcl
MakeSecEL737 elli psts235:3008
}
#-------------------------------------------------
proc loadsinqhm {file} {
set f [open $file r]
while {[gets $f line] >= 0} {
append conf $line
}
close $f
return $conf
}
#-------------------------------------------------
proc appleinit {} {
return [loadsinqhm sans.xml]
}
#---------------------------------------------------------------------
proc formattof {l} {
set count 0
set delay [expr int([lindex $l 0])]
foreach e $l {
append txt [format " %12d" [expr int($e) - $delay]]
incr count
if {$count >= 5} {
append txt "\n"
set count 0
}
}
set len [llength $l]
set bin [lindex $l [expr $len - 1]]
set diff [expr [lindex $l 1] - [lindex $l 0]]
set bin [expr $bin + int($diff)]
append txt [format " %12d" [expr int($bin) - $delay]]
append txt "\n"
return [string trimright $txt]
}
#------------------------------------------------------------------
proc tofappleinit {} {
set dim [string trim [hval /sics/apple/dim]]
set dimlist [split $dim]
set ntime [lindex $dimlist 1]
append conf "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
append conf "<sinqhm filler=\"tof\" hdr_daq_mask=\"0x20000000\" "
append conf "hdr_daq_active=\"0x00000000\">\n"
append conf "<bank rank=\"2\">\n"
append conf " <axis length=\"16387\" mapping=\"direct\"/>\n "
append conf " <axis length=\"$ntime\" mapping=\"boundary\" array=\"tof\"/>\n"
append conf "</bank>\n"
set bins [string trim [hval /sics/apple/time_binning]]
set binl [split $bins]
set delay [expr int([lindex $binl 0])% 200000]
# mdif write [format "DT %d" $delay]
foreach b $binl {
if { [string length [string trim $b]] > 1} {
lappend binlist [string trim $b]
}
}
set tlen [expr $ntime + 1]
append conf "<tof rank=\"1\" dim=\"$tlen\">\n"
append conf [formattof $binlist] "\n"
append conf "</tof>\n"
append conf "</sinqhm>\n"
return $conf
}
#-------------------------------------------------
set hmhttp 0
if {$hmhttp == 1} {
source ../tcl/sinqhttp.tcl
# MakeHTTPHM apple 1 hm01 appleinit
# MakeHTTPHM apple 1 localhost:8080 appleinit
# apple dim 16384
#---------- for TOF
MakeHTTPHM apple 2 hm01 tofappleinit tof
apple dim 16384 10
apple genbin 10 20 100
applesct debug 0
apple init
}
set simhm 1
#if {$simhm == 1} {
source ../tcl/simhm.tcl
simhm::MakeSimHM simi 3 tof
# simhm::makeSecond simi singledet 30
simi dim 64 64 5
lappend tlist 10 20 30 40 50
simi time_binning $tlist
simi init
#}
set phytron 0
if {$phytron == 1} {
#makesctcontroller phyto phytron psts234:3002 5
makesctcontroller phyto phytron morpheus-ts:3013
#makesctcontroller phyto phytron localhost:8080 5
phyto debug 0
source ../tcl/phytron.tcl
phytron::make alge X phyto -360 0
}
#MakeLMD200 lmd400 lnsts11 3012
set stddrive 0
if {$stddrive == 1} {
makesctcontroller stdsct std localhost:8080 "\r" 10
source ../tcl/stddrive.tcl
stddrive::makestddrive eule EuleDrive stdsct
}
set el755 0
if {$el755 == 1} {
source ../tcl/stddrive.tcl
source ../tcl/el755.tcl
makesctcontroller el755sct std localhost:8080 "\r" 10
#el755sct debug 1
for {set i 0} {$i < 3} {incr i} {
el755sct transact "RMT 1"
el755sct transact "ECHO 2"
}
el755::makeel755 mf 5 el755sct
el755sct queue /sics/mf progress read
mf upperlimit 10
mf lowerlimit -10
mf tolerance .1
}
set dc-804 0
if {${dc-804} == 1} {
source ../tcl/pimotor.tcl
makesctcontroller dc804sct std localhost:8080 "\r" 10 "\x03" "\x03"
pimotor::makepimotor dc1 1 dc804sct -10000 10000
}
proc testprot {input} {
return "${input}_hugo_appended_by_Tcl"
}
proc testerr {input} {
error "$input is SO abyssimally wrong!"
}
set slsecho 0
if {$slsecho == 1} {
source ../tcl/stddrive.tcl
source ../tcl/slsecho.tcl
makesctcontroller slssct slsecho taspmagnet:5001
#makesctcontroller slssct slsecho localhost:8080
slsecho::makeslsecho ma1 5 slssct
#slsecho::makeslsecho ma3 2 slssct
}
set nhq202m 0
if {$nhq202m == 1} {
source ../tcl/stddrive.tcl
source ../tcl/nhq202m.tcl
#makesctcontroller nhq202 charbychar localhost:8005 "\r\n"
#makesctcontroller nhq202 charbychar localhost:8080 "\r\n"
makesctcontroller nhq202 charbychar psts225:3002 "\r\n"
#------- Put him into lovely mode, it needs a few commands before it gets there
nhq202 transact \#
nhq202 transact \#
nhq202 transact \#
nhq202 debug 0
nhq202m::makehv hv1 nhq202 1
}
set poldizug 0
if {$poldizug == 1} {
makesctcontroller zugsct std pc6651:4167 "\r\n" 3.0 "\r\n"
zugsct debug 0
source ../tcl/stddrive.tcl
source ../sim/poldi_sics/zug.tcl
}
#MakeSPSS7 s7 203 251 129.129.195.55:2005
#MakeSPSS7 s7 203 251 localhost:8090
set jvl 0
if {$jvl == 1} {
source ../sim/boa_sics/jvl.tcl
makesctcontroller jvlsct jvl localhost:8080
jvlsct debug -1
jvl::make ja 2 jvlsct -10000 10000 120
}
set nanotec 0
if {$nanotec == 1} {
source ../sim/boa_sics/nanotec.tcl
makesctcontroller nanosct std localhost:8080 \r 1 \r
nanosct debug -1
nanotec::make nano 1 nanosct -100000 100000 120
}
set agilent 0
if {$agilent == 1} {
source ../tcl/stddrive.tcl
source ../tmp/agilent.tcl
makesctcontroller agi std 129.129.195.78:5025 \n 2 \n \n
agilent::make agi
}
set secmot 1
if {$secmot == 1} {
source ../sim/sicscommon/secsim.tcl
MakeSecSim eva -40 40 .3
}

94
test/testrics Executable file
View 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

4
test/testsics
View File

@ -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
@ -54,6 +55,9 @@ source nxscripttest.tcl
#------------ test SANS MultiMotor
source testmumo.tcl
#------------ test SingleX
source testsinglex.tcl
#------------ print test summary
cleanupTests
exit 1

2
test/testsicsdata.tcl
View File

@ -164,7 +164,7 @@ test sicsdata-1.8 {Testing UU write} -body {
test sicsdata-1.9 {Testing file dump} -body {
data clear
data copyhm 0 hm
testOK "data dump test.dat"
testOK "data dumpxy test.dat"
set status [catch {exec diff test.dat sicsdatasoll.dat} msg]
if {$status != 0} {
error "Difference in dump file: $msg"

184
test/testsinglex.tcl Normal file
View File

@ -0,0 +1,184 @@
#---------------------------------------------------------------
# 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."
singlex mode bi
#---------------------------------------------------------------
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
#-------------------------------------------------------------
# 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
set testub "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.11 {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.12 {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

47
test/testsoll.xml
View File

@ -1,8 +1,9 @@
<?xml version="1.0" encoding="UTF-8"?>
<NXroot NeXus_version="3.0.0" XML_version="mxml" file_name="test.xml"
file_time="2007-02-21 10:51:15+0100" Instrument="Washmaschine">
<NXroot NeXus_version="4.1.0" XML_version="mxml" file_name="test.xml"
file_time="2009-11-16 11:43:33+0100" Instrument="Washmaschine">
<NXentry name="entry1">
<testtext target="/entry1/testtext">Hugo ist eine Nassnase</testtext>
<testtext NAPItype="NX_CHAR[23]" target="/entry1/testtext">Hugo ist eine Nassnase
</testtext>
<testfloat NAPItype="NX_FLOAT32">
27.8000
</testfloat>
@ -19,7 +20,8 @@ file_time="2007-02-21 10:51:15+0100" Instrument="Washmaschine">
<preset NAPItype="NX_FLOAT32">
10.0000
</preset>
<mode>timer</mode>
<mode NAPItype="NX_CHAR[132]">timer
</mode>
<time NAPItype="NX_FLOAT32">
10.0000
</time>
@ -41,37 +43,32 @@ file_time="2007-02-21 10:51:15+0100" Instrument="Washmaschine">
</NXmonitor>
<NXdata name="detector">
<hmdata NAPItype="NX_INT32[23]" signal="1">
55 55 55 55
55 55 55 55
55 55 55 55
55 55 55 55
55 55 55 55
55 55 55 55 55
55 55 55 55 55
55 55 55 55 55
55 55 55 55 55
55 55 55
</hmdata>
<time_binning NAPItype="NX_FLOAT32[20]">
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
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
</time_binning>
<x_axis NAPItype="NX_FLOAT32[10]">
10.0000 11.0000 12.0000 13.0000
14.0000 15.0000 16.0000 17.0000
18.0000 19.0000
10.0000 11.0000 12.0000 13.0000 14.0000
15.0000 16.0000 17.0000 18.0000 19.0000
</x_axis>
<y_axis NAPItype="NX_INT32[10]">
10 11 12 13
14 15 16 17
18 19
10 11 12 13 14
15 16 17 18 19
</y_axis>
<NAPIlink target="/entry1/testtext" />
<gurke NAPItype="NX_INT32[23]">
23 23 23 23
23 23 23 23
23 23 23 23
23 23 23 23
23 23 23 23
23 23 23 23 23
23 23 23 23 23
23 23 23 23 23
23 23 23 23 23
23 23 23
</gurke>
</NXdata>

183
test/testtool Executable file
View 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
View 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/testbi.dat
set status [catch {exec diff testbi.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
View 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

42
test/testutil.tcl
View File

@ -11,9 +11,9 @@ proc SICSValue {command} {
return [string trim [lindex $l 1]]
}
#-----------------------------------------------------------------------------
proc compareValue {is should} {
proc compareValue {is should {delta .01} } {
if {[string is double $is] == 1} {
if {abs($should - $is) > .01} {
if {abs($should - $is) > $delta} {
error "Bad compare is: $is, should $should"
}
} else {
@ -23,6 +23,18 @@ proc compareValue {is should} {
}
return OK
}
#-----------------------------------------------------------------------------
proc compareMultiValue {is should {delta .01} } {
set l1 [split [string trim $is]]
set l2 [split [string trim $should]]
if {[llength $l1 ] != [llength $l2]} {
error "List length mismatch in compareMultiValue"
}
for {set i 0} {$i < [llength $l1]} {incr i } {
compareValue [lindex $l1 $i] [lindex $l2 $i] $delta
}
return OK
}
#------------------------------------------------------------------------------
proc testPar {name testval priv } {
config rights Spy Spy
@ -41,6 +53,24 @@ proc testPar {name testval priv } {
eval $name $value
return "OK"
}
#------------------------------------------------------------------------------
proc testMultiPar {name testval priv} {
config rights Spy Spy
set value [SICSValue $name]
set res [eval $name $testval]
if {[string first ERROR $res] < 0} {
error "Managed to set parameter even if not allowed"
}
config rights $priv $priv
set res [eval $name $testval]
if {[string first ERROR $res] >= 0} {
error "Setting parameter failed with $res"
}
set readback [SICSValue $name]
compareMultiValue $readback $testval
eval $name $value
return "OK"
}
#-------------------------------------------------------------------------------
proc testROPar {name val} {
config rights Mugger Mugger
@ -48,9 +78,13 @@ proc testROPar {name val} {
compareValue $value $val
catch {$name [expr $val + 1]} msg
set value [SICSValue $name]
compareValue $value $val
set status [catch {compareValue $value $val} msg]
config rights Spy Spy
return OK
if {$status == 0} {
error "Was able to change read-only parameter name"
} else {
return OK
}
}
#------------------------------------------------------------------------------
proc testDrive {name value priv} {