proc test044 { method {nprocs 5} {nfiles 10} {cont 0} args } {
source ./include.tcl
global encrypt
global rand_init
set args [convert_args $method $args]
set omethod [convert_method $method]
berkdb srand $rand_init
set eindex [lsearch -exact $args "-env"]
if { $eindex != -1 } {
incr eindex
set env [lindex $args $eindex]
puts "Test044 skipping for env $env"
return
}
if { $encrypt != 0 } {
puts "Test044 skipping for security"
return
}
puts "Test044: system integration test db $method $nprocs processes \
on $nfiles files"
set otherargs ""
set key_avg 10
set data_avg 20
set do_exit 0
for { set i 0 } { $i < [llength $args] } {incr i} {
switch -regexp -- [lindex $args $i] {
-key_avg { incr i; set key_avg [lindex $args $i] }
-data_avg { incr i; set data_avg [lindex $args $i] }
-testdir { incr i; set testdir [lindex $args $i] }
-x.* { set do_exit 1 }
default {
lappend otherargs [lindex $args $i]
}
}
}
if { $cont == 0 } {
env_cleanup $testdir
puts "\tTest044.a: creating environment and $nfiles files"
set dbenv [berkdb_env -create -txn -home $testdir]
error_check_good env_open [is_valid_env $dbenv] TRUE
set m $method
for { set i 0 } { $i < $nfiles } { incr i } {
if { $method == "all" } {
switch [berkdb random_int 1 2] {
1 { set m -btree }
2 { set m -hash }
}
} else {
set m $omethod
}
set db [eval {berkdb_open -env $dbenv -create \
-mode 0644 $m} $otherargs {test044.$i.db}]
error_check_good dbopen [is_valid_db $db] TRUE
error_check_good db_close [$db close] 0
}
}
$dbenv close
if { $do_exit == 1 } {
return
}
puts "\tTest044.b: forking off $nprocs processes and utilities"
set cycle 1
set ncycles 3
while { $cycle <= $ncycles } {
set dbenv [berkdb_env -create -txn -home $testdir]
error_check_good env_open [is_valid_env $dbenv] TRUE
puts "Beginning cycle $cycle"
set ddpid [exec $util_path/db_deadlock -h $testdir -t 5 &]
set cppid [exec $util_path/db_checkpoint -h $testdir -p 2 &]
puts "Deadlock detector: $ddpid Checkpoint daemon $cppid"
set pidlist {}
for { set i 0 } {$i < $nprocs} {incr i} {
set p [exec $tclsh_path \
$test_path/sysscript.tcl $testdir \
$nfiles $key_avg $data_avg $omethod \
>& $testdir/test044.$i.log &]
lappend pidlist $p
}
set sleep [berkdb random_int 300 600]
puts \
"[timestamp] $nprocs processes running $pidlist for $sleep seconds"
tclsleep $sleep
puts "[timestamp] Crashing"
error_check_good env_close [$dbenv close] 0
tclkill $ddpid
tclkill $cppid
foreach p $pidlist {
tclkill $p
}
set errstrings [eval findfail [glob $testdir/test044.*.log]]
foreach str $errstrings {
puts "FAIL: error message in log file: $str"
}
test044_verify $testdir $nfiles
incr cycle
}
}
proc test044_usage { } {
puts -nonewline "test044 method nentries [-d directory] [-i iterations]"
puts " [-p procs] -x"
}
proc test044_verify { dir nfiles } {
source ./include.tcl
puts "\tTest044.verify: Running recovery and verifying file contents"
set stat [catch {exec $util_path/db_recover -h $dir} result]
if { $stat == 1 } {
error "FAIL: Recovery error: $result."
}
for { set f 0 } { $f < $nfiles } { incr f } {
set db($f) [berkdb_open $dir/test044.$f.db]
error_check_good $f:dbopen [is_valid_db $db($f)] TRUE
set cursors($f) [$db($f) cursor]
error_check_bad $f:cursor_open $cursors($f) NULL
error_check_good \
$f:cursor_open [is_substr $cursors($f) $db($f)] 1
}
for { set f 0 } { $f < $nfiles } { incr f } {
for {set d [$cursors($f) get -first] } \
{ [string length $d] != 0 } \
{ set d [$cursors($f) get -next] } {
set k [lindex [lindex $d 0] 0]
set d [lindex [lindex $d 0] 1]
set flist [zero_list $nfiles]
set r $d
while { [set ndx [string first : $r]] != -1 } {
set fnum [string range $r 0 [expr $ndx - 1]]
if { [lindex $flist $fnum] == 0 } {
set fl "-set"
} else {
set fl "-next"
}
if { $fl != "-set" || $fnum != $f } {
if { [string compare $fl "-set"] == 0} {
set full [$cursors($fnum) \
get -set $k]
} else {
set full [$cursors($fnum) \
get -next]
}
set key [lindex [lindex $full 0] 0]
set rec [lindex [lindex $full 0] 1]
error_check_good \
$f:dbget_$fnum:key $key $k
error_check_good \
$f:dbget_$fnum:data $rec $d
}
set flist [lreplace $flist $fnum $fnum 1]
incr ndx
set r [string range $r $ndx end]
}
}
}
for { set f 0 } { $f < $nfiles } { incr f } {
error_check_good $cursors($f) [$cursors($f) close] 0
error_check_good db_close:$f [$db($f) close] 0
}
}