dbsql/test/test.tcl

# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2004
#	Sleepycat Software.  All rights reserved.
#
# $Id: test.tcl 7 2007-02-03 13:34:17Z gburd $

source ./include.tcl

# Load DBSQL's TCL API.
load $tcllib

if { [file exists $testdir] != 1 } {
	file mkdir $testdir
}

global __debug_print
global __debug_on
global __debug_test

#
# Test if utilities work to figure out the path.  Most systems
# use ., but QNX has a problem with execvp of shell scripts which
# causes it to break.
#
set stat [catch {exec ./dbsql --help} ret]
if { [string first "exec format error" $ret] != -1 } {
	set util_path ./.libs
} else {
	set util_path .
}
set __debug_print 0

# Error stream that (should!) always go to the console, even if we're
# redirecting to ALL.OUT.
set consoleerr stderr

set dict $test_path/wordlist
set alphabet "abcdefghijklmnopqrstuvwxyz"
set datastr "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"

# Random number seed.
global rand_init
set rand_init 12082004

# Open handles global check
set ohandles {}

# Normally, we're not running an all-tests-in-one-env run.  This matters
# for error stream/error prefix settings in berkdbsql_open.
global is_envmethod
set is_envmethod 0

# The variable one_test allows us to run all the permutations
# of a test with run_all or run_std.
global one_test
if { [info exists one_test] != 1 } {
	set one_test "ALL"
}

# This is where the test numbering and parameters now live.
source $test_path/testparams.tcl

# Set up any OS-specific values
global tcl_platform
set is_windows_test [is_substr $tcl_platform(os) "Win"]
set is_hp_test [is_substr $tcl_platform(os) "HP-UX"]
set is_je_test 0
set is_qnx_test [is_substr $tcl_platform(os) "QNX"]
set upgrade_be [big_endian]

global EXE BAT
if { $is_windows_test == 1 } {
	set EXE ".exe"
	set BAT ".bat"
} else {
	set EXE ""
	set BAT ""
}

# From here on out, test.tcl contains the procs that are used to
# run all or part of the test suite.

proc run_std { { testname ALL } args } {
	global test_names
	global one_test
	source ./include.tcl

	set one_test $testname
	if { $one_test != "ALL" } {
		# Source testparams again to adjust test_names.
		source $test_path/testparams.tcl
	}

	set exflgs [eval extractflags $args]
	set args [lindex $exflgs 0]
	set flags [lindex $exflgs 1]

	set display 1
	set run 1
	set std_only 1
	set rflags {--}
	foreach f $flags {
		switch $f {
			A {
				set std_only 0
			}
			n {
				set display 1
				set run 0
				set rflags [linsert $rflags 0 "-n"]
			}
		}
	}

	if { $std_only == 1 } {
		fileremove -f ALL.OUT

		set o [open ALL.OUT a]
		if { $run == 1 } {
			puts -nonewline "Test suite run started at: "
			puts [clock format [clock seconds] -format "%H:%M %D"]
			puts [berkdbsql version -string]

			puts -nonewline $o "Test suite run started at: "
			puts $o [clock format [clock seconds] -format "%H:%M %D"]
			puts $o [berkdbsql version -string]
		}
		close $o
	}

	set test_list {
#	{"environment"		"env"}
	}

	foreach pair $test_list {
		set msg [lindex $pair 0]
		set cmd [lindex $pair 1]
		puts "Running $msg tests"
		if [catch {exec $tclsh_path << \
		    "global one_test; set one_test $one_test; \
		    source $test_path/test.tcl; r $rflags $cmd" \
		    >>& ALL.OUT } res] {
			set o [open ALL.OUT a]
			puts $o "FAIL: $cmd test: $res"
			close $o
		}
	}

	# If not actually running, no need to check for failure.
	# If running in the context of the larger 'run_all' we don't
	# check for failure here either.
	if { $run == 0 || $std_only == 0 } {
		return
	}

	set failed [check_output ALL.OUT]

	set o [open ALL.OUT a]
	if { $failed == 0 } {
		puts "Regression Tests Succeeded"
		puts $o "Regression Tests Succeeded"
	} else {
		puts "Regression Tests Failed"
		puts "Check UNEXPECTED OUTPUT lines."
		puts "Review ALL.OUT.x for details."
		puts $o "Regression Tests Failed"
	}

	puts -nonewline "Test suite run completed at: "
	puts [clock format [clock seconds] -format "%H:%M %D"]
	puts -nonewline $o "Test suite run completed at: "
	puts $o [clock format [clock seconds] -format "%H:%M %D"]
	close $o
}

