diff options
Diffstat (limited to 'bdb/test/recd006.tcl')
| -rw-r--r-- | bdb/test/recd006.tcl | 262 |
1 files changed, 0 insertions, 262 deletions
diff --git a/bdb/test/recd006.tcl b/bdb/test/recd006.tcl deleted file mode 100644 index fc35e755b08..00000000000 --- a/bdb/test/recd006.tcl +++ /dev/null @@ -1,262 +0,0 @@ -# See the file LICENSE for redistribution information. -# -# Copyright (c) 1996-2002 -# Sleepycat Software. All rights reserved. -# -# $Id: recd006.tcl,v 11.26 2002/03/15 16:30:53 sue Exp $ -# -# TEST recd006 -# TEST Nested transactions. -proc recd006 { method {select 0} args} { - global kvals - source ./include.tcl - - set args [convert_args $method $args] - set omethod [convert_method $method] - - if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { - puts "Recd006 skipping for method $method" - return - } - puts "Recd006: $method nested transactions" - - # Create the database and environment. - env_cleanup $testdir - - set dbfile recd006.db - set testfile $testdir/$dbfile - - puts "\tRecd006.a: create database" - set oflags "-create $args $omethod $testfile" - set db [eval {berkdb_open} $oflags] - error_check_good dbopen [is_valid_db $db] TRUE - - # Make sure that we have enough entries to span a couple of - # different pages. - set did [open $dict] - set count 0 - while { [gets $did str] != -1 && $count < 1000 } { - if { [string compare $omethod "-recno"] == 0 } { - set key [expr $count + 1] - } else { - set key $str - } - - set ret [$db put -nooverwrite $key $str] - error_check_good put $ret 0 - - incr count - } - close $did - - # Variables used below: - # p1: a pair of keys that are likely to be on the same page. - # p2: a pair of keys that are likely to be on the same page, - # but on a page different than those in p1. - set dbc [$db cursor] - error_check_good dbc [is_substr $dbc $db] 1 - - set ret [$dbc get -first] - error_check_bad dbc_get:DB_FIRST [llength $ret] 0 - set p1 [lindex [lindex $ret 0] 0] - set kvals($p1) [lindex [lindex $ret 0] 1] - - set ret [$dbc get -next] - error_check_bad dbc_get:DB_NEXT [llength $ret] 0 - lappend p1 [lindex [lindex $ret 0] 0] - set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1] - - set ret [$dbc get -last] - error_check_bad dbc_get:DB_LAST [llength $ret] 0 - set p2 [lindex [lindex $ret 0] 0] - set kvals($p2) [lindex [lindex $ret 0] 1] - - set ret [$dbc get -prev] - error_check_bad dbc_get:DB_PREV [llength $ret] 0 - lappend p2 [lindex [lindex $ret 0] 0] - set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1] - - error_check_good dbc_close [$dbc close] 0 - error_check_good db_close [$db close] 0 - - # Now create the full transaction environment. - set eflags "-create -txn -home $testdir" - - puts "\tRecd006.b: creating environment" - set env_cmd "berkdb_env $eflags" - set dbenv [eval $env_cmd] - error_check_bad dbenv $dbenv NULL - - # Reset the environment. - reset_env $dbenv - - set p1 [list $p1] - set p2 [list $p2] - - # List of recovery tests: {CMD MSG} pairs - set rlist { - { {nesttest DB TXNID ENV 1 $p1 $p2 commit commit} - "Recd006.c: children (commit commit)"} - { {nesttest DB TXNID ENV 0 $p1 $p2 commit commit} - "Recd006.d: children (commit commit)"} - { {nesttest DB TXNID ENV 1 $p1 $p2 commit abort} - "Recd006.e: children (commit abort)"} - { {nesttest DB TXNID ENV 0 $p1 $p2 commit abort} - "Recd006.f: children (commit abort)"} - { {nesttest DB TXNID ENV 1 $p1 $p2 abort abort} - "Recd006.g: children (abort abort)"} - { {nesttest DB TXNID ENV 0 $p1 $p2 abort abort} - "Recd006.h: children (abort abort)"} - { {nesttest DB TXNID ENV 1 $p1 $p2 abort commit} - "Recd006.i: children (abort commit)"} - { {nesttest DB TXNID ENV 0 $p1 $p2 abort commit} - "Recd006.j: children (abort commit)"} - } - - foreach pair $rlist { - set cmd [subst [lindex $pair 0]] - set msg [lindex $pair 1] - if { $select != 0 } { - set tag [lindex $msg 0] - set tail [expr [string length $tag] - 2] - set tag [string range $tag $tail $tail] - if { [lsearch $select $tag] == -1 } { - continue - } - } - op_recover abort $testdir $env_cmd $dbfile $cmd $msg - op_recover commit $testdir $env_cmd $dbfile $cmd $msg - } - - puts "\tRecd006.k: Verify db_printlog can read logfile" - set tmpfile $testdir/printlog.out - set stat [catch {exec $util_path/db_printlog -h $testdir \ - > $tmpfile} ret] - error_check_good db_printlog $stat 0 - fileremove $tmpfile -} - -# Do the nested transaction test. -# We want to make sure that children inherit properly from their -# parents and that locks are properly handed back to parents -# and that the right thing happens on commit/abort. -# In particular: -# Write lock on parent, properly acquired by child. -# Committed operation on child gives lock to parent so that -# other child can also get the lock. -# Aborted op by child releases lock so other child can get it. -# Correct database state if child commits -# Correct database state if child aborts -proc nesttest { db parent env do p1 p2 child1 child2} { - global kvals - source ./include.tcl - - if { $do == 1 } { - set func toupper - } else { - set func tolower - } - - # Do an RMW on the parent to get a write lock. - set p10 [lindex $p1 0] - set p11 [lindex $p1 1] - set p20 [lindex $p2 0] - set p21 [lindex $p2 1] - - set ret [$db get -rmw -txn $parent $p10] - set res $ret - set Dret [lindex [lindex $ret 0] 1] - if { [string compare $Dret $kvals($p10)] == 0 || - [string compare $Dret [string toupper $kvals($p10)]] == 0 } { - set val 0 - } else { - set val $Dret - } - error_check_good get_parent_RMW $val 0 - - # OK, do child 1 - set kid1 [$env txn -parent $parent] - error_check_good kid1 [is_valid_txn $kid1 $env] TRUE - - # Reading write-locked parent object should be OK - #puts "\tRead write-locked parent object for kid1." - set ret [$db get -txn $kid1 $p10] - error_check_good kid1_get10 $ret $res - - # Now update this child - set data [lindex [lindex [string $func $ret] 0] 1] - set ret [$db put -txn $kid1 $p10 $data] - error_check_good kid1_put10 $ret 0 - - #puts "\tKid1 successful put." - - # Now start child2 - #puts "\tBegin txn for kid2." - set kid2 [$env txn -parent $parent] - error_check_good kid2 [is_valid_txn $kid2 $env] TRUE - - # Getting anything in the p1 set should deadlock, so let's - # work on the p2 set. - set data [string $func $kvals($p20)] - #puts "\tPut data for kid2." - set ret [$db put -txn $kid2 $p20 $data] - error_check_good kid2_put20 $ret 0 - - #puts "\tKid2 data put successful." - - # Now let's do the right thing to kid1 - puts -nonewline "\tKid1 $child1..." - if { [string compare $child1 "commit"] == 0 } { - error_check_good kid1_commit [$kid1 commit] 0 - } else { - error_check_good kid1_abort [$kid1 abort] 0 - } - puts "complete" - - # In either case, child2 should now be able to get the - # lock, either because it is inherited by the parent - # (commit) or because it was released (abort). - set data [string $func $kvals($p11)] - set ret [$db put -txn $kid2 $p11 $data] - error_check_good kid2_put11 $ret 0 - - # Now let's do the right thing to kid2 - puts -nonewline "\tKid2 $child2..." - if { [string compare $child2 "commit"] == 0 } { - error_check_good kid2_commit [$kid2 commit] 0 - } else { - error_check_good kid2_abort [$kid2 abort] 0 - } - puts "complete" - - # Now, let parent check that the right things happened. - # First get all four values - set p10_check [lindex [lindex [$db get -txn $parent $p10] 0] 0] - set p11_check [lindex [lindex [$db get -txn $parent $p11] 0] 0] - set p20_check [lindex [lindex [$db get -txn $parent $p20] 0] 0] - set p21_check [lindex [lindex [$db get -txn $parent $p21] 0] 0] - - if { [string compare $child1 "commit"] == 0 } { - error_check_good parent_kid1 $p10_check \ - [string tolower [string $func $kvals($p10)]] - } else { - error_check_good \ - parent_kid1 $p10_check [string tolower $kvals($p10)] - } - if { [string compare $child2 "commit"] == 0 } { - error_check_good parent_kid2 $p11_check \ - [string tolower [string $func $kvals($p11)]] - error_check_good parent_kid2 $p20_check \ - [string tolower [string $func $kvals($p20)]] - } else { - error_check_good parent_kid2 $p11_check $kvals($p11) - error_check_good parent_kid2 $p20_check $kvals($p20) - } - - # Now do a write on the parent for 21 whose lock it should - # either have or should be available. - set ret [$db put -txn $parent $p21 [string $func $kvals($p21)]] - error_check_good parent_put21 $ret 0 - - return 0 -} |