# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998, 1999
#	Sleepycat Software.  All rights reserved.
#
#	$Id: test.tcl,v 1.1.1.17.2.2 2000/02/08 00:48:11 noriko Exp $

source ./include.tcl

# Load DB's TCL API.
load $tcllib

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

global __debug_print
global __debug_on

set __debug_print 0
set __debug_on 0

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

for { set i 1 } { $i <= $deadtests } {incr i} {
	set name [format "dead%03d.tcl" $i]
	source $test_path/$name
}
for { set i 1 } { $i <= $envtests } {incr i} {
	set name [format "env%03d.tcl" $i]
	source $test_path/$name
}
for { set i 1 } { $i <= $recdtests } {incr i} {
	set name [format "recd%03d.tcl" $i]
	source $test_path/$name
}
for { set i 1 } { $i <= $rpctests } {incr i} {
	set name [format "rpc%03d.tcl" $i]
	source $test_path/$name
}
for { set i 1 } { $i <= $rsrctests } {incr i} {
	set name [format "rsrc%03d.tcl" $i]
	source $test_path/$name
}
for { set i 1 } { $i <= $runtests } {incr i} {
	set name [format "test%03d.tcl" $i]
	source $test_path/$name
}
for { set i 1 } { $i <= $subdbtests } {incr i} {
	set name [format "sdb%03d.tcl" $i]
	source $test_path/$name
}

source $test_path/archive.tcl
source $test_path/byteorder.tcl
source $test_path/dbm.tcl
source $test_path/hsearch.tcl
source $test_path/join.tcl
source $test_path/lock001.tcl
source $test_path/lock002.tcl
source $test_path/lock003.tcl
source $test_path/log.tcl
source $test_path/mpool.tcl
source $test_path/mutex.tcl
source $test_path/ndbm.tcl
source $test_path/sdbtest001.tcl
source $test_path/sdbtest002.tcl
source $test_path/sdbutils.tcl
source $test_path/testutils.tcl
source $test_path/txn.tcl
source $test_path/upgrade.tcl

set dict $test_path/wordlist
set alphabet "abcdefghijklmnopqrstuvwxyz"

# Random number seed.
global rand_init
set rand_init 12345

# Default record length and padding character for
# fixed record length access method(s)
set fixed_len 20
set fixed_pad 0

set recd_debug	0
set log_log_record_types 0

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

proc run_all { } {
	global runtests
	global subdbtests
	source ./include.tcl

	exec $RM -rf ALL.OUT

	set o [open ALL.OUT a]
	puts $o [berkdb version -string]
	close $o

	set test_list {
	{"environment"		"env"}
	{"archive"		"archive"}
	{"locking"		"lock"}
	{"logging"		"log"}
	{"memory pool"		"mpool"}
	{"mutex"		"mutex"}
	{"transaction"		"txn"}
	{"deadlock detection"	"dead"}
	{"subdatabase"		"subdb_gen"}
	{"byte-order"		"byte"}
	{"recno backing file"	"rsrc"}
	{"DBM interface"	"dbm"}
	{"NDBM interface"	"ndbm"}
	{"Hsearch interface"	"hsearch"}
	}

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

	# Run recovery tests.
	#
	# XXX These too are broken into separate tclsh instantiations
	# so we don't require so much memory, but I think it's cleaner
	# and more useful to do it down inside proc r than here,
	# since "r recd" gets done a lot and needs to work.
	puts "Running recovery tests"
	if [catch {exec $tclsh_path \
	    << "source $test_path/test.tcl; r recd" >>& ALL.OUT } res] {
		set o [open ALL.OUT a]
		puts $o "FAIL: recd test"
		close $o
	}

	# Run join test
	#
	# XXX
	# Broken up into separate tclsh instantiations so we don't require
	# so much memory.
	puts "Running join test"
	foreach i "join1 join2 join3 join4 join5 join6" {
		if [catch {exec $tclsh_path \
		    << "source $test_path/test.tcl; r $i" >>& ALL.OUT } res] {
			set o [open ALL.OUT a]
			puts $o "FAIL: $i test"
			close $o
		}
	}

	# Access method tests.
	#
	# XXX
	# Broken up into separate tclsh instantiations so we don't require
	# so much memory.
	foreach i "btree rbtree hash queue recno frecno rrecno" {
		puts "Running $i tests"
		for { set j 1 } { $j <= $runtests } {incr j} {
			if [catch {exec $tclsh_path \
			    << "source $test_path/test.tcl; \
			    run_method -$i $j $j" >>& ALL.OUT } res] {
				set o [open ALL.OUT a]
				puts $o "FAIL: [format "test%03d" $j] $i"
				close $o
			}
		}
		if [catch {exec $tclsh_path \
		    << "source $test_path/test.tcl; \
		    subdb -$i" >>& ALL.OUT } res] {
			set o [open ALL.OUT a]
			puts $o "FAIL: subdb -$i test"
			close $o
		}
	}

	catch { exec $SED -e /^FAIL/p -e d ALL.OUT } res
	set o [open ALL.OUT a]
	if { [string length $res] == 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"
	}
	close $o
}

