95 lines
2.6 KiB
Tcl
Executable File
95 lines
2.6 KiB
Tcl
Executable File
#!/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
|