- Test for TRICS

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

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