proc r { args } {
	global envtests
	global log_log_record_types
	global recdtests
	global subdbtests
	source ./include.tcl

	if {[catch {
		set l [ lindex $args 0 ]
		switch $l {
			archive { eval archive [lrange $args 1 end] }
			byte {
				foreach method \
				    "-hash -btree -recno -queue -frecno" {
					byteorder $method
				}
			}
			dbm { eval dbm }
			dead {
				eval dead001 [lrange $args 1 end]
				eval dead002 [lrange $args 1 end]
			}
			env {
				for { set i 1 } { $i <= $envtests } {incr i} {
					eval env00$i
				}
			}
			hsearch { eval hsearch }
			join {
				eval r join1
				eval r join2
				eval r join3
				eval r join4
				eval r join5
				eval r join6
			}
			join1 { eval jointest }
			join2 { eval jointest 512 }
			join3 {	eval jointest 8192 0 " -join_item"}
			join4 { eval jointest 8192 2 }
			join5 { eval jointest 8192 3 }
			join6 { eval jointest 512 3 }
			lock { eval locktest [lrange $args 1 end] }
			log { eval logtest [lrange $args 1 end] }
			mpool {
				eval r mpool1
				eval r mpool2
				eval r mpool3
			}
			mpool1 { eval mpool [lrange $args 1 end] }
			mpool2 { eval mpool -mem system [lrange $args 1 end] }
			mpool3 { eval mpool -mem private [lrange $args 1 end] }
			mutex { eval mutex [lrange $args 1 end] }
			ndbm { eval ndbm }
			recd {
				if { $PERL5 != "" } {
					set log_log_record_types 1
					set err [catch {exec $PERL5 \
					    "$test_path/log.pl" "--init"} ret]
					error_check_good \
					    "Initializing log record tracker" \
					    $err 0
				}
				foreach method \
			"btree rbtree hash queue recno frecno rrecno" {
					if { [catch \
					    {run_recd -$method} ret ] != 0 } {
						puts $ret
					}
				}
				if { $log_log_record_types == 1 } {
					catch {exec $PERL5 "$test_path/log.pl" \
					    "--summary" $test_path} ret
					puts $ret
					set log_log_record_types 0
				}
			}
			rpc {
				if { [catch {run_rpcmethod -txn} ret] != 0 } {
					puts $ret
				}
				foreach method \
			"hash queue recno frecno rrecno rbtree btree" {
					if { [catch {run_rpcmethod \
					    -$method} ret] != 0 } {
						puts $ret
					}
				}
			}
			rsrc {
				eval rsrc001
				eval rsrc002
			}
			subdb {
				eval subdbtest001
				eval subdbtest002

				foreach method \
			"btree rbtree hash queue recno frecno rrecno" {
					eval subdb [ -$method ]
				}
			}
			subdb_gen {
				eval subdbtest001
				eval subdbtest002
			}
			txn { eval txntest [lrange $args 1 end] }

			btree -
			rbtree -
			hash -
			queue -
			recno -
			frecno -
			rrecno { eval run_method $args }

			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_method { method {start 1} {stop 0} args } {
	global __debug_on
	global __debug_print
	global parms
	global runtests

	if { $stop == 0 } {
		set stop $runtests
	}
	puts "run_method: $method $start $stop $args"

	if {[catch {
		for { set i $start } { $i <= $stop } {incr i} {
			set name [format "test%03d" $i]
			if { [info exists parms($name)] != 1 } {
				continue
			}
			puts "[timestamp]"
			eval $name $method $parms($name) $args
			if { $__debug_print != 0 } {
				puts ""
			}
			if { $__debug_on != 0 } {
				debug
			}
			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]\
			    run_method: $method $i: $theError"
		} else {
			error $theError;
		}
	}
}

proc run_rpcmethod { type {start 1} {stop 0} {largs ""} } {
	global __debug_on
	global __debug_print
	global parms
	global runtests
	source ./include.tcl

	if { $stop == 0 } {
		set stop $runtests
	}
	puts "run_rpcmethod: $type $start $stop $largs"

	set curdir [pwd]
	cd $testdir
	set fulltestdir [pwd]
	cd $curdir
	if { [string compare $rpc_server "localhost"] == 0 } {
	       set dpid [exec ./berkeley_db_svc -h $fulltestdir &]
	} else {
	       set dpid [exec rsh $curdir/berkeley_db_svc  &]
	}
	puts "\tRun_rpcmethod.a: starting server, pid $dpid"

	exec $SLEEP 2

	puts "\tRun_rpcmethod.b: creating environment"

	cleanup $testdir
	set home [file tail $testdir]

	set txn ""
	set use_txn 0
	if { [string first "txn" $type] != -1 } {
		set txn "-txn"
		set use_txn 1
	}
	set env [eval {berkdb env -create -mode 0644 -home $home \
	    -server $rpc_server -client_timeout 10000} $txn]
	error_check_good lock_env:open [is_valid_env $env] TRUE

	append largs " -env $env "
	if { $use_txn == 1 } {
		if { $start == 1 } {
			set ntxns 32
		} else {
			set ntxns $start
		}
		set i 1
		set stat [catch {eval txn001_suba $ntxns $env} res]
		if { $stat == 0 } {
			set stat [catch {eval txn001_subb $ntxns $env} res]
		}
	} else {
		set stat [catch {
			for { set i $start } { $i <= $stop } {incr i} {
				puts "[timestamp]"
				set name [format "test%03d" $i]
				eval $name $type $parms($name) $largs
				if { $__debug_print != 0 } {
					puts ""
				}
				if { $__debug_on != 0 } {
					debug
				}
				flush stdout
				flush stderr
			}
		} res]
	}
	if { $stat != 0} {
		global errorInfo;

		set fnl [string first "\n" $errorInfo]
		set theError [string range $errorInfo 0 [expr $fnl - 1]]
		$env close
		exec $KILL $dpid
		if {[string first FAIL $errorInfo] == -1} {
			error "FAIL:[timestamp]\
			    run_rpcmethod: $type $i: $theError"
		} else {
			error $theError;
		}
	}
	error_check_good env_close [$env close] 0
	exec $KILL $dpid

}
 
proc subdb { method } {
	global subdbtests

	for { set i 1 } {$i <= $subdbtests} {incr i} {
		set name [format "subdb%03d" $i]
		eval $name $method
	}
}

proc run_recd { method {start 1} {stop 0} args } {
	global __debug_on
	global __debug_print
	global parms
	global recdtests
	source ./include.tcl

	if { $stop == 0 } {
		set stop $recdtests
	}
	puts "run_recd: $method $start $stop $args"

	if {[catch {
		for { set i $start } { $i <= $stop } {incr i} {
			puts "[timestamp]"
			set name [format "recd%03d" $i]
			# By redirecting stdout to stdout, we make exec
			# print output rather than simply returning it.
			exec $tclsh_path << "source $test_path/test.tcl; \
			    eval $name $method" >@ stdout
			if { $__debug_print != 0 } {
				puts ""
			}
			if { $__debug_on != 0 } {
				debug
			}
			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]\
			    run_recd: $method $i: $theError"
		} else {
			error $theError;
		}
	}
}
