- Test for TRICS

- Implemented testoll which can log a SICS session and create a test from it

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

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

test/testini.tcl

@@ -547,7 +547,7 @@ if {$astrium == 1} {
     source ../tcl/astrium.tcl
 }
 
-set el737sec 1
+set el737sec 0
 
 
 if {$el737sec == 1} {

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

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

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

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
+	}
+}
+

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
+

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