proc recd015 { method args } {
source ./include.tcl
global rand_init
error_check_good set_random_seed [berkdb srand $rand_init] 0
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "Recd015: $method ($args) prepared txns test"
set numtxns 1
set testfile NULL
set env_cmd "berkdb_env -create -txn -home $testdir"
set msg "\tRecd015.a"
foreach op { abort commit discard } {
puts "$msg: Simple test to prepare $numtxns txn with $op "
env_cleanup $testdir
recd015_body $env_cmd $testfile $numtxns $msg $op
}
set numtxns 10000
set testfile recd015.db
set txnmax [expr $numtxns + 5]
env_cleanup $testdir
set env_cmd "berkdb_env -create -txn_max \
$txnmax -lock_max_lockers $txnmax -txn -home $testdir"
set env [eval $env_cmd]
error_check_good dbenv [is_valid_env $env] TRUE
set db [eval {berkdb_open -create} $omethod -env $env $args $testfile]
error_check_good dbopen [is_valid_db $db] TRUE
error_check_good dbclose [$db close] 0
error_check_good envclose [$env close] 0
set msg "\tRecd015.b"
foreach op { abort commit discard } {
puts "$msg: Large test to prepare $numtxns txn with $op"
recd015_body $env_cmd $testfile $numtxns $msg $op
}
set stat [catch {exec $util_path/db_printlog -h $testdir \
> $testdir/LOG } ret]
error_check_good db_printlog $stat 0
fileremove $testdir/LOG
}
proc recd015_body { env_cmd testfile numtxns msg op } {
source ./include.tcl
sentinel_init
set gidf $testdir/gidfile
fileremove -f $gidf
set pidlist {}
puts "$msg.0: Executing child script to prepare txns"
berkdb debug_check
set p [exec $tclsh_path $test_path/wrap.tcl recd15scr.tcl \
$testdir/recdout $env_cmd $testfile $gidf $numtxns &]
lappend pidlist $p
watch_procs $pidlist 5
set f1 [open $testdir/recdout r]
set r [read $f1]
puts $r
close $f1
fileremove -f $testdir/recdout
berkdb debug_check
puts -nonewline "$msg.1: Running recovery ... "
flush stdout
berkdb debug_check
set env [eval $env_cmd -recover]
error_check_good dbenv-recover [is_valid_env $env] TRUE
puts "complete"
puts "$msg.2: getting txns from txn_recover"
set txnlist [$env txn_recover]
error_check_good txnlist_len [llength $txnlist] $numtxns
set gfd [open $gidf r]
set i 0
while { [gets $gfd gid] != -1 } {
set gids($i) $gid
incr i
}
close $gfd
error_check_good num_gids $i $numtxns
set i 0
puts "$msg.3: comparing GIDs and $op txns"
foreach tpair $txnlist {
set txn [lindex $tpair 0]
set gid [lindex $tpair 1]
error_check_good gidcompare $gid $gids($i)
error_check_good txn:$op [$txn $op] 0
incr i
}
if { $op != "discard" } {
error_check_good envclose [$env close] 0
return
}
puts "$msg.4: resolving/discarding txns"
set txnlist [$env txn_recover]
set len [llength $txnlist]
set opval(1) "abort"
set opcnt(1) 0
set opval(2) "commit"
set opcnt(2) 0
set opval(3) "discard"
set opcnt(3) 0
while { $len != 0 } {
set opicnt(1) 0
set opicnt(2) 0
set opicnt(3) 0
for { set i 0 } { $i < $len } { incr i } {
set t [lindex $txnlist $i]
set txn [lindex $t 0]
set newop [berkdb random_int 1 3]
set ret [$txn $opval($newop)]
error_check_good txn_$opval($newop):$i $ret 0
incr opcnt($newop)
incr opicnt($newop)
}
set txnlist [$env txn_recover]
set len [llength $txnlist]
}
error_check_good envclose [$env close] 0
}