- First version of instrument regression tests

- sinqcom is the first version of a communication testing program
  for instruments

insttest/sicstcldebug.tcl

@@ -0,0 +1,73 @@
+#------------------------------------------------------------------
+# This is a helper file in order to debug SICS Tcl scripts. The idea
+# is that a connection to a SICS interpreter at localhost:2911 is opened.
+# Then unknown is reimplemented to send unknown commands (which must be
+# SICS commands) to the SICS interpreter for evaluation. This is done
+# with transact in order to figure out when SICS finished processing.
+# Thus is should be possible to debug SICS Tcl scripts in a normal
+# standalone interpreter without the overhead of restarting SICS
+# all the time. It may even be possible to use one of the normal
+# Tcl debuggers then....
+#
+# Mark Koennecke, February 2006
+#
+# Revamped for use in testing SICS instruments.
+# Mark Koennecke, November 2006
+#------------------------------------------------------------------
+set host(amor)     amor.psi.ch
+set host(dmc)      dmc.psi.ch
+set host(focus)    focus.psi.ch
+set host(hrpt)     hrpt.psi.ch
+set host(mars)     mars.psi.ch
+set host(morpheus) morpheus.psi.ch
+set host(narziss)  narziss.psi.ch
+set host(poldi)    poldi.psi.ch
+set host(rita2)    rita2.psi.ch
+set host(sans)     sans.psi.ch
+set host(sansli)   sans2.psi.ch
+set host(tasp)     tasp.psi.ch
+set host(trics)    trics.psi.ch
+set host(local)    localhost
+ 
+#-------------------------------------------------------------------
+# initialize the socket before debugging. If local == 1, then a 
+# connection to localhost is built
+#------------------------------------------------------------------
+proc initSicsDebug {instrument} {
+    global socke host
+    catch {close $socke}
+    set status [catch {set compi $host($instrument)} msg]
+    if {$status != 0} {
+	error "Host for $instrument not found"
+    }
+    set socke [socket $compi 2911]
+    gets $socke
+    puts $socke "Spy 007"
+    flush $socke
+    gets $socke
+}
+#----------------------------------------------------------------
+proc sicscommand args {
+    global socke
+    append com "transact " [join $args]
+	puts $socke $com
+	flush $socke
+	set reply ""
+	while {1} {
+		set line [gets $socke]
+		if {[string first TRANSACTIONFINISHED $line] >= 0} {
+			return $reply
+		} else {
+			append reply $line "\n"
+		}
+	}
+}
+#------------------------------------------------------------------
+proc unknown args {
+    return [sicscommand $args]
+}
+#------------------------------------------------------------------
+proc clientput args {
+	puts stdout [join $args]
+}
+#------------------------------------------------------------------