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