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"
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
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]
}
proc recd008_parent { op env db p1key parent b0 d0 breadth depth } {
global kvals
source ./include.tcl
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
set ret [recd008_txn $op $env $db $p1key $parent \
$b0 $d0 $breadth $depth]
puts "Child runs complete. Parent modifies data."
set newdata $olddata.parent
set ret [$db put -txn $parent $p1key $newdata]
error_check_good db_put $ret 0
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)"
for {set b $b0} {$b <= $breadth} {incr b} {
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
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]
}
set ret [$db put -txn $t $p1key $newdata]
error_check_good db_put $ret 0
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
}