proc recd006 { method {select 0} args } {
global kvals
source ./include.tcl
set envargs ""
set zero_idx [lsearch -exact $args "-zero_log"]
if { $zero_idx != -1 } {
set args [lreplace $args $zero_idx $zero_idx]
set envargs "-zero_log"
}
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 ($envargs)"
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
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
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
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_env $dbenv
set p1 [list $p1]
set p2 [list $p2]
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
}
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
}
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
set kid1 [$env txn -parent $parent]
error_check_good kid1 [is_valid_txn $kid1 $env] TRUE
set ret [$db get -txn $kid1 $p10]
error_check_good kid1_get10 $ret $res
set data [lindex [lindex [string $func $ret] 0] 1]
set ret [$db put -txn $kid1 $p10 $data]
error_check_good kid1_put10 $ret 0
set kid2 [$env txn -parent $parent]
error_check_good kid2 [is_valid_txn $kid2 $env] TRUE
set data [string $func $kvals($p20)]
set ret [$db put -txn $kid2 $p20 $data]
error_check_good kid2_put20 $ret 0
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"
set data [string $func $kvals($p11)]
set ret [$db put -txn $kid2 $p11 $data]
error_check_good kid2_put11 $ret 0
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"
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)
}
set ret [$db put -txn $parent $p21 [string $func $kvals($p21)]]
error_check_good parent_put21 $ret 0
return 0
}