1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: recd006.tcl,v 12.8 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST recd006 8# TEST Nested transactions. 9proc recd006 { method {select 0} args } { 10 global kvals 11 source ./include.tcl 12 13 set envargs "" 14 set zero_idx [lsearch -exact $args "-zero_log"] 15 if { $zero_idx != -1 } { 16 set args [lreplace $args $zero_idx $zero_idx] 17 set envargs "-zero_log" 18 } 19 20 set args [convert_args $method $args] 21 set omethod [convert_method $method] 22 23 if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { 24 puts "Recd006 skipping for method $method" 25 return 26 } 27 puts "Recd006: $method nested transactions ($envargs)" 28 29 # Create the database and environment. 30 env_cleanup $testdir 31 32 set dbfile recd006.db 33 set testfile $testdir/$dbfile 34 35 puts "\tRecd006.a: create database" 36 set oflags "-create $args $omethod $testfile" 37 set db [eval {berkdb_open} $oflags] 38 error_check_good dbopen [is_valid_db $db] TRUE 39 40 # Make sure that we have enough entries to span a couple of 41 # different pages. 42 set did [open $dict] 43 set count 0 44 while { [gets $did str] != -1 && $count < 1000 } { 45 if { [string compare $omethod "-recno"] == 0 } { 46 set key [expr $count + 1] 47 } else { 48 set key $str 49 } 50 51 set ret [$db put -nooverwrite $key $str] 52 error_check_good put $ret 0 53 54 incr count 55 } 56 close $did 57 58 # Variables used below: 59 # p1: a pair of keys that are likely to be on the same page. 60 # p2: a pair of keys that are likely to be on the same page, 61 # but on a page different than those in p1. 62 set dbc [$db cursor] 63 error_check_good dbc [is_substr $dbc $db] 1 64 65 set ret [$dbc get -first] 66 error_check_bad dbc_get:DB_FIRST [llength $ret] 0 67 set p1 [lindex [lindex $ret 0] 0] 68 set kvals($p1) [lindex [lindex $ret 0] 1] 69 70 set ret [$dbc get -next] 71 error_check_bad dbc_get:DB_NEXT [llength $ret] 0 72 lappend p1 [lindex [lindex $ret 0] 0] 73 set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1] 74 75 set ret [$dbc get -last] 76 error_check_bad dbc_get:DB_LAST [llength $ret] 0 77 set p2 [lindex [lindex $ret 0] 0] 78 set kvals($p2) [lindex [lindex $ret 0] 1] 79 80 set ret [$dbc get -prev] 81 error_check_bad dbc_get:DB_PREV [llength $ret] 0 82 lappend p2 [lindex [lindex $ret 0] 0] 83 set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1] 84 85 error_check_good dbc_close [$dbc close] 0 86 error_check_good db_close [$db close] 0 87 88 # Now create the full transaction environment. 89 set eflags "-create -txn -home $testdir" 90 91 puts "\tRecd006.b: creating environment" 92 set env_cmd "berkdb_env $eflags" 93 set dbenv [eval $env_cmd] 94 error_check_bad dbenv $dbenv NULL 95 96 # Reset the environment. 97 reset_env $dbenv 98 99 set p1 [list $p1] 100 set p2 [list $p2] 101 102 # List of recovery tests: {CMD MSG} pairs 103 set rlist { 104 { {nesttest DB TXNID ENV 1 $p1 $p2 commit commit} 105 "Recd006.c: children (commit commit)"} 106 { {nesttest DB TXNID ENV 0 $p1 $p2 commit commit} 107 "Recd006.d: children (commit commit)"} 108 { {nesttest DB TXNID ENV 1 $p1 $p2 commit abort} 109 "Recd006.e: children (commit abort)"} 110 { {nesttest DB TXNID ENV 0 $p1 $p2 commit abort} 111 "Recd006.f: children (commit abort)"} 112 { {nesttest DB TXNID ENV 1 $p1 $p2 abort abort} 113 "Recd006.g: children (abort abort)"} 114 { {nesttest DB TXNID ENV 0 $p1 $p2 abort abort} 115 "Recd006.h: children (abort abort)"} 116 { {nesttest DB TXNID ENV 1 $p1 $p2 abort commit} 117 "Recd006.i: children (abort commit)"} 118 { {nesttest DB TXNID ENV 0 $p1 $p2 abort commit} 119 "Recd006.j: children (abort commit)"} 120 } 121 122 foreach pair $rlist { 123 set cmd [subst [lindex $pair 0]] 124 set msg [lindex $pair 1] 125 if { $select != 0 } { 126 set tag [lindex $msg 0] 127 set tail [expr [string length $tag] - 2] 128 set tag [string range $tag $tail $tail] 129 if { [lsearch $select $tag] == -1 } { 130 continue 131 } 132 } 133 op_recover abort $testdir $env_cmd $dbfile $cmd $msg 134 op_recover commit $testdir $env_cmd $dbfile $cmd $msg 135 } 136 137 puts "\tRecd006.k: Verify db_printlog can read logfile" 138 set tmpfile $testdir/printlog.out 139 set stat [catch {exec $util_path/db_printlog -h $testdir \ 140 > $tmpfile} ret] 141 error_check_good db_printlog $stat 0 142 fileremove $tmpfile 143} 144 145# Do the nested transaction test. 146# We want to make sure that children inherit properly from their 147# parents and that locks are properly handed back to parents 148# and that the right thing happens on commit/abort. 149# In particular: 150# Write lock on parent, properly acquired by child. 151# Committed operation on child gives lock to parent so that 152# other child can also get the lock. 153# Aborted op by child releases lock so other child can get it. 154# Correct database state if child commits 155# Correct database state if child aborts 156proc nesttest { db parent env do p1 p2 child1 child2} { 157 global kvals 158 source ./include.tcl 159 160 if { $do == 1 } { 161 set func toupper 162 } else { 163 set func tolower 164 } 165 166 # Do an RMW on the parent to get a write lock. 167 set p10 [lindex $p1 0] 168 set p11 [lindex $p1 1] 169 set p20 [lindex $p2 0] 170 set p21 [lindex $p2 1] 171 172 set ret [$db get -rmw -txn $parent $p10] 173 set res $ret 174 set Dret [lindex [lindex $ret 0] 1] 175 if { [string compare $Dret $kvals($p10)] == 0 || 176 [string compare $Dret [string toupper $kvals($p10)]] == 0 } { 177 set val 0 178 } else { 179 set val $Dret 180 } 181 error_check_good get_parent_RMW $val 0 182 183 # OK, do child 1 184 set kid1 [$env txn -parent $parent] 185 error_check_good kid1 [is_valid_txn $kid1 $env] TRUE 186 187 # Reading write-locked parent object should be OK 188 #puts "\tRead write-locked parent object for kid1." 189 set ret [$db get -txn $kid1 $p10] 190 error_check_good kid1_get10 $ret $res 191 192 # Now update this child 193 set data [lindex [lindex [string $func $ret] 0] 1] 194 set ret [$db put -txn $kid1 $p10 $data] 195 error_check_good kid1_put10 $ret 0 196 197 #puts "\tKid1 successful put." 198 199 # Now start child2 200 #puts "\tBegin txn for kid2." 201 set kid2 [$env txn -parent $parent] 202 error_check_good kid2 [is_valid_txn $kid2 $env] TRUE 203 204 # Getting anything in the p1 set should deadlock, so let's 205 # work on the p2 set. 206 set data [string $func $kvals($p20)] 207 #puts "\tPut data for kid2." 208 set ret [$db put -txn $kid2 $p20 $data] 209 error_check_good kid2_put20 $ret 0 210 211 #puts "\tKid2 data put successful." 212 213 # Now let's do the right thing to kid1 214 puts -nonewline "\tKid1 $child1..." 215 if { [string compare $child1 "commit"] == 0 } { 216 error_check_good kid1_commit [$kid1 commit] 0 217 } else { 218 error_check_good kid1_abort [$kid1 abort] 0 219 } 220 puts "complete" 221 222 # In either case, child2 should now be able to get the 223 # lock, either because it is inherited by the parent 224 # (commit) or because it was released (abort). 225 set data [string $func $kvals($p11)] 226 set ret [$db put -txn $kid2 $p11 $data] 227 error_check_good kid2_put11 $ret 0 228 229 # Now let's do the right thing to kid2 230 puts -nonewline "\tKid2 $child2..." 231 if { [string compare $child2 "commit"] == 0 } { 232 error_check_good kid2_commit [$kid2 commit] 0 233 } else { 234 error_check_good kid2_abort [$kid2 abort] 0 235 } 236 puts "complete" 237 238 # Now, let parent check that the right things happened. 239 # First get all four values 240 set p10_check [lindex [lindex [$db get -txn $parent $p10] 0] 0] 241 set p11_check [lindex [lindex [$db get -txn $parent $p11] 0] 0] 242 set p20_check [lindex [lindex [$db get -txn $parent $p20] 0] 0] 243 set p21_check [lindex [lindex [$db get -txn $parent $p21] 0] 0] 244 245 if { [string compare $child1 "commit"] == 0 } { 246 error_check_good parent_kid1 $p10_check \ 247 [string tolower [string $func $kvals($p10)]] 248 } else { 249 error_check_good \ 250 parent_kid1 $p10_check [string tolower $kvals($p10)] 251 } 252 if { [string compare $child2 "commit"] == 0 } { 253 error_check_good parent_kid2 $p11_check \ 254 [string tolower [string $func $kvals($p11)]] 255 error_check_good parent_kid2 $p20_check \ 256 [string tolower [string $func $kvals($p20)]] 257 } else { 258 error_check_good parent_kid2 $p11_check $kvals($p11) 259 error_check_good parent_kid2 $p20_check $kvals($p20) 260 } 261 262 # Now do a write on the parent for 21 whose lock it should 263 # either have or should be available. 264 set ret [$db put -txn $parent $p21 [string $func $kvals($p21)]] 265 error_check_good parent_put21 $ret 0 266 267 return 0 268} 269