source ./include.tcl
load $tcllib
if { [file exists $testdir] != 1 } {
file mkdir $testdir
}
global __debug_print
global __debug_on
global __debug_test
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
set consoleerr stderr
set dict $test_path/wordlist
set alphabet "abcdefghijklmnopqrstuvwxyz"
set datastr "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"
global rand_init
set rand_init 11302005
set fixed_len 20
set recd_debug 0
set log_log_record_types 0
set ohandles {}
global is_envmethod
set is_envmethod 0
global is_repchild
set is_repchild 0
global noenv_messaging
set noenv_messaging 0
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
global one_test
if { [info exists one_test] != 1 } {
set one_test "ALL"
}
global checking_valid_methods
set checking_valid_methods 0
global valid_methods
set valid_methods { btree rbtree queue queueext recno frecno rrecno hash }
global test_recopts
set test_recopts { "-recover" "" }
source $test_path/testutils.tcl
global tcl_platform
set is_freebsd_test [string match FreeBSD $tcl_platform(os)]
set is_hp_test [string match HP-UX $tcl_platform(os)]
set is_linux_test [string match Linux $tcl_platform(os)]
set is_qnx_test [string match QNX $tcl_platform(os)]
set is_sunos_test [string match SunOS $tcl_platform(os)]
set is_windows_test [string match Win* $tcl_platform(os)]
set is_windows9x_test [string match "Windows 95" $tcl_platform(osVersion)]
set is_je_test 0
set upgrade_be [big_endian]
global is_fat32
set is_fat32 [string match FAT32 [lindex [file system check] 1]]
global EXE BAT
if { $is_windows_test == 1 } {
set EXE ".exe"
set BAT ".bat"
} else {
set EXE ""
set BAT ""
}
source $test_path/testparams.tcl
set has_crypto 1
set stat [catch {set db [eval {berkdb_open_noerr \
-create -btree -encryptaes test_passwd} ] } result ]
if { $stat != 0 } {
error_check_good non_crypto_release \
[expr [is_substr $result "operation not supported"] || \
[is_substr $result "invalid argument"]] 1
set has_crypto 0
} else {
error_check_good close_encrypted_db [$db close] 0
}
proc run_std { { testname ALL } args } {
global test_names
global one_test
global has_crypto
global valid_methods
source ./include.tcl
set one_test $testname
if { $one_test != "ALL" } {
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 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"}
{"backup" "backup"}
{"file operations" "fop"}
{"locking" "lock"}
{"logging" "log"}
{"memory pool" "memp"}
{"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 { $std_only == 1 } {
lappend test_list {"replication" "rep_subset"}
} else {
lappend test_list {"replication" "rep_complete"}
}
if { $has_crypto == 1 } {
lappend test_list {"security" "sec"}
}
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 << \
"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
}
}
puts "Running recovery tests"
if [catch {
exec $tclsh_path << \
"global one_test; set one_test $one_test; \
source $test_path/test.tcl; r $rflags recd" \
2>@ stderr >> ALL.OUT
} res] {
set o [open ALL.OUT a]
puts $o "FAIL: recd tests: $res"
close $o
}
if { $one_test == "ALL" } {
puts "Running join test"
foreach test "join1 join2 join3 join4 join5 join6" {
if [catch {exec $tclsh_path << \
"source $test_path/test.tcl; r $rflags $test" \
>>& ALL.OUT } res] {
set o [open ALL.OUT a]
puts $o "FAIL: $test test: $res"
close $o
}
}
}
}
if { $no_am == 0 } {
foreach method $valid_methods {
puts "Running $method tests"
foreach test $test_names(test) {
if { $run == 0 } {
set o [open ALL.OUT a]
run_method \
-$method $test $display $run $o
close $o
}
if { $run } {
if [catch {exec $tclsh_path << \
"global one_test; \
set one_test $one_test; \
source $test_path/test.tcl; \
run_method \
-$method $test $display $run"\
>>& ALL.OUT } res] {
set o [open ALL.OUT a]
puts $o "FAIL:$test $method: $res"
close $o
}
}
}
}
}
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 } {
set pattern {(?x)
^[:space:]*$|
.*?wrap\.tcl.*|
.*?dbscript\.tcl.*|
.*?ddscript\.tcl.*|
.*?mpoolscript\.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.*|
^fileops:\s.*|
^jointest.*$|
^r\sarchive\s*|
^r\sbackup\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.$|
^Backuptest\s.*|
^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:.*|
^Running\stest\ssdb.*|
^Running\stest\stest.*|
^Script\swatcher\sprocess\s.*|
^Secondary\sindex\sjoin\s.*|
^\sBerkeley\sDB\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*Add\sa\sthird\sversion\s.*|
^\t*Archive[:\.].*|
^\t*Backuptest.*|
^\t*Bigfile[0-9][0-9][0-9].*|
^\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*Recover\sfrom\sfirst\sdatabase$|
^\t*Recover\sfrom\ssecond\sdatabase$|
^\t*Remove\ssecond\sdb$|
^\t*Rep_verify.*|
^\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 has_crypto
global rand_init
global one_test
global test_recopts
global checking_valid_methods
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 ]
set starttest [lindex $args 1]
switch $sub {
bigfile -
dead -
env -
lock -
log -
memp -
rsrc -
sdbtest -
txn {
if { $display } {
run_subsystem $sub 1 0
}
if { $run } {
run_subsystem $sub
}
}
byte {
if { $one_test == "ALL" } {
run_test byteorder $display $run
}
}
archive -
backup -
dbm -
hsearch -
ndbm -
shelltest {
if { $one_test == "ALL" } {
if { $display } { puts "eval $sub" }
if { $run } {
check_handles
eval $sub
}
}
}
compact -
elect -
inmemdb -
init -
fop {
foreach test $test_names($sub) {
eval run_test $test $display $run
}
}
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 "eval jointest" }
if { $run } {
check_handles
eval jointest
}
}
joinbench {
puts "[timestamp]"
eval r $saveflags join1
eval r $saveflags join2
puts "[timestamp]"
}
join2 {
if { $display } { puts "eval jointest 512" }
if { $run } {
check_handles
eval jointest 512
}
}
join3 {
if { $display } {
puts "eval jointest 8192 0 -join_item"
}
if { $run } {
check_handles
eval jointest 8192 0 -join_item
}
}
join4 {
if { $display } { puts "eval jointest 8192 2" }
if { $run } {
check_handles
eval jointest 8192 2
}
}
join5 {
if { $display } { puts "eval jointest 8192 3" }
if { $run } {
check_handles
eval jointest 8192 3
}
}
join6 {
if { $display } { puts "eval jointest 512 3" }
if { $run } {
check_handles
eval jointest 512 3
}
}
recd {
check_handles
run_recds $run $display [lrange $args 1 end]
}
rep {
r rep_subset $starttest
}
rep_subset {
berkdb srand $rand_init
set tindex [lsearch $test_names(rep) $starttest]
if { $tindex == -1 } {
set tindex 0
}
set rlist [lrange $test_names(rep) $tindex end]
foreach test $rlist {
set random_recopt \
[berkdb random_int 0 1]
if { $random_recopt == 1 } {
set test_recopts "-recover"
} else {
set test_recopts {""}
}
set method_list \
[find_valid_methods $test]
set list_length \
[expr [llength $method_list] - 1]
set method_index \
[berkdb random_int 0 $list_length]
set rand_method \
[lindex $method_list $method_index]
if { $display } {
puts "eval $test \
$rand_method; verify_dir \
$testdir \"\" 1"
}
if { $run } {
check_handles
eval $test $rand_method
verify_dir $testdir "" 1
}
}
set test_recopts { "-recover" "" }
}
rep_complete {
set tindex [lsearch $test_names(rep) $starttest]
if { $tindex == -1 } {
set tindex 0
}
set rlist [lrange $test_names(rep) $tindex end]
foreach test $rlist {
run_test $test $display $run
}
}
repmethod {
berkdb srand $rand_init
foreach sub { test sdb } {
foreach test $test_names($sub) {
eval run_test run_repmethod \
$display $run $test
}
}
}
rpc {
if { $one_test == "ALL" } {
if { $display } { puts "r $sub" }
global BAT EXE rpc_svc svc_list
global rpc_svc svc_list is_je_test
set old_rpc_src $rpc_svc
foreach rpc_svc $svc_list {
if { $rpc_svc == "berkeley_dbje_svc" } {
set old_util_path $util_path
set util_path $je_root/dist
set is_je_test 1
}
if { !$run || \
![file exist $util_path/$rpc_svc$BAT] || \
![file exist $util_path/$rpc_svc$EXE] } {
continue
}
run_subsystem rpc
if { [catch {run_rpcmethod -txn} ret] != 0 } {
puts $ret
}
if { $is_je_test } {
check_handles
eval run_rpcmethod -btree
verify_dir $testdir "" 1
} else {
run_test run_rpcmethod $display $run
}
if { $is_je_test } {
set util_path $old_util_path
set is_je_test 0
}
}
set rpc_svc $old_rpc_src
}
}
sec {
if { $has_crypto == 0 } {
return
}
if { $display } {
run_subsystem $sub 1 0
}
if { $run } {
run_subsystem $sub 0 1
}
}
secmethod {
if { $has_crypto == 0 } {
return
}
foreach test $test_names(test) {
eval run_test run_secmethod \
$display $run $test
eval run_test run_secenv \
$display $run $test
}
}
sdb {
if { $one_test == "ALL" } {
if { $display } {
run_subsystem sdbtest 1 0
}
if { $run } {
run_subsystem sdbtest 0 1
}
}
foreach test $test_names(sdb) {
eval run_test $test $display $run
}
}
sindex {
if { $one_test == "ALL" } {
if { $display } {
sindex 1 0
sijoin 1 0
}
if { $run } {
sindex 0 1
sijoin 0 1
}
}
}
btree -
rbtree -
hash -
iqueue -
iqueueext -
queue -
queueext -
recno -
frecno -
rrecno {
foreach test $test_names(test) {
eval run_method [lindex $args 0] $test \
$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 { sub { display 0 } { run 1} } {
global test_names
if { [info exists test_names($sub)] != 1 } {
puts stderr "Subsystem $sub has no tests specified in\
testparams.tcl; skipping."
return
}
foreach test $test_names($sub) {
if { $display } {
puts "eval $test"
}
if { $run } {
check_handles
if {[catch {eval $test} ret] != 0 } {
puts "FAIL: run_subsystem: $sub $test: \
$ret"
}
}
}
}
proc run_test { test {display 0} {run 1} args } {
source ./include.tcl
global valid_methods
foreach method $valid_methods {
if { $display } {
puts "eval $test -$method $args; verify_dir $testdir \"\" 1"
}
if { $run } {
check_handles
eval $test -$method $args
verify_dir $testdir "" 1
}
}
}
proc run_method { method test {display 0} {run 1} \
{ outfile stdout } args } {
global __debug_on
global __debug_print
global __debug_test
global test_names
global parms
source ./include.tcl
if {[catch {
if { $display } {
puts -nonewline $outfile "eval $test $method"
puts -nonewline $outfile " $parms($test) $args"
puts $outfile " ; verify_dir $testdir \"\" 1"
}
if { $run } {
check_handles $outfile
puts $outfile "[timestamp]"
eval $test $method $parms($test) $args
if { $__debug_print != 0 } {
puts $outfile ""
}
verify_dir $testdir "" 1
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_method: $method $test: $theError"
} else {
error $theError;
}
}
}
proc run_rpcmethod { method {largs ""} } {
global __debug_on
global __debug_print
global __debug_test
global rpc_tests
global parms
global is_envmethod
global rpc_svc
source ./include.tcl
puts "run_rpcmethod: $method $largs using $rpc_svc"
set save_largs $largs
set dpid [rpc_server_start]
puts "\tRun_rpcmethod.a: started server, pid $dpid"
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 } {
set ntxns 32
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]
}
set stat [catch {eval txn003} res]
error_check_good envclose [$env close] 0
} else {
foreach test $rpc_tests($rpc_svc) {
set stat [catch {
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 \
-cachesize {0 134217728 1}}]
error_check_good env_open \
[is_valid_env $env] TRUE
set largs $save_largs
append largs " -env $env "
puts "[timestamp]"
puts "Running test $test with RPC service $rpc_svc"
puts "eval $test $method $parms($test) $largs"
eval $test $method $parms($test) $largs
if { $__debug_print != 0 } {
puts ""
}
if { $__debug_on != 0 } {
debug $__debug_test
}
flush stdout
flush stderr
error_check_good envclose [$env close] 0
set env ""
} res]
if { $stat != 0} {
global errorInfo;
puts "$res"
set fnl [string first "\n" $errorInfo]
set theError [string range $errorInfo 0 [expr $fnl - 1]]
if {[string first FAIL $errorInfo] == -1} {
puts "FAIL:[timestamp]\
run_rpcmethod: $method $test: $errorInfo"
} else {
puts $theError;
}
catch { $env close } ignore
set env ""
tclkill $dpid
set dpid [rpc_server_start]
}
}
}
set is_envmethod 0
tclkill $dpid
}
proc run_rpcnoserver { method {largs ""} } {
global __debug_on
global __debug_print
global __debug_test
global test_names
global parms
global is_envmethod
source ./include.tcl
puts "run_rpcnoserver: $method $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 } {
set ntxns 32
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 {
foreach test $test_names {
check_handles
if { [info exists parms($test)] != 1 } {
puts stderr "$test disabled in \
testparams.tcl; skipping."
continue
}
remote_cleanup $rpc_server $rpc_testdir $testdir
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 $test $method $parms($test) $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
}
} 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
}
}
proc run_secmethod { method test {display 0} {run 1} \
{ outfile stdout } args } {
global passwd
global has_crypto
if { $has_crypto == 0 } {
return
}
set largs $args
append largs " -encryptaes $passwd "
eval run_method $method $test $display $run $outfile $largs
}
proc run_secenv { method test {largs ""} } {
global __debug_on
global __debug_print
global __debug_test
global is_envmethod
global has_crypto
global test_names
global parms
global passwd
source ./include.tcl
if { $has_crypto == 0 } {
return
}
puts "run_secenv: $method $test $largs"
set save_largs $largs
env_cleanup $testdir
set is_envmethod 1
set stat [catch {
check_handles
set env [eval {berkdb_env -create -mode 0644 -home $testdir \
-encryptaes $passwd -cachesize {0 4194304 1}}]
error_check_good env_open [is_valid_env $env] TRUE
append largs " -env $env "
puts "[timestamp]"
if { [info exists parms($test)] != 1 } {
puts stderr "$test disabled in\
testparams.tcl; skipping."
continue
}
eval $test $method $parms($test) $largs
append largs " -encrypt "
eval $test $method $parms($test) $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 -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 $test: $theError"
} else {
error $theError;
}
set is_envmethod 0
}
}
proc run_reptest { method test {droppct 0} {nclients 1} {do_del 0} \
{do_sec 0} {do_oob 0} {largs "" } } {
source ./include.tcl
if { $is_windows9x_test == 1 } {
puts "Skipping replication test on Win 9x platform."
return
}
global __debug_on
global __debug_print
global __debug_test
global is_envmethod
global parms
global passwd
global has_crypto
puts "run_reptest \
$method $test $droppct $nclients $do_del $do_sec $do_oob $largs"
env_cleanup $testdir
set is_envmethod 1
set stat [catch {
if { $do_sec && $has_crypto } {
set envargs "-encryptaes $passwd"
append largs " -encrypt "
} else {
set envargs ""
}
check_handles
set largs [repl_envsetup \
$envargs $largs $test $nclients $droppct $do_oob]
puts "[timestamp]"
if { [info exists parms($test)] != 1 } {
puts stderr "$test disabled in\
testparams.tcl; skipping."
continue
}
puts -nonewline \
"Repl: $test: 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 $test $method $parms($test) $largs
if { $__debug_print != 0 } {
puts ""
}
if { $__debug_on != 0 } {
debug $__debug_test
}
flush stdout
flush stderr
repl_envprocq $test $nclients $do_oob
repl_envver0 $test $method $nclients
if { $do_del } {
repl_verdel $test $method $nclients
}
repl_envclose $test $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 $test: $theError"
} else {
error $theError;
}
}
set is_envmethod 0
}
proc run_repmethod { method test {numcl 0} {display 0} {run 1} \
{outfile stdout} {largs ""} } {
source ./include.tcl
if { $is_windows9x_test == 1 } {
puts "Skipping replication test on Win 9x platform."
return
}
global __debug_on
global __debug_print
global __debug_test
global is_envmethod
global test_names
global parms
global has_crypto
global passwd
set save_largs $largs
env_cleanup $testdir
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]
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]
if { $is_windows_test == 1 } {
set droppct 0
}
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 { $display == 1 } {
puts $outfile "eval run_reptest $method $test $droppct \
$nclients $do_del $do_sec $do_oob $largs"
}
if { $run == 1 } {
run_reptest $method $test $droppct $nclients $do_del \
$do_sec $do_oob $largs
}
}
proc run_envmethod { method test {display 0} {run 1} {outfile stdout} \
{ largs "" } } {
global __debug_on
global __debug_print
global __debug_test
global is_envmethod
global test_names
global parms
source ./include.tcl
set save_largs $largs
set envargs ""
set logargs " -log_regionmax 2057152 "
set cacheargs "-cachesize {0 4194304 1}"
env_cleanup $testdir
if { $display == 1 } {
puts $outfile "eval run_envmethod $method \
$test 0 1 stdout $largs"
}
set sindex [lsearch -exact $largs "-shm"]
if { $sindex >= 0 } {
if { [mem_chk " -system_mem -shm_key 1 "] == 1 } {
break
} else {
append envargs " -system_mem -shm_key 1 "
set largs [lreplace $largs $sindex $sindex]
}
}
if { [lsearch -exact $largs "-thread"] != -1 } {
append envargs " -thread -lock_max_lockers 2000 "
}
set aindex [lsearch -exact $largs "-alloc"]
if { $aindex >= 0 } {
append envargs " -alloc "
set largs [lreplace $largs $aindex $aindex]
}
set lockargs " -lock_max_locks 40000 -lock_max_objects 20000 "
if { $run == 1 } {
set is_envmethod 1
set stat [catch {
check_handles
set env [eval {berkdb_env -create -txn -mode 0644 \
-home $testdir} $logargs $cacheargs $lockargs $envargs]
error_check_good env_open [is_valid_env $env] TRUE
append largs " -env $env "
puts "[timestamp]"
if { [info exists parms($test)] != 1 } {
puts stderr "$test disabled in\
testparams.tcl; skipping."
continue
}
eval $test $method $parms($test) $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 $test: $theError"
} else {
error $theError;
}
}
set is_envmethod 0
}
}
proc run_recd { method test {run 1} {display 0} args } {
global __debug_on
global __debug_print
global __debug_test
global parms
global test_names
global log_log_record_types
global gen_upgrade_log
global upgrade_be
global upgrade_dir
global upgrade_method
global upgrade_name
source ./include.tcl
if { $run == 1 } {
puts "run_recd: $method $test $parms($test) $args"
}
if {[catch {
if { $display } {
puts "eval $test $method $parms($test) $args"
}
if { $run } {
check_handles
set upgrade_method $method
set upgrade_name $test
puts "[timestamp]"
set ret [catch { exec $tclsh_path << \
"source $test_path/test.tcl; \
set log_log_record_types $log_log_record_types;\
set gen_upgrade_log $gen_upgrade_log;\
set upgrade_be $upgrade_be; \
set upgrade_dir $upgrade_dir; \
set upgrade_method $upgrade_method; \
set upgrade_name $upgrade_name; \
eval $test $method $parms($test) $args" \
>&@ stdout
} res]
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: $theError"
} else {
error $theError;
}
}
}
proc run_recds { {run 1} {display 0} args } {
source ./include.tcl
global log_log_record_types
global test_names
global gen_upgrade_log
global encrypt
global valid_methods
set log_log_record_types 1
logtrack_init
set zero_log_tests \
{recd001 recd002 recd003 recd004 recd005 recd006 recd007}
foreach method $valid_methods {
check_handles
foreach test $test_names(recd) {
if { $gen_upgrade_log == 1 && $test == "recd017" && \
$encrypt == 0 } {
puts "Skipping recd017 for non-crypto run."
continue
}
if { $gen_upgrade_log == 1 && $test != "recd017" && \
$encrypt == 1 } {
puts "Skipping $test for crypto run."
continue
}
if { [catch {eval run_recd $method $test $run \
$display $args} ret ] != 0 } {
puts $ret
}
set zlog_idx [lsearch -exact $zero_log_tests $test]
if { $method == "btree" && $zlog_idx > -1 } {
if { [catch {eval run_recd $method $test \
$run $display -zero_log $args} ret ] != 0 } {
puts $ret
}
}
if { $gen_upgrade_log == 1 } {
save_upgrade_files $testdir
}
}
}
if { $run } {
if { $gen_upgrade_log == 0 || $encrypt == 0 } {
logtrack_summary
}
}
set log_log_record_types 0
}
proc run_all { { testname ALL } args } {
global test_names
global one_test
global has_crypto
global valid_methods
source ./include.tcl
fileremove -f ALL.OUT
set one_test $testname
if { $one_test != "ALL" } {
source $test_path/testparams.tcl
}
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
lappend args -A
eval {run_std} $one_test $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 } {
}
foreach method $valid_methods {
puts "Running $method tests with pagesize $pgsz"
foreach sub {test sdb si} {
foreach test $test_names($sub) {
if { $run == 0 } {
set o [open ALL.OUT a]
eval {run_method -$method \
$test $display $run $o} \
$args
close $o
}
if { $run } {
if [catch {exec $tclsh_path << \
"global one_test; \
set one_test $one_test; \
source $test_path/test.tcl; \
eval {run_method -$method \
$test $display $run \
stdout} $args" \
>>& ALL.OUT } res] {
set o [open ALL.OUT a]
puts $o "FAIL: \
-$method $test: $res"
close $o
}
}
}
}
}
}
set args $save_args
foreach method $valid_methods {
puts "Running $method tests in a txn env"
foreach sub {test sdb si} {
foreach test $test_names($sub) {
if { $run == 0 } {
set o [open ALL.OUT a]
run_envmethod -$method $test $display \
$run $o $args
close $o
}
if { $run } {
if [catch {exec $tclsh_path << \
"global one_test; \
set one_test $one_test; \
source $test_path/test.tcl; \
run_envmethod -$method $test \
$display $run stdout $args" \
>>& ALL.OUT } res] {
set o [open ALL.OUT a]
puts $o "FAIL: run_envmethod \
$method $test: $res"
close $o
}
}
}
}
}
foreach method $valid_methods {
puts "Running $method tests in a threaded txn env"
foreach sub {test sdb si} {
foreach test $test_names($sub) {
if { $run == 0 } {
set o [open ALL.OUT a]
eval {run_envmethod -$method $test \
$display $run $o -thread}
close $o
}
if { $run } {
if [catch {exec $tclsh_path << \
"global one_test; \
set one_test $one_test; \
source $test_path/test.tcl; \
eval {run_envmethod -$method $test \
$display $run stdout -thread}" \
>>& ALL.OUT } res] {
set o [open ALL.OUT a]
puts $o "FAIL: run_envmethod \
$method $test -thread: $res"
close $o
}
}
}
}
}
foreach method $valid_methods {
puts "Running $method tests in an env with -alloc"
foreach sub {test sdb si} {
foreach test $test_names($sub) {
if { $run == 0 } {
set o [open ALL.OUT a]
eval {run_envmethod -$method $test \
$display $run $o -alloc}
close $o
}
if { $run } {
if [catch {exec $tclsh_path << \
"global one_test; \
set one_test $one_test; \
source $test_path/test.tcl; \
eval {run_envmethod -$method $test \
$display $run stdout -alloc}" \
>>& ALL.OUT } res] {
set o [open ALL.OUT a]
puts $o "FAIL: run_envmethod \
$method $test -alloc: $res"
close $o
}
}
}
}
}
set test_list [list {"testNNN under replication" "repmethod"}]
if { $is_freebsd_test == 1 || $is_linux_test == 1 || \
$is_sunos_test == 1 || $is_windows_test == 1 } {
lappend test_list {"big files" "bigfile"}
}
if { $has_crypto == 1 } {
lappend test_list {"testNNN with security" "secmethod"}
}
if { [file exists ./berkeley_db_svc] ||
[file exists ./berkeley_db_cxxsvc] ||
[file exists ./berkeley_db_javasvc] } {
lappend 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 << \
"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 { $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_envmethod1 { method {display 0} {run 1} { outfile stdout } args } {
global __debug_on
global __debug_print
global __debug_test
global is_envmethod
global test_names
global parms
source ./include.tcl
if { $run == 1 } {
puts "run_envmethod1: $method $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 } {
puts $outfile "eval run_envmethod1 $method $args"
}
set stat [catch {
foreach test $test_names(test) {
if { [info exists parms($test)] != 1 } {
puts stderr "$test disabled in\
testparams.tcl; skipping."
continue
}
if { $run } {
puts $outfile "[timestamp]"
eval $test $method $parms($test) $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 $test: $theError"
} else {
error $theError;
}
}
set stat [catch {
foreach test $test_names(test) {
if { [info exists parms($test)] != 1 } {
puts stderr "$test disabled in\
testparams.tcl; skipping."
continue
}
if { $run } {
puts $outfile "[timestamp]"
eval $test $method $parms($test) $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 $test: $theError"
} else {
error $theError;
}
}
if { $run == 1 } {
error_check_good envclose [$env close] 0
check_handles $outfile
}
set is_envmethod 0
}
proc sindex { {display 0} {run 1} {outfile stdout} {verbose 0} args } {
global test_names
global testdir
global verbose_check_secondaries
set verbose_check_secondaries $verbose
global nsecondaries
set nsecondaries 2
foreach n { 200 5000 } {
foreach pm { btree hash recno frecno queue queueext } {
foreach sm { dbtree dhash ddbtree ddhash btree hash } {
foreach test $test_names(si) {
if { $display } {
puts -nonewline $outfile \
"eval $test {\[list\
$pm $sm $sm\]} $n ;"
puts $outfile " verify_dir \
$testdir \"\" 1"
}
if { $run } {
check_handles $outfile
eval $test \
{[list $pm $sm $sm]} $n
verify_dir $testdir "" 1
}
}
}
}
}
foreach pm { btree hash } {
set methlist [list $pm]
for { set j 1 } { $j <= 20 } {incr j} {
if { $j % 2 == 0 } {
lappend methlist "dbtree"
} else {
lappend methlist "ddbtree"
}
}
foreach test $test_names(si) {
if { $display } {
puts "eval $test {\[list $methlist\]} 500"
}
if { $run } {
eval $test {$methlist} 500
}
}
}
}
proc sijoin { {display 0} {run 1} {outfile stdout} } {
foreach pm { btree hash recno } {
if { $display } {
foreach sm { btree hash } {
puts $outfile "eval sijointest\
{\[list $pm $sm $sm\]} 1000"
}
puts $outfile "eval sijointest\
{\[list $pm btree hash\]} 1000"
puts $outfile "eval sijointest\
{\[list $pm hash btree\]} 1000"
}
if { $run } {
foreach sm { btree hash } {
eval sijointest {[list $pm $sm $sm]} 1000
}
eval sijointest {[list $pm btree hash]} 1000
eval sijointest {[list $pm hash btree]} 1000
}
}
}
proc run { proc_suffix method {start 1} {stop 999} } {
global test_names
switch -exact -- $proc_suffix {
envmethod -
method -
recd -
repmethod -
reptest -
secenv -
secmethod {
if { $proc_suffix == "recd" } {
set testtype recd
} else {
set testtype test
}
for { set i $start } { $i <= $stop } { incr i } {
set name [format "%s%03d" $testtype $i]
if { [lsearch -exact $test_names($testtype) \
$name] == -1 } {
continue
}
run_$proc_suffix $method $name
}
}
default {
puts "$proc_suffix is not set up with to be used with run"
}
}
}
proc get_test_pagesizes { } {
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 65536} }
8192 { return {512 65536} }
65536 { return {512 8192} }
default { return {512 8192 65536} }
}
error_check_good NOTREACHED 0 1
}
proc run_timed_once { timedtest args } {
set start [timestamp -r]
set ret [catch {
eval $timedtest $args
flush stdout
flush stderr
} res]
set stop [timestamp -r]
if { $ret != 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_timed: $timedtest: $theError"
} else {
error $theError;
}
}
return [expr $stop - $start]
}
proc run_timed { niter timedtest args } {
if { $niter < 1 } {
error "run_timed: Invalid number of iterations $niter"
}
set sum 0
set e {}
for { set i 1 } { $i <= $niter } { incr i } {
set elapsed [eval run_timed_once $timedtest $args]
lappend e $elapsed
set sum [expr $sum + $elapsed]
puts "Test $timedtest run $i completed: $elapsed seconds"
}
if { $niter > 1 } {
set avg [expr $sum / $niter]
puts "Average $timedtest time: $avg"
puts "Raw $timedtest data: $e"
}
}