diff options
Diffstat (limited to 'bdb/test/recd015.tcl')
| -rw-r--r-- | bdb/test/recd015.tcl | 160 |
1 files changed, 160 insertions, 0 deletions
diff --git a/bdb/test/recd015.tcl b/bdb/test/recd015.tcl new file mode 100644 index 00000000000..8c3ad612419 --- /dev/null +++ b/bdb/test/recd015.tcl @@ -0,0 +1,160 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999-2002 +# Sleepycat Software. All rights reserved. +# +# $Id: recd015.tcl,v 1.13 2002/09/05 17:23:06 sandstro Exp $ +# +# TEST recd015 +# TEST This is a recovery test for testing lots of prepared txns. +# TEST This test is to force the use of txn_recover to call with the +# TEST DB_FIRST flag and then DB_NEXT. +proc recd015 { method args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Recd015: $method ($args) prepared txns test" + + # Create the database and environment. + + set numtxns 1 + set testfile NULL + + set env_cmd "berkdb_env -create -txn -home $testdir" + set msg "\tRecd015.a" + puts "$msg Simple test to prepare $numtxns txn " + foreach op { abort commit discard } { + env_cleanup $testdir + recd015_body $env_cmd $testfile $numtxns $msg $op + } + + # + # Now test large numbers of prepared txns to test DB_NEXT + # on txn_recover. + # + set numtxns 250 + set testfile recd015.db + set txnmax [expr $numtxns + 5] + # + # For this test we create our database ahead of time so that we + # don't need to send methods and args to the script. + # + env_cleanup $testdir + set env_cmd "berkdb_env -create -txn_max $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" + puts "$msg Large test to prepare $numtxns txn " + foreach op { abort commit discard } { + 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 + # + # Make sure we have as many as we expect + 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 + } + # + # If we discarded, now do it again and randomly resolve some + # until all txns are resolved. + # + 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 + # + # Abort/commit or discard them randomly until + # all are resolved. + # + 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) + } +# puts "$opval(1): $opicnt(1) Total: $opcnt(1)" +# puts "$opval(2): $opicnt(2) Total: $opcnt(2)" +# puts "$opval(3): $opicnt(3) Total: $opcnt(3)" + + set txnlist [$env txn_recover] + set len [llength $txnlist] + } + + error_check_good envclose [$env close] 0 +} |