diff options
Diffstat (limited to 'storage/bdb/test/test.tcl')
| -rw-r--r-- | storage/bdb/test/test.tcl | 1863 |
1 files changed, 1863 insertions, 0 deletions
diff --git a/storage/bdb/test/test.tcl b/storage/bdb/test/test.tcl new file mode 100644 index 00000000000..10ee9425b7a --- /dev/null +++ b/storage/bdb/test/test.tcl @@ -0,0 +1,1863 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996-2002 +# Sleepycat Software. All rights reserved. +# +# $Id: test.tcl,v 11.225 2002/09/10 18:51:38 sue Exp $ + +source ./include.tcl + +# Load DB's TCL API. +load $tcllib + +if { [file exists $testdir] != 1 } { + file mkdir $testdir +} + +global __debug_print +global __debug_on +global __debug_test +global util_path + +# +# 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 ./db_printlog -?} ret] +if { [string first "exec format error" $ret] != -1 } { + set util_path ./.libs +} else { + set util_path . +} +set __debug_print 0 +set encrypt 0 +set old_encrypt 0 +set passwd test_passwd + +# This is where the test numbering and parameters now live. +source $test_path/testparams.tcl + +# Error stream that (should!) always go to the console, even if we're +# redirecting to ALL.OUT. +set consoleerr stderr + +foreach sub $subs { + if { [info exists num_test($sub)] != 1 } { + puts stderr "Subsystem $sub has no number of tests specified in\ + testparams.tcl; skipping." + continue + } + set end $num_test($sub) + for { set i 1 } { $i <= $end } {incr i} { + set name [format "%s%03d.tcl" $sub $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/logtrack.tcl +source $test_path/ndbm.tcl +source $test_path/parallel.tcl +source $test_path/reputils.tcl +source $test_path/sdbutils.tcl +source $test_path/shelltest.tcl +source $test_path/sindex.tcl +source $test_path/testutils.tcl +source $test_path/upgrade.tcl + +set dict $test_path/wordlist +set alphabet "abcdefghijklmnopqrstuvwxyz" +set datastr "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz" + +# Random number seed. +global rand_init +set rand_init 101301 + +# 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 +set ohandles {} + +# Normally, we're not running an all-tests-in-one-env run. This matters +# for error stream/error prefix settings in berkdb_open. +global is_envmethod +set is_envmethod 0 + +# For testing locker id wrap around. +global lock_curid +global lock_maxid +set lock_curid 0 +set lock_maxid 2147483647 +global txn_curid +global txn_maxid +set txn_curid 2147483648 +set txn_maxid 4294967295 + +# 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_qnx_test [is_substr $tcl_platform(os) "QNX"] + +# From here on out, test.tcl contains the procs that are used to +# run all or part of the test suite. + +proc run_std { args } { + global num_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 am_only 0 + set no_am 0 + set std_only 1 + set rflags {--} + foreach f $flags { + switch $f { + A { + set std_only 0 + } + M { + set no_am 1 + puts "run_std: all but access method tests." + } + m { + set am_only 1 + puts "run_std: access method tests only." + } + 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 [berkdb version -string] + + puts -nonewline $o "Test suite run started at: " + puts $o [clock format [clock seconds] -format "%H:%M %D"] + puts $o [berkdb version -string] + } + close $o + } + + set test_list { + {"environment" "env"} + {"archive" "archive"} + {"locking" "lock"} + {"logging" "log"} + {"memory pool" "memp"} + {"mutex" "mutex"} + {"transaction" "txn"} + {"deadlock detection" "dead"} + {"subdatabase" "sdb"} + {"byte-order" "byte"} + {"recno backing file" "rsrc"} + {"DBM interface" "dbm"} + {"NDBM interface" "ndbm"} + {"Hsearch interface" "hsearch"} + {"secondary index" "sindex"} + } + + if { $am_only == 0 } { + + 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 $rflags $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. + # + # Note that we still wrap the test in an exec so that + # its output goes to ALL.OUT. run_recd will wrap each test + # so that both error streams go to stdout (which here goes + # to ALL.OUT); information that run_recd wishes to print + # to the "real" stderr, but outside the wrapping for each test, + # such as which tests are being skipped, it can still send to + # stderr. + puts "Running recovery tests" + if [catch { + exec $tclsh_path \ + << "source $test_path/test.tcl; r $rflags recd" \ + 2>@ stderr >> ALL.OUT + } res] { + set o [open ALL.OUT a] + puts $o "FAIL: recd tests" + 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 $rflags $i" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: $i test" + close $o + } + } + } + + if { $no_am == 0 } { + # Access method tests. + # + # XXX + # Broken up into separate tclsh instantiations so we don't + # require so much memory. + foreach i \ + "btree hash queue queueext recno rbtree frecno rrecno" { + puts "Running $i tests" + for { set j 1 } { $j <= $num_test(test) } {incr j} { + if { $run == 0 } { + set o [open ALL.OUT a] + run_method -$i $j $j $display $run $o + close $o + } + if { $run } { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + run_method -$i $j $j $display $run"\ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL:\ + [format "test%03d" $j] $i" + 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_failed_run 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; 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 check_failed_run { file {text "^FAIL"}} { + set failed 0 + set o [open $file r] + while { [gets $o line] >= 0 } { + set ret [regexp $text $line] + if { $ret != 0 } { + set failed 1 + } + } + close $o + + return $failed +} + +proc r { args } { + global num_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 { + byte { + if { $display } { + puts "run_test byteorder" + } + if { $run } { + check_handles + run_test byteorder + } + } + archive - + dbm - + hsearch - + ndbm - + shelltest - + sindex { + if { $display } { puts "r $sub" } + if { $run } { + check_handles + $sub + } + } + bigfile - + dead - + env - + lock - + log - + memp - + mutex - + rsrc - + sdbtest - + txn { + if { $display } { run_subsystem $sub 1 0 } + if { $run } { + run_subsystem $sub + } + } + join { + eval r $saveflags join1 + eval r $saveflags join2 + eval r $saveflags join3 + eval r $saveflags join4 + eval r $saveflags join5 + eval r $saveflags join6 + } + join1 { + if { $display } { puts jointest } + if { $run } { + check_handles + jointest + } + } + joinbench { + puts "[timestamp]" + eval r $saveflags join1 + eval r $saveflags join2 + puts "[timestamp]" + } + join2 { + if { $display } { puts "jointest 512" } + if { $run } { + check_handles + jointest 512 + } + } + join3 { + if { $display } { + puts "jointest 8192 0 -join_item" + } + if { $run } { + check_handles + jointest 8192 0 -join_item + } + } + join4 { + if { $display } { puts "jointest 8192 2" } + if { $run } { + check_handles + jointest 8192 2 + } + } + join5 { + if { $display } { puts "jointest 8192 3" } + if { $run } { + check_handles + jointest 8192 3 + } + } + join6 { + if { $display } { puts "jointest 512 3" } + if { $run } { + check_handles + jointest 512 3 + } + } + recd { + check_handles + run_recds $run $display [lrange $args 1 end] + } + rep { + for { set j 1 } { $j <= $num_test(test) } \ + { incr j } { + if { $display } { + puts "eval run_test \ + run_repmethod 0 $j $j" + } + if { $run } { + eval run_test \ + run_repmethod 0 $j $j + } + } + for { set i 1 } \ + { $i <= $num_test(rep) } {incr i} { + set test [format "%s%03d" $sub $i] + if { $i == 2 } { + if { $run } { + puts "Skipping rep002 \ + (waiting on SR #6195)" + } + continue + } + if { $display } { + puts "run_test $test" + } + if { $run } { + run_test $test + } + } + } + rpc { + if { $display } { puts "r $sub" } + global rpc_svc svc_list + set old_rpc_src $rpc_svc + foreach rpc_svc $svc_list { + if { !$run || \ + ![file exist $util_path/$rpc_svc] } { + continue + } + run_subsystem rpc + if { [catch {run_rpcmethod -txn} ret] != 0 } { + puts $ret + } + run_test run_rpcmethod + } + set rpc_svc $old_rpc_src + } + sec { + if { $display } { + run_subsystem $sub 1 0 + } + if { $run } { + run_subsystem $sub 0 1 + } + for { set j 1 } { $j <= $num_test(test) } \ + { incr j } { + if { $display } { + puts "eval run_test \ + run_secmethod $j $j" + puts "eval run_test \ + run_secenv $j $j" + } + if { $run } { + eval run_test \ + run_secmethod $j $j + eval run_test \ + run_secenv $j $j + } + } + } + sdb { + if { $display } { + puts "eval r $saveflags sdbtest" + for { set j 1 } \ + { $j <= $num_test(sdb) } \ + { incr j } { + puts "eval run_test \ + subdb $j $j" + } + } + if { $run } { + eval r $saveflags sdbtest + for { set j 1 } \ + { $j <= $num_test(sdb) } \ + { incr j } { + eval run_test subdb $j $j + } + } + } + btree - + rbtree - + hash - + queue - + queueext - + recno - + frecno - + rrecno { + eval run_method [lindex $args 0] \ + 1 0 $display $run [lrange $args 1 end] + } + + 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_subsystem { prefix { display 0 } { run 1} } { + global num_test + if { [info exists num_test($prefix)] != 1 } { + puts stderr "Subsystem $sub has no number of tests specified in\ + testparams.tcl; skipping." + return + } + for { set i 1 } { $i <= $num_test($prefix) } {incr i} { + set name [format "%s%03d" $prefix $i] + if { $display } { + puts "eval $name" + } + if { $run } { + check_handles + catch {eval $name} + } + } +} + +proc run_test { testname args } { + source ./include.tcl + foreach method "hash queue queueext recno rbtree frecno rrecno btree" { + check_handles + eval $testname -$method $args + verify_dir $testdir "" 1 + } +} + +proc run_method { method {start 1} {stop 0} {display 0} {run 1} \ + { outfile stdout } args } { + global __debug_on + global __debug_print + global num_test + global parms + source ./include.tcl + + if { $stop == 0 } { + set stop $num_test(test) + } + if { $run == 1 } { + puts $outfile "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 } { + puts stderr "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + if { $display } { + puts -nonewline $outfile "eval $name $method" + puts -nonewline $outfile " $parms($name) $args" + puts $outfile " ; verify_dir $testdir \"\" 1" + } + if { $run } { + check_handles $outfile + puts $outfile "[timestamp]" + eval $name $method $parms($name) $args + if { $__debug_print != 0 } { + puts $outfile "" + } + # verify all databases the test leaves behind + verify_dir $testdir "" 1 + 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 { method {start 1} {stop 0} {largs ""} } { + global __debug_on + global __debug_print + global num_test + global parms + global is_envmethod + global rpc_svc + source ./include.tcl + + if { $stop == 0 } { + set stop $num_test(test) + } + puts "run_rpcmethod: $method $start $stop $largs" + + set save_largs $largs + if { [string compare $rpc_server "localhost"] == 0 } { + set dpid [exec $util_path/$rpc_svc -h $rpc_testdir &] + } else { + set dpid [exec rsh $rpc_server $rpc_path/$rpc_svc \ + -h $rpc_testdir &] + } + puts "\tRun_rpcmethod.a: starting server, pid $dpid" + tclsleep 10 + remote_cleanup $rpc_server $rpc_testdir $testdir + + set home [file tail $rpc_testdir] + + set is_envmethod 1 + set use_txn 0 + if { [string first "txn" $method] != -1 } { + set use_txn 1 + } + if { $use_txn == 1 } { + if { $start == 1 } { + set ntxns 32 + } else { + set ntxns $start + } + set i 1 + check_handles + remote_cleanup $rpc_server $rpc_testdir $testdir + set env [eval {berkdb_env -create -mode 0644 -home $home \ + -server $rpc_server -client_timeout 10000} -txn] + error_check_good env_open [is_valid_env $env] TRUE + + set stat [catch {eval txn001_suba $ntxns $env} res] + if { $stat == 0 } { + set stat [catch {eval txn001_subb $ntxns $env} res] + } + error_check_good envclose [$env close] 0 + set stat [catch {eval txn003} res] + } else { + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + check_handles + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Test%03d $i]\ + disabled in testparams.tcl;\ + skipping." + continue + } + remote_cleanup $rpc_server $rpc_testdir $testdir + # + # Set server cachesize to 1Mb. Otherwise some + # tests won't fit (like test084 -btree). + # + set env [eval {berkdb_env -create -mode 0644 \ + -home $home -server $rpc_server \ + -client_timeout 10000 \ + -cachesize {0 1048576 1}}] + error_check_good env_open \ + [is_valid_env $env] TRUE + append largs " -env $env " + + puts "[timestamp]" + eval $name $method $parms($name) $largs + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug + } + flush stdout + flush stderr + set largs $save_largs + error_check_good envclose [$env close] 0 + } + } res] + } + if { $stat != 0} { + global errorInfo; + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + tclkill $dpid + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_rpcmethod: $method $i: $theError" + } else { + error $theError; + } + } + set is_envmethod 0 + tclkill $dpid +} + +proc run_rpcnoserver { method {start 1} {stop 0} {largs ""} } { + global __debug_on + global __debug_print + global num_test + global parms + global is_envmethod + source ./include.tcl + + if { $stop == 0 } { + set stop $num_test(test) + } + puts "run_rpcnoserver: $method $start $stop $largs" + + set save_largs $largs + remote_cleanup $rpc_server $rpc_testdir $testdir + set home [file tail $rpc_testdir] + + set is_envmethod 1 + set use_txn 0 + if { [string first "txn" $method] != -1 } { + set use_txn 1 + } + if { $use_txn == 1 } { + if { $start == 1 } { + set ntxns 32 + } else { + set ntxns $start + } + set i 1 + check_handles + remote_cleanup $rpc_server $rpc_testdir $testdir + set env [eval {berkdb_env -create -mode 0644 -home $home \ + -server $rpc_server -client_timeout 10000} -txn] + error_check_good env_open [is_valid_env $env] TRUE + + set stat [catch {eval txn001_suba $ntxns $env} res] + if { $stat == 0 } { + set stat [catch {eval txn001_subb $ntxns $env} res] + } + error_check_good envclose [$env close] 0 + } else { + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + check_handles + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Test%03d $i]\ + disabled in testparams.tcl;\ + skipping." + continue + } + remote_cleanup $rpc_server $rpc_testdir $testdir + # + # Set server cachesize to 1Mb. Otherwise some + # tests won't fit (like test084 -btree). + # + set env [eval {berkdb_env -create -mode 0644 \ + -home $home -server $rpc_server \ + -client_timeout 10000 \ + -cachesize {0 1048576 1} }] + error_check_good env_open \ + [is_valid_env $env] TRUE + append largs " -env $env " + + puts "[timestamp]" + eval $name $method $parms($name) $largs + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug + } + flush stdout + flush stderr + set largs $save_largs + error_check_good envclose [$env close] 0 + } + } res] + } + if { $stat != 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_rpcnoserver: $method $i: $theError" + } else { + error $theError; + } + set is_envmethod 0 + } + +} + +# +# Run method tests in secure mode. +# +proc run_secmethod { method {start 1} {stop 0} {display 0} {run 1} \ + { outfile stdout } args } { + global passwd + + append largs " -encryptaes $passwd " + eval run_method $method $start $stop $display $run $outfile $largs +} + +# +# Run method tests in its own, new secure environment. +# +proc run_secenv { method {start 1} {stop 0} {largs ""} } { + global __debug_on + global __debug_print + global is_envmethod + global num_test + global parms + global passwd + source ./include.tcl + + if { $stop == 0 } { + set stop $num_test(test) + } + puts "run_secenv: $method $start $stop $largs" + + set save_largs $largs + env_cleanup $testdir + set is_envmethod 1 + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + check_handles + set env [eval {berkdb_env -create -mode 0644 \ + -home $testdir -encryptaes $passwd \ + -cachesize {0 1048576 1}}] + error_check_good env_open [is_valid_env $env] TRUE + append largs " -env $env " + + puts "[timestamp]" + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + + # + # Run each test multiple times in the secure env. + # Once with a secure env + clear database + # Once with a secure env + secure database + # + eval $name $method $parms($name) $largs + append largs " -encrypt " + eval $name $method $parms($name) $largs + + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug + } + flush stdout + flush stderr + set largs $save_largs + error_check_good envclose [$env close] 0 + error_check_good envremove [berkdb envremove \ + -home $testdir -encryptaes $passwd] 0 + } + } res] + if { $stat != 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_secenv: $method $i: $theError" + } else { + error $theError; + } + set is_envmethod 0 + } + +} + +# +# Run replication method tests in master and client env. +# +proc run_reptest { method test {droppct 0} {nclients 1} {do_del 0} \ + {do_sec 0} {do_oob 0} {largs "" } } { + source ./include.tcl + global __debug_on + global __debug_print + global __debug_test + global is_envmethod + global num_test + global parms + global passwd + global rand_init + + berkdb srand $rand_init + set c [string index $test 0] + if { $c == "s" } { + set i [string range $test 1 end] + set name [format "subdb%03d" $i] + } else { + set i $test + set name [format "test%03d" $i] + } + puts "run_reptest: $method $name" + + env_cleanup $testdir + set is_envmethod 1 + set stat [catch { + if { $do_sec } { + set envargs "-encryptaes $passwd" + append largs " -encrypt " + } else { + set envargs "" + } + check_handles + # + # This will set up the master and client envs + # and will return us the args to pass to the + # test. + set largs [repl_envsetup \ + $envargs $largs $test $nclients $droppct $do_oob] + + puts "[timestamp]" + if { [info exists parms($name)] != 1 } { + puts stderr "[format Test%03d $i] \ + disabled in\ + testparams.tcl; skipping." + continue + } + puts -nonewline \ + "Repl: $name: dropping $droppct%, $nclients clients " + if { $do_del } { + puts -nonewline " with delete verification;" + } else { + puts -nonewline " no delete verification;" + } + if { $do_sec } { + puts -nonewline " with security;" + } else { + puts -nonewline " no security;" + } + if { $do_oob } { + puts -nonewline " with out-of-order msgs;" + } else { + puts -nonewline " no out-of-order msgs;" + } + puts "" + + eval $name $method $parms($name) $largs + + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug $__debug_test + } + flush stdout + flush stderr + repl_envprocq $i $nclients $do_oob + repl_envver0 $i $method $nclients + if { $do_del } { + repl_verdel $i $method $nclients + } + repl_envclose $i $envargs + } res] + if { $stat != 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_reptest: $method $i: $theError" + } else { + error $theError; + } + } + set is_envmethod 0 +} + +# +# Run replication method tests in master and client env. +# +proc run_repmethod { method {numcl 0} {start 1} {stop 0} {display 0} + {run 1} {outfile stdout} {largs ""} } { + source ./include.tcl + global __debug_on + global __debug_print + global __debug_test + global is_envmethod + global num_test + global parms + global passwd + global rand_init + + set stopsdb $num_test(sdb) + if { $stop == 0 } { + set stop $num_test(test) + } else { + if { $stopsdb > $stop } { + set stopsdb $stop + } + } + berkdb srand $rand_init + + # + # We want to run replication both normally and with crypto. + # So run it once and then run again with crypto. + # + set save_largs $largs + env_cleanup $testdir + + if { $display == 1 } { + for { set i $start } { $i <= $stop } { incr i } { + puts $outfile "eval run_repmethod $method \ + 0 $i $i 0 1 stdout $largs" + } + } + if { $run == 1 } { + set is_envmethod 1 + # + # Use an array for number of clients because we really don't + # want to evenly-weight all numbers of clients. Favor smaller + # numbers but test more clients occasionally. + set drop_list { 0 0 0 0 0 1 1 5 5 10 20 } + set drop_len [expr [llength $drop_list] - 1] + set client_list { 1 1 2 1 1 1 2 2 3 1 } + set cl_len [expr [llength $client_list] - 1] + set stat [catch { + for { set i $start } { $i <= $stopsdb } {incr i} { + if { $numcl == 0 } { + set clindex [berkdb random_int 0 $cl_len] + set nclients [lindex $client_list $clindex] + } else { + set nclients $numcl + } + set drindex [berkdb random_int 0 $drop_len] + set droppct [lindex $drop_list $drindex] + set do_sec [berkdb random_int 0 1] + set do_oob [berkdb random_int 0 1] + set do_del [berkdb random_int 0 1] + + if { $do_sec } { + set envargs "-encryptaes $passwd" + append largs " -encrypt " + } else { + set envargs "" + } + check_handles + # + # This will set up the master and client envs + # and will return us the args to pass to the + # test. + set largs [repl_envsetup $envargs $largs \ + $i $nclients $droppct $do_oob] + + puts "[timestamp]" + set name [format "subdb%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Subdb%03d $i] \ + disabled in\ + testparams.tcl; skipping." + continue + } + puts -nonewline "Repl: $name: dropping $droppct%, \ + $nclients clients " + if { $do_del } { + puts -nonewline " with delete verification;" + } else { + puts -nonewline " no delete verification;" + } + if { $do_sec } { + puts -nonewline " with security;" + } else { + puts -nonewline " no security;" + } + if { $do_oob } { + puts -nonewline " with out-of-order msgs;" + } else { + puts -nonewline " no out-of-order msgs;" + } + puts "" + + eval $name $method $parms($name) $largs + + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug $__debug_test + } + flush stdout + flush stderr + repl_envprocq $i $nclients $do_oob + repl_envver0 $i $method $nclients + if { $do_del } { + repl_verdel $i $method $nclients + } + repl_envclose $i $envargs + set largs $save_largs + } + } res] + if { $stat != 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_repmethod: $method $i: $theError" + } else { + error $theError; + } + } + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + if { $numcl == 0 } { + set clindex [berkdb random_int 0 $cl_len] + set nclients [lindex $client_list $clindex] + } else { + set nclients $numcl + } + set drindex [berkdb random_int 0 $drop_len] + set droppct [lindex $drop_list $drindex] + set do_sec [berkdb random_int 0 1] + set do_oob [berkdb random_int 0 1] + set do_del [berkdb random_int 0 1] + + if { $do_sec } { + set envargs "-encryptaes $passwd" + append largs " -encrypt " + } else { + set envargs "" + } + check_handles + # + # This will set up the master and client envs + # and will return us the args to pass to the + # test. + set largs [repl_envsetup $envargs $largs \ + $i $nclients $droppct $do_oob] + + puts "[timestamp]" + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Test%03d $i] \ + disabled in\ + testparams.tcl; skipping." + continue + } + puts -nonewline "Repl: $name: dropping $droppct%, \ + $nclients clients " + if { $do_del } { + puts -nonewline " with delete verification;" + } else { + puts -nonewline " no delete verification;" + } + if { $do_sec } { + puts -nonewline " with security;" + } else { + puts -nonewline " no security;" + } + if { $do_oob } { + puts -nonewline " with out-of-order msgs;" + } else { + puts -nonewline " no out-of-order msgs;" + } + puts "" + + eval $name $method $parms($name) $largs + + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug $__debug_test + } + flush stdout + flush stderr + repl_envprocq $i $nclients $do_oob + repl_envver0 $i $method $nclients + if { $do_del } { + repl_verdel $i $method $nclients + } + repl_envclose $i $envargs + set largs $save_largs + } + } res] + if { $stat != 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_repmethod: $method $i: $theError" + } else { + error $theError; + } + } + set is_envmethod 0 + } +} + +# +# Run method tests, each in its own, new environment. (As opposed to +# run_envmethod1 which runs all the tests in a single environment.) +# +proc run_envmethod { method {start 1} {stop 0} {display 0} {run 1} \ + {outfile stdout } { largs "" } } { + global __debug_on + global __debug_print + global __debug_test + global is_envmethod + global num_test + global parms + source ./include.tcl + + set stopsdb $num_test(sdb) + if { $stop == 0 } { + set stop $num_test(test) + } else { + if { $stopsdb > $stop } { + set stopsdb $stop + } + } + + set save_largs $largs + env_cleanup $testdir + + if { $display == 1 } { + for { set i $start } { $i <= $stop } { incr i } { + puts $outfile "eval run_envmethod $method \ + $i $i 0 1 stdout $largs" + } + } + + if { $run == 1 } { + set is_envmethod 1 + # + # Run both subdb and normal tests for as long as there are + # some of each type. Start with the subdbs: + set stat [catch { + for { set i $start } { $i <= $stopsdb } {incr i} { + check_handles + set env [eval {berkdb_env -create -txn \ + -mode 0644 -home $testdir}] + error_check_good env_open \ + [is_valid_env $env] TRUE + append largs " -env $env " + + puts "[timestamp]" + set name [format "subdb%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr \ + "[format Subdb%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + eval $name $method $parms($name) $largs + + error_check_good envclose [$env close] 0 + error_check_good envremove [berkdb envremove \ + -home $testdir] 0 + flush stdout + flush stderr + set largs $save_largs + } + } res] + if { $stat != 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_envmethod: $method $i: $theError" + } else { + error $theError; + } + } + # Subdb tests are done, now run through the regular tests: + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + check_handles + set env [eval {berkdb_env -create -txn \ + -mode 0644 -home $testdir}] + error_check_good env_open \ + [is_valid_env $env] TRUE + append largs " -env $env " + + puts "[timestamp]" + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr \ + "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + eval $name $method $parms($name) $largs + + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug $__debug_test + } + flush stdout + flush stderr + set largs $save_largs + error_check_good envclose [$env close] 0 + error_check_good envremove [berkdb envremove \ + -home $testdir] 0 + } + } res] + if { $stat != 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_envmethod: $method $i: $theError" + } else { + error $theError; + } + } + set is_envmethod 0 + } +} + +proc subdb { method {start 1} {stop 0} {display 0} {run 1} \ + {outfile stdout} args} { + global num_test testdir + global parms + + for { set i $start } { $i <= $stop } {incr i} { + set name [format "subdb%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Subdb%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + if { $display } { + puts -nonewline $outfile "eval $name $method" + puts -nonewline $outfile " $parms($name) $args;" + puts $outfile "verify_dir $testdir \"\" 1" + } + if { $run } { + check_handles $outfile + eval $name $method $parms($name) $args + verify_dir $testdir "" 1 + } + flush stdout + flush stderr + } +} + +proc run_recd { method {start 1} {stop 0} {run 1} {display 0} args } { + global __debug_on + global __debug_print + global __debug_test + global parms + global num_test + global log_log_record_types + source ./include.tcl + + if { $stop == 0 } { + set stop $num_test(recd) + } + if { $run == 1 } { + puts "run_recd: $method $start $stop $args" + } + + if {[catch { + for { set i $start } { $i <= $stop } {incr i} { + set name [format "recd%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Recd%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + if { $display } { + puts "eval $name $method $parms($name) $args" + } + if { $run } { + check_handles + puts "[timestamp]" + # By redirecting stdout to stdout, we make exec + # print output rather than simply returning it. + # By redirecting stderr to stdout too, we make + # sure everything winds up in the ALL.OUT file. + set ret [catch { exec $tclsh_path << \ + "source $test_path/test.tcl; \ + set log_log_record_types \ + $log_log_record_types; eval $name \ + $method $parms($name) $args" \ + >&@ stdout + } res] + + # Don't die if the test failed; we want + # to just proceed. + if { $ret != 0 } { + puts "FAIL:[timestamp] $res" + } + + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug $__debug_test + } + 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; + } + } +} + +proc run_recds { {run 1} {display 0} args } { + global log_log_record_types + + set log_log_record_types 1 + logtrack_init + foreach method \ + "btree rbtree hash queue queueext recno frecno rrecno" { + check_handles + if { [catch {eval \ + run_recd -$method 1 0 $run $display $args} ret ] != 0 } { + puts $ret + } + } + if { $run } { + logtrack_summary + } + set log_log_record_types 0 +} + +proc run_all { args } { + global num_test + source ./include.tcl + + fileremove -f ALL.OUT + + set exflgs [eval extractflags $args] + set flags [lindex $exflgs 1] + set display 1 + set run 1 + set am_only 0 + set parallel 0 + set nparalleltests 0 + set rflags {--} + foreach f $flags { + switch $f { + m { + set am_only 1 + } + 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 [berkdb 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} $args + + set test_pagesizes [get_test_pagesizes] + set args [lindex $exflgs 0] + set save_args $args + + foreach pgsz $test_pagesizes { + set args $save_args + append args " -pagesize $pgsz -chksum" + if { $am_only == 0 } { + # Run recovery tests. + # + # XXX These don't actually work at multiple pagesizes; + # disable them for now. + # + # 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. + # + # XXX See comment in run_std for why this only directs + # stdout and not stderr. Don't worry--the right stuff + # happens. + #puts "Running recovery tests with pagesize $pgsz" + #if [catch {exec $tclsh_path \ + # << "source $test_path/test.tcl; \ + # r $rflags recd $args" \ + # 2>@ stderr >> ALL.OUT } res] { + # set o [open ALL.OUT a] + # puts $o "FAIL: recd test:" + # puts $o $res + # 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 queueext recno frecno rrecno" { + puts "Running $i tests with pagesize $pgsz" + for { set j 1 } { $j <= $num_test(test) } {incr j} { + if { $run == 0 } { + set o [open ALL.OUT a] + eval {run_method -$i $j $j $display \ + $run $o} $args + close $o + } + if { $run } { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + eval {run_method -$i $j $j \ + $display $run stdout} $args" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o \ + "FAIL: [format \ + "test%03d" $j] $i" + close $o + } + } + } + + # + # Run subdb tests with varying pagesizes too. + # + for { set j 1 } { $j <= $num_test(sdb) } {incr j} { + if { $run == 0 } { + set o [open ALL.OUT a] + eval {subdb -$i $j $j $display \ + $run $o} $args + close $o + } + if { $run == 1 } { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + eval {subdb -$i $j $j $display \ + $run stdout} $args" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: subdb -$i $j $j" + close $o + } + } + } + } + } + set args $save_args + # + # Run access method tests at default page size in one env. + # + foreach i "btree rbtree hash queue queueext recno frecno rrecno" { + puts "Running $i tests in a txn env" + for { set j 1 } { $j <= $num_test(test) } { incr j } { + if { $run == 0 } { + set o [open ALL.OUT a] + run_envmethod -$i $j $j $display \ + $run $o $args + close $o + } + if { $run } { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + run_envmethod -$i $j $j \ + $display $run stdout $args" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o \ + "FAIL: run_envmethod $i $j $j" + close $o + } + } + } + } + # + # Run tests using proc r. The replication tests have been + # moved from run_std to run_all. + # + set test_list { + {"replication" "rep"} + {"security" "sec"} + } + # + # If configured for RPC, then run rpc tests too. + # + if { [file exists ./berkeley_db_svc] || + [file exists ./berkeley_db_cxxsvc] || + [file exists ./berkeley_db_javasvc] } { + append test_list {{"RPC" "rpc"}} + } + + 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 $rflags $cmd $args" >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: $cmd test" + 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 +} + +# +# Run method tests in one environment. (As opposed to run_envmethod +# which runs each test in its own, new environment.) +# +proc run_envmethod1 { method {start 1} {stop 0} {display 0} {run 1} \ + { outfile stdout } args } { + global __debug_on + global __debug_print + global __debug_test + global is_envmethod + global num_test + global parms + source ./include.tcl + + set stopsdb $num_test(sdb) + if { $stop == 0 } { + set stop $num_test(test) + } else { + if { $stopsdb > $stop } { + set stopsdb $stop + } + } + if { $run == 1 } { + puts "run_envmethod1: $method $start $stop $args" + } + + set is_envmethod 1 + if { $run == 1 } { + check_handles + env_cleanup $testdir + error_check_good envremove [berkdb envremove -home $testdir] 0 + set env [eval {berkdb_env -create -cachesize {0 10000000 0}} \ + {-mode 0644 -home $testdir}] + error_check_good env_open [is_valid_env $env] TRUE + append largs " -env $env " + } + + if { $display } { + # The envmethod1 tests can't be split up, since they share + # an env. + puts $outfile "eval run_envmethod1 $method $args" + } + + set stat [catch { + for { set i $start } { $i <= $stopsdb } {incr i} { + set name [format "subdb%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Subdb%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + if { $run } { + puts $outfile "[timestamp]" + eval $name $method $parms($name) $largs + if { $__debug_print != 0 } { + puts $outfile "" + } + if { $__debug_on != 0 } { + debug $__debug_test + } + } + 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]] + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_envmethod: $method $i: $theError" + } else { + error $theError; + } + } + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts stderr "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + if { $run } { + puts $outfile "[timestamp]" + eval $name $method $parms($name) $largs + if { $__debug_print != 0 } { + puts $outfile "" + } + if { $__debug_on != 0 } { + debug $__debug_test + } + } + 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]] + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_envmethod1: $method $i: $theError" + } else { + error $theError; + } + } + if { $run == 1 } { + error_check_good envclose [$env close] 0 + check_handles $outfile + } + set is_envmethod 0 + +} + +# We want to test all of 512b, 8Kb, and 64Kb pages, but chances are one +# of these is the default pagesize. We don't want to run all the AM tests +# twice, so figure out what the default page size is, then return the +# other two. +proc get_test_pagesizes { } { + # Create an in-memory database. + set db [berkdb_open -create -btree] + error_check_good gtp_create [is_valid_db $db] TRUE + set statret [$db stat] + set pgsz 0 + foreach pair $statret { + set fld [lindex $pair 0] + if { [string compare $fld {Page size}] == 0 } { + set pgsz [lindex $pair 1] + } + } + + error_check_good gtp_close [$db close] 0 + + error_check_bad gtp_pgsz $pgsz 0 + switch $pgsz { + 512 { return {8192 32768} } + 8192 { return {512 32768} } + 32768 { return {512 8192} } + default { return {512 8192 32768} } + } + error_check_good NOTREACHED 0 1 +} |