sics/test/testtool

#!/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
	}
}