proc sdb012 { method args } {
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
if { [is_queue $method] == 1 } {
puts "Subdb012: skipping for method $method"
return
}
set eindex [lsearch -exact $args "-env"]
if { $eindex != -1 } {
incr eindex
set env [lindex $args $eindex]
puts "Subdb012 skipping for env $env"
return
}
set encargs ""
set largs [split_encargs $args encargs]
puts "Subdb012: $method ($largs $encargs) subdb txn/locking tests"
set count 0
set sdb "Subdb012."
set teststr "abcdefghijklmnopqrstuvwxyz"
set testlet [split $teststr {}]
foreach t1 { none one abort auto commit } {
foreach t2 { none abort auto commit } {
if { $t1 == "one" } {
if { $t2 == "none" || $t2 == "auto"} {
continue
}
}
set tlet [lindex $testlet $count]
foreach r1 { none abort commit } {
foreach r2 { none abort commit } {
set tlist [list $t1 $t2 $r1 $r2]
set nnone [llength \
[lsearch -all $tlist none]]
if { $nnone != 0 && $nnone != 4 } {
continue
}
sdb012_body $testdir $omethod $largs \
$encargs $sdb$tlet $tlist
}
}
incr count
}
}
}
proc s012 { method args } {
source ./include.tcl
set omethod [convert_method $method]
set encargs ""
set largs ""
puts "Subdb012: $method ($largs $encargs) subdb txn/locking tests"
set sdb "Subdb012."
set tlet X
set tlist $args
error_check_good tlist [llength $tlist] 4
sdb012_body $testdir $omethod $largs $encargs $sdb$tlet $tlist
}
proc sdb012_subsys { tlist } {
set t1 [lindex $tlist 0]
set allnone {none none none none}
if { $allnone == $tlist } {
set subsys "-lock"
} else {
set subsys "-txn"
}
return $subsys
}
proc sdb012_tflags { env tlist } {
set ret ""
set t1 ""
foreach t $tlist {
switch $t {
one {
set t1 [$env txn]
error_check_good txnbegin [is_valid_txn $t1 $env] TRUE
lappend ret "-txn $t1"
lappend ret "-txn $t1"
}
auto {
lappend ret "-auto_commit"
}
abort -
commit {
if { $t1 == "" } {
set txn [$env txn]
error_check_good txnbegin [is_valid_txn $txn \
$env] TRUE
lappend ret "-txn $txn"
} else {
set t1 ""
}
}
none {
lappend ret ""
}
default {
error "Txn command $t not implemented"
}
}
}
return $ret
}
proc sdb012_top { tflags tlist } {
set ret ""
set t1 ""
foreach t $tlist tf $tflags {
switch $t {
one {
set t1 [lindex $tf 1]
}
auto {
lappend ret "sdb012_nop"
}
abort -
commit {
if { $t1 == "" } {
set txn [lindex $tf 1]
set top "$txn $t"
lappend ret $top
} else {
set top "$t1 $t"
lappend ret "sdb012_nop"
lappend ret $top
set t1 ""
}
}
none {
lappend ret "sdb012_nop"
}
}
}
return $ret
}
proc sdb012_nop { } {
return 0
}
proc sdb012_isabort { tlist item } {
set i [lindex $tlist $item]
if { $i == "one" } {
set i [lindex $tlist [expr $item + 1]]
}
if { $i == "abort" } {
return 1
} else {
return 0
}
}
proc sdb012_body { testdir omethod largs encargs msg tlist } {
puts "\t$msg: $tlist"
set testfile subdb012.db
set subdb1 sub1
set subdb2 sub2
set subsys [sdb012_subsys $tlist]
env_cleanup $testdir
set env [eval {berkdb_env -create -home} $testdir $subsys $encargs]
error_check_good dbenv [is_valid_env $env] TRUE
error_check_good test_lock [$env test abort subdb_lock] 0
set tflags [sdb012_tflags $env $tlist]
foreach {txn1 txn2 rem1 rem2} $tflags {break}
foreach {top1 top2 rop1 rop2} [sdb012_top $tflags $tlist] {break}
puts "\t$msg.0: Create sub databases in env with $subsys"
set s1 [eval {berkdb_open -env $env -create -mode 0644} \
$largs $txn1 {$omethod $testfile $subdb1}]
error_check_good dbopen [is_valid_db $s1] TRUE
set ret [eval $top1]
error_check_good t1_end $ret 0
set s2 [eval {berkdb_open -env $env -create -mode 0644} \
$largs $txn2 {$omethod $testfile $subdb2}]
error_check_good dbopen [is_valid_db $s2] TRUE
puts "\t$msg.1: Subdbs are open; resolve txns if necessary"
set ret [eval $top2]
error_check_good t2_end $ret 0
set t1_isabort [sdb012_isabort $tlist 0]
set t2_isabort [sdb012_isabort $tlist 1]
set r1_isabort [sdb012_isabort $tlist 2]
set r2_isabort [sdb012_isabort $tlist 3]
puts "\t$msg.2: Subdbs are open; verify removal failures"
set r [ catch {berkdb dbremove -env $env $testfile $subdb1} result ]
error_check_bad dbremove1_open $r 0
if { $t1_isabort } {
error_check_good dbremove1_open_ab [is_substr \
$result "no such file"] 1
} else {
error_check_good dbremove1_open [is_substr \
$result DB_LOCK_NOTGRANTED] 1
}
set r [ catch {berkdb dbremove -env $env $testfile $subdb2} result ]
error_check_bad dbremove2_open $r 0
if { $t2_isabort } {
error_check_good dbremove2_open_ab [is_substr \
$result "no such file"] 1
} else {
error_check_good dbremove2_open [is_substr \
$result DB_LOCK_NOTGRANTED] 1
}
set r [catch {berkdb dbremove -env $env $testfile} result]
error_check_bad dbremovef_open $r 0
if { $t1_isabort && $t2_isabort } {
error_check_good dbremovef_open_ab [is_substr \
$result "no such file"] 1
} else {
error_check_good dbremovef_open [is_substr \
$result DB_LOCK_NOTGRANTED] 1
}
puts "\t$msg.3: Close subdb2; verify removals"
error_check_good close_s2 [$s2 close] 0
set r [ catch {eval {berkdb dbremove -env} \
$env $rem2 $testfile $subdb2} result ]
if { $t2_isabort } {
error_check_bad dbrem2_ab $r 0
error_check_good dbrem2_ab [is_substr \
$result "no such file"] 1
} else {
error_check_good dbrem2 $result 0
}
set r [eval $rop2]
error_check_good rop2 $r 0
set r [ catch {berkdb dbremove -env $env $testfile $subdb1} result ]
error_check_bad dbremove1.2_open $r 0
if { $t1_isabort } {
error_check_good dbremove1.2_open_ab [is_substr \
$result "no such file"] 1
} else {
error_check_good dbremove1.2_open [is_substr \
$result DB_LOCK_NOTGRANTED] 1
}
if { !$t1_isabort || $t2_isabort } {
set r [catch {berkdb dbremove -env $env $testfile} result]
if { $t1_isabort && $t2_isabort } {
error_check_bad dbremovef.2_open $r 0
error_check_good dbremove.2_open_ab [is_substr \
$result "no such file"] 1
} else {
error_check_bad dbremovef.2_open $r 0
error_check_good dbremove.2_open [is_substr \
$result DB_LOCK_NOTGRANTED] 1
}
}
puts "\t$msg.4: Close subdb1; verify removals"
error_check_good close_s1 [$s1 close] 0
set r [ catch {eval {berkdb dbremove -env} \
$env $rem1 $testfile $subdb1} result ]
if { $t1_isabort } {
error_check_bad dbremove1_ab $r 0
error_check_good dbremove1_ab [is_substr \
$result "no such file"] 1
} else {
error_check_good dbremove1 $result 0
}
set r [eval $rop1]
error_check_good rop1 $r 0
set r [ catch {berkdb dbremove -env $env $testfile $subdb2} result ]
if { $r2_isabort && !$t2_isabort } {
error_check_good dbremove2.1_ab $result 0
} else {
error_check_bad dbremove2.1 $r 0
error_check_good dbremove2.1 [is_substr \
$result "no such file"] 1
}
set r [ catch {berkdb dbremove -env $env $testfile $subdb1} result ]
if { $r1_isabort && !$t1_isabort } {
error_check_good dbremove1.1 $result 0
} else {
error_check_bad dbremove_open $r 0
error_check_good dbremove.1 [is_substr \
$result "no such file"] 1
}
puts "\t$msg.5: All closed; remove file"
set r [catch {berkdb dbremove -env $env $testfile} result]
if { $t1_isabort && $t2_isabort } {
error_check_bad dbremove_final_ab $r 0
error_check_good dbremove_file_abstr [is_substr \
$result "no such file"] 1
} else {
error_check_good dbremove_final $r 0
}
error_check_good envclose [$env close] 0
}