proc check_output { file } {
	# These are all the acceptable patterns.
	# TODO update these patterns
	set pattern {(?x)
		^[:space:]*$|
		.*?wrap\.tcl.*|
		.*?dbscript\.tcl.*|
		.*?ddscript\.tcl.*|
		.*?mpoolscript\.tcl.*|
		.*?mutexscript\.tcl.*|
		^\d\d:\d\d:\d\d\s\(\d\d:\d\d:\d\d\)$|
		^\d\d:\d\d:\d\d\s\(\d\d:\d\d:\d\d\)\sCrashing$|
		^\d\d:\d\d:\d\d\s\(\d\d:\d\d:\d\d\)\s[p|P]rocesses\srunning:.*|
		^\d\d:\d\d:\d\d\s\(\d\d:\d\d:\d\d\)\s5\sprocesses\srunning.*|
		^\d:\sPut\s\d*\sstrings\srandom\soffsets.*|
		^100.*|
		^eval\s.*|
		^exec\s.*|
		^jointest.*$|
		^r\sarchive\s*|
		^r\sdbm\s*|
		^r\shsearch\s*|
		^r\sndbm\s*|
		^r\srpc\s*|
		^run_recd:\s.*|
		^run_reptest:\s.*|
		^run_rpcmethod:\s.*|
		^run_secenv:\s.*|
		^All\sprocesses\shave\sexited.$|
		^Beginning\scycle\s\d$|
		^Byteorder:.*|
		^Child\sruns\scomplete\.\s\sParent\smodifies\sdata\.$|
		^Deadlock\sdetector:\s\d*\sCheckpoint\sdaemon\s\d*$|
		^Ending\srecord.*|
		^Environment\s.*?specified;\s\sskipping\.$|
		^Executing\srecord\s.*|
		^Join\stest:\.*|
		^Method:\s.*|
		^Repl:\stest\d\d\d:.*|
		^Repl:\ssdb\d\d\d:.*|
		^Script\swatcher\sprocess\s.*|
		^Secondary\sindex\sjoin\s.*|
		^Sleepycat\sSoftware:\sBerkeley\sDBSQL\s.*|
		^Test\ssuite\srun\s.*|
		^Unlinking\slog:\serror\smessage\sOK$|
		^Verifying\s.*|
		^\t*\.\.\.dbc->get.*$|
		^\t*\.\.\.dbc->put.*$|
		^\t*\.\.\.key\s\d*$|
		^\t*\.\.\.Skipping\sdbc.*|
		^\t*and\s\d*\sduplicate\sduplicates\.$|
		^\t*About\sto\srun\srecovery\s.*complete$|
		^\t*Archive[:\.].*|
		^\t*Building\s.*|
		^\t*closing\ssecondaries\.$|
		^\t*Command\sexecuted\sand\s.*$|
		^\t*DBM.*|
		^\t*[d|D]ead[0-9][0-9][0-9].*|
		^\t*Dump\/load\sof.*|
		^\t*[e|E]nv[0-9][0-9][0-9].*|
		^\t*Executing\scommand$|
		^\t*Executing\stxn_.*|
		^\t*File\srecd005\.\d\.db\sexecuted\sand\saborted\.$|
		^\t*File\srecd005\.\d\.db\sexecuted\sand\scommitted\.$|
		^\t*[f|F]op[0-9][0-9][0-9].*|
		^\t*HSEARCH.*|
		^\t*Initial\sCheckpoint$|
		^\t*Iteration\s\d*:\sCheckpointing\.$|
		^\t*Joining:\s.*|
		^\t*Kid[1|2]\sabort\.\.\.complete$|
		^\t*Kid[1|2]\scommit\.\.\.complete$|
		^\t*[l|L]ock[0-9][0-9][0-9].*|
		^\t*[l|L]og[0-9][0-9][0-9].*|
		^\t*[m|M]emp[0-9][0-9][0-9].*|
		^\t*[m|M]utex[0-9][0-9][0-9].*|
		^\t*NDBM.*|
		^\t*opening\ssecondaries\.$|
		^\t*op_recover_rec:\sRunning\srecovery.*|
		^\t*[r|R]ecd[0-9][0-9][0-9].*|
		^\t*[r|R]ep[0-9][0-9][0-9].*|
		^\t*[r|R]ep_test.*|
		^\t*[r|R]pc[0-9][0-9][0-9].*|
		^\t*[r|R]src[0-9][0-9][0-9].*|
		^\t*Run_rpcmethod.*|
		^\t*Running\srecovery\son\s.*|
		^\t*[s|S]ec[0-9][0-9][0-9].*|
		^\t*[s|S]i[0-9][0-9][0-9].*|
		^\t*[s|S]ijoin.*|
		^\t*sdb[0-9][0-9][0-9].*|
		^\t*Skipping\s.*|
		^\t*Subdb[0-9][0-9][0-9].*|
		^\t*Subdbtest[0-9][0-9][0-9].*|
		^\t*Syncing$|
		^\t*[t|T]est[0-9][0-9][0-9].*|
		^\t*[t|T]xn[0-9][0-9][0-9].*|
		^\t*Txnscript.*|
		^\t*Using\s.*?\senvironment\.$|
		^\t*Verification\sof.*|
		^\t*with\stransactions$}

	set failed 0
	set f [open $file r]
	while { [gets $f line] >= 0 } {
		if { [regexp $pattern $line] == 0 } {
			puts -nonewline "UNEXPECTED OUTPUT: "
			puts $line
			set failed 1
		}
	}
	close $f
	return $failed
}

proc r { args } {
	global test_names
	global rand_init
	global one_test

	source ./include.tcl

	set exflgs [eval extractflags $args]
	set args [lindex $exflgs 0]
	set flags [lindex $exflgs 1]

	set display 1
	set run 1
	set saveflags "--"
	foreach f $flags {
		switch $f {
			n {
				set display 1
				set run 0
				set saveflags "-n $saveflags"
			}
		}
	}

	if {[catch {
		set sub [ lindex $args 0 ]
		switch $sub {
			shelltest {
				if { $one_test == "ALL" } {
					if { $display } { puts "r $sub" }
					if { $run } {
						check_handles
						$sub
					}
				}
			}
			default {
				error \
				   "FAIL:[timestamp] r: $args: unknown command"
			}
		}
		flush stdout
		flush stderr
	} res] != 0} {
		global errorInfo;

		set fnl [string first "\n" $errorInfo]
		set theError [string range $errorInfo 0 [expr $fnl - 1]]
		if {[string first FAIL $errorInfo] == -1} {
			error "FAIL:[timestamp] r: $args: $theError"
		} else {
			error $theError;
		}
	}
}

proc run_all { { testname ALL } args } {
	global test_names
	global one_test
	source ./include.tcl

	fileremove -f ALL.OUT

	set one_test $testname
	if { $one_test != "ALL" } {
		# Source testparams again to adjust test_names.
		source $test_path/testparams.tcl
	}

	set exflgs [eval extractflags $args]
	set flags [lindex $exflgs 1]
	set display 1
	set run 1
	set parallel 0
	set nparalleltests 0
	set rflags {--}
	foreach f $flags {
		switch $f {
			n {
				set display 1
				set run 0
				set rflags [linsert $rflags 0 "-n"]
			}
		}
	}

	set o [open ALL.OUT a]
	if { $run == 1 } {
		puts -nonewline "Test suite run started at: "
		puts [clock format [clock seconds] -format "%H:%M %D"]
		puts [berkdb version -string]

		puts -nonewline $o "Test suite run started at: "
		puts $o [clock format [clock seconds] -format "%H:%M %D"]
		puts $o [berkdbsql version -string]
	}
	close $o
	#
	# First run standard tests.  Send in a -A to let run_std know
	# that it is part of the "run_all" run, so that it doesn't
	# print out start/end times.
	#
	lappend args -A
	eval {run_std} $one_test $args

	set args [lindex $exflgs 0]
	set save_args $args

	foreach pair $test_list {
		set msg [lindex $pair 0]
		set cmd [lindex $pair 1]
		puts "Running $msg tests"
		if [catch {exec $tclsh_path << \
		    "global one_test; set one_test $one_test; \
		    source $test_path/test.tcl; \
		    r $rflags $cmd $args" >>& ALL.OUT } res] {
			set o [open ALL.OUT a]
			puts $o "FAIL: $cmd test: $res"
			close $o
		}
	}

	# If not actually running, no need to check for failure.
	if { $run == 0 } {
		return
	}

	set failed 0
	set o [open ALL.OUT r]
	while { [gets $o line] >= 0 } {
		if { [regexp {^FAIL} $line] != 0 } {
			set failed 1
		}
	}
	close $o
	set o [open ALL.OUT a]
	if { $failed == 0 } {
		puts "Regression Tests Succeeded"
		puts $o "Regression Tests Succeeded"
	} else {
		puts "Regression Tests Failed; see ALL.OUT for log"
		puts $o "Regression Tests Failed"
	}

	puts -nonewline "Test suite run completed at: "
	puts [clock format [clock seconds] -format "%H:%M %D"]
	puts -nonewline $o "Test suite run completed at: "
	puts $o [clock format [clock seconds] -format "%H:%M %D"]
	close $o
}

proc run { proc_suffix method {start 1} {stop 999} } {
	global test_names

	switch -exact -- $proc_suffix {
		default {
			puts "$proc_suffix is not set up with to be used with run"
		}
	}
}