1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996-2009 Oracle. All rights reserved. 4# 5# $Id$ 6# 7# TEST recd008 8# TEST Test deeply nested transactions and many-child transactions. 9proc recd008 { method {breadth 4} {depth 4} args} { 10 global kvals 11 source ./include.tcl 12 13 set args [convert_args $method $args] 14 set omethod [convert_method $method] 15 16 puts "Recd008: $method $breadth X $depth deeply nested transactions" 17 18 # Create the database and environment. 19 env_cleanup $testdir 20 21 set dbfile recd008.db 22 23 puts "\tRecd008.a: create database" 24 set db [eval {berkdb_open -create} $args $omethod $testdir/$dbfile] 25 error_check_good dbopen [is_valid_db $db] TRUE 26 27 # Make sure that we have enough entries to span a couple of 28 # different pages. 29 set did [open $dict] 30 set count 0 31 while { [gets $did str] != -1 && $count < 1000 } { 32 if { [is_record_based $method] == 1 } { 33 set key [expr $count + 1] 34 } else { 35 set key $str 36 } 37 if { $count == 500} { 38 set p1 $key 39 set kvals($p1) $str 40 } 41 set ret [$db put $key [chop_data $method $str]] 42 error_check_good put $ret 0 43 44 incr count 45 } 46 close $did 47 error_check_good db_close [$db close] 0 48 49 set txn_max [expr int([expr pow($breadth,$depth)])] 50 if { $txn_max < 20 } { 51 set txn_max 20 52 } 53 54 puts "\tRecd008.b: create environment for $txn_max transactions" 55 56 set max_locks 2500 57 set eflags "-mode 0644 -create -lock_max_locks $max_locks \ 58 -lock_max_objects $max_locks -txn_max $txn_max -txn -home $testdir" 59 set env_cmd "berkdb_env $eflags" 60 set dbenv [eval $env_cmd] 61 error_check_good env_open [is_valid_env $dbenv] TRUE 62 63 reset_env $dbenv 64 65 set rlist { 66 { {recd008_parent abort ENV DB $method $p1 TXNID 1 1 $breadth $depth} 67 "Recd008.c: child abort parent" } 68 { {recd008_parent commit ENV DB $method $p1 TXNID 1 1 $breadth $depth} 69 "Recd008.d: child commit parent" } 70 } 71 foreach pair $rlist { 72 set cmd [subst [lindex $pair 0]] 73 set msg [lindex $pair 1] 74 op_recover abort $testdir $env_cmd $dbfile $cmd $msg $args 75 eval recd008_setkval $dbfile $p1 $args 76 op_recover commit $testdir $env_cmd $dbfile $cmd $msg $args 77 eval recd008_setkval $dbfile $p1 $args 78 } 79 80 puts "\tRecd008.e: Verify db_printlog can read logfile" 81 set tmpfile $testdir/printlog.out 82 set stat [catch {exec $util_path/db_printlog -h $testdir \ 83 > $tmpfile} ret] 84 error_check_good db_printlog $stat 0 85 fileremove $tmpfile 86} 87 88proc recd008_setkval { dbfile p1 args} { 89 global kvals 90 source ./include.tcl 91 92 set db [eval {berkdb_open} $args $testdir/$dbfile] 93 error_check_good dbopen [is_valid_db $db] TRUE 94 set ret [$db get $p1] 95 error_check_good dbclose [$db close] 0 96 set kvals($p1) [lindex [lindex $ret 0] 1] 97} 98 99# This is a lot like the op_recover procedure. We cannot use that 100# because it was not meant to be called recursively. This proc 101# knows about depth/breadth and file naming so that recursive calls 102# don't overwrite various initial and afterop files, etc. 103# 104# The basic flow of this is: 105# (Initial file) 106# Parent begin transaction (in op_recover) 107# Parent starts children 108# Recursively call recd008_recover 109# (children modify p1) 110# Parent modifies p1 111# (Afterop file) 112# Parent commit/abort (in op_recover) 113# (Final file) 114# Recovery test (in op_recover) 115proc recd008_parent { op env db method p1key parent b0 d0 breadth depth } { 116 global kvals 117 source ./include.tcl 118 119 # 120 # Save copy of original data 121 # Acquire lock on data 122 # 123 set olddata [pad_data $method $kvals($p1key)] 124 set ret [$db get -rmw -txn $parent $p1key] 125 set Dret [lindex [lindex $ret 0] 1] 126 error_check_good get_parent_RMW $Dret $olddata 127 128 # 129 # Parent spawns off children 130 # 131 set ret [recd008_txn $op $env $db $method $p1key $parent \ 132 $b0 $d0 $breadth $depth] 133 134 puts "Child runs complete. Parent modifies data." 135 136 # 137 # Parent modifies p1 138 # 139 set newdata $olddata.parent 140 set ret [$db put -txn $parent $p1key [chop_data $method $newdata]] 141 error_check_good db_put $ret 0 142 143 # 144 # Save value in kvals for later comparison 145 # 146 switch $op { 147 "commit" { 148 set kvals($p1key) $newdata 149 } 150 "abort" { 151 set kvals($p1key) $olddata 152 } 153 } 154 return 0 155} 156 157proc recd008_txn { op env db method p1key parent b0 d0 breadth depth } { 158 global log_log_record_types 159 global kvals 160 source ./include.tcl 161 162 for {set d 1} {$d < $d0} {incr d} { 163 puts -nonewline "\t" 164 } 165 puts "Recd008_txn: $op parent:$parent $breadth $depth ($b0 $d0)" 166 167 # Save the initial file and open the environment and the file 168 for {set b $b0} {$b <= $breadth} {incr b} { 169 # 170 # Begin child transaction 171 # 172 set t [$env txn -parent $parent] 173 error_check_bad txn_begin $t NULL 174 error_check_good txn_begin [is_valid_txn $t $env] TRUE 175 set startd [expr $d0 + 1] 176 set child $b:$startd:$t 177 set olddata [pad_data $method $kvals($p1key)] 178 set newdata $olddata.$child 179 set ret [$db get -rmw -txn $t $p1key] 180 set Dret [lindex [lindex $ret 0] 1] 181 error_check_good get_parent_RMW $Dret $olddata 182 183 # 184 # Recursively call to set up nested transactions/children 185 # 186 for {set d $startd} {$d <= $depth} {incr d} { 187 set ret [recd008_txn commit $env $db $method $p1key $t \ 188 $b $d $breadth $depth] 189 set ret [recd008_txn abort $env $db $method $p1key $t \ 190 $b $d $breadth $depth] 191 } 192 # 193 # Modifies p1. 194 # 195 set ret [$db put -txn $t $p1key [chop_data $method $newdata]] 196 error_check_good db_put $ret 0 197 198 # 199 # Commit or abort 200 # 201 for {set d 1} {$d < $startd} {incr d} { 202 puts -nonewline "\t" 203 } 204 puts "Executing txn_$op:$t" 205 error_check_good txn_$op:$t [$t $op] 0 206 for {set d 1} {$d < $startd} {incr d} { 207 puts -nonewline "\t" 208 } 209 set ret [$db get -rmw -txn $parent $p1key] 210 set Dret [lindex [lindex $ret 0] 1] 211 set newdata [pad_data $method $newdata] 212 switch $op { 213 "commit" { 214 puts "Command executed and committed." 215 error_check_good get_parent_RMW $Dret $newdata 216 set kvals($p1key) $newdata 217 } 218 "abort" { 219 puts "Command executed and aborted." 220 error_check_good get_parent_RMW $Dret $olddata 221 set kvals($p1key) $olddata 222 } 223 } 224 } 225 return 0 226} 227