proc txn014 { } {
source ./include.tcl
set tnum "014"
puts "Txn$tnum: Test use of parent and child txns."
set parentfile test$tnum.db
set nonparentfile test$tnum.db.2
set method "-btree"
set nentries 5000
env_cleanup $testdir
puts "\tTxn$tnum.a: Create environment."
set eflags "-create -mode 0644 -txn -home $testdir"
set env [eval {berkdb_env_noerr} $eflags]
error_check_good env [is_valid_env $env] TRUE
puts "\tTxn$tnum.b: Start parent txn and open database."
set parent [$env txn]
error_check_good parent_begin [is_valid_txn $parent $env] TRUE
set db [berkdb_open_noerr \
-env $env -txn $parent -create $method $parentfile]
populate $db $method $parent $nentries 0 0
puts "\tTxn$tnum.c: Start non-parent txn and open database."
set nonparent [$env txn]
error_check_good nonparent_begin [is_valid_txn $nonparent $env] TRUE
set db2 [berkdb_open_noerr \
-env $env -txn $nonparent -create $method $nonparentfile]
populate $db2 $method $nonparent $nentries 0 0
puts "\tTxn$tnum.d: Start child txn."
set child [$env txn -parent $parent]
puts "\tTxn$tnum.e: Verify parent is disabled."
catch {$db put -txn $parent a a} ret
error_check_good \
parent_disabled [is_substr $ret "Child transaction is active"] 1
puts "\tTxn$tnum.f: Get a handle on parent's database using child txn."
set childdb \
[berkdb_open_noerr -env $env -txn $child $method $parentfile]
puts "\tTxn$tnum.g: Read database with child txn/child handle,"
puts "\tTxn$tnum.g: and with child txn/parent handle."
set did [open $dict]
set count 0
while { [gets $did str] != -1 && $count < $nentries } {
set key $str
set ret [$childdb get -txn $child $key]
error_check_good \
get $ret [list [list $key [pad_data $method $str]]]
set ret [$db get -txn $child $key]
error_check_good \
get $ret [list [list $key [pad_data $method $str]]]
incr count
}
close $did
puts "\tTxn$tnum.h: Child cannot read data from non-parent."
set ret [$db2 get -txn $nonparent $key]
error_check_good \
np_get $ret [list [list $key [pad_data $method $key]]]
catch {$db2 get -txn $child $key} ret
error_check_good \
child_np_get [is_substr $ret "is still active"] 1
puts "\tTxn$tnum.i: Write to database with child txn & child handle."
populate $childdb $method $child $nentries 0 0
puts "\tTxn$tnum.j: Write to database with child txn & parent handle."
populate $db $method $child $nentries 0 0
puts "\tTxn$tnum.k: Commit child, freeing parent."
error_check_good child_commit [$child commit] 0
error_check_good childdb_close [$childdb close] 0
puts "\tTxn$tnum.l: Add more entries to db using parent txn."
set nentries [expr $nentries * 2]
populate $db $method $parent $nentries 0 0
puts "\tTxn$tnum.m: Start new child txn and read database."
set child2 [$env txn -parent $parent]
set child2db \
[berkdb_open_noerr -env $env -txn $child2 $method $parentfile]
set did [open $dict]
set count 0
while { [gets $did str] != -1 && $count < $nentries } {
set key $str
set ret [$child2db get -txn $child2 $key]
error_check_good \
get $ret [list [list $key [pad_data $method $str]]] 1
incr count
}
close $did
puts "\tTxn$tnum.n: Clean up."
error_check_good child2_commit [$child2 commit] 0
error_check_good nonparent_commit [$nonparent commit] 0
error_check_good parent_commit [$parent commit] 0
error_check_good db_close [$db close] 0
error_check_good db2_close [$db2 close] 0
error_check_good childdb_close [$child2db close] 0
error_check_good env_close [$env close] 0
}