proc lock005 { } {
source ./include.tcl
puts "Lock005: Page lock release test"
env_cleanup $testdir
set e [berkdb_env -create -lock -home $testdir -txn -log]
error_check_good env_open [is_valid_env $e] TRUE
set db [berkdb open -create -auto_commit -env $e -len 10 -queue q.db]
error_check_good dbopen [is_valid_db $db] TRUE
puts "\tLock005.a: Verify that we are locking"
set txn1 [$e txn -nowait]
error_check_good txn_begin [is_valid_txn $txn1 $e] TRUE
set ret [catch {$db put -txn $txn1 -append record1} recno1]
error_check_good dbput_txn1 $ret 0
set txn2 [$e txn -nowait]
error_check_good txn_begin [is_valid_txn $txn2 $e] TRUE
set ret [catch {$db get -txn $txn2 $recno1} res]
error_check_good dbget_wrong_record \
[is_substr $res "deadlock"] 1
error_check_good txn1commit [$txn1 commit] 0
how_many_locks 1 $e
error_check_good txn2commit [$txn2 commit] 0
how_many_locks 1 $e
puts "\tLock005.b: Verify locks after abort or commit"
foreach endorder {forward reverse} {
end_order_test $db $e commit abort $endorder
end_order_test $db $e abort commit $endorder
end_order_test $db $e commit commit $endorder
end_order_test $db $e abort abort $endorder
}
error_check_good db_close [$db close] 0
error_check_good env_close [$e close] 0
}
proc end_order_test { db e txn1end txn2end endorder } {
set txn1 [$e txn -nowait]
error_check_good txn_begin [is_valid_txn $txn1 $e] TRUE
set ret [catch {$db put -txn $txn1 -append record1} recno1]
error_check_good dbput_txn1 $ret 0
how_many_locks 2 $e
set txn2 [$e txn -nowait]
error_check_good txn_begin [is_valid_txn $txn2 $e] TRUE
set ret [catch {$db put -txn $txn2 -append record2} recno2]
error_check_good dbput_txn2 $ret 0
how_many_locks 3 $e
if {$endorder == "forward"} {
puts "\tLock005.b.1: $txn1end txn1 then $txn2end txn2"
error_check_good txn_$txn1end [$txn1 $txn1end] 0
how_many_locks 2 $e
set ret1 [catch {$db get -txn $txn2 $recno1} res1]
set ret2 [catch {$db get -txn $txn2 $recno2} res2]
if { $txn1end == "commit" } {
error_check_good txn2_sees_txn1 $ret1 0
error_check_good txn2_sees_txn2 $ret2 0
} else {
error_check_good txn2_cantsee_txn1 [llength $res1] 0
}
error_check_good txn_$txn2end [$txn2 $txn2end] 0
how_many_locks 1 $e
set ret3 [catch {$db get $recno1} res3]
set ret4 [catch {$db get $recno2} res4]
if { $txn2end == "commit" } {
error_check_good txn2_sees_txn1 $ret3 0
error_check_good txn2_sees_txn2 $ret4 0
error_check_good txn2_has_record2 \
[is_substr $res4 "record2"] 1
} else {
error_check_good txn2_cantsee_txn1 $ret3 0
error_check_good txn2_aborted [llength $res4] 0
}
} elseif { $endorder == "reverse" } {
puts "\tLock005.b.2: $txn2end txn2 then $txn1end txn1"
error_check_good txn_$txn2end [$txn2 $txn2end] 0
how_many_locks 2 $e
set ret1 [catch {$db get -txn $txn1 $recno1} res1]
set ret2 [catch {$db get -txn $txn1 $recno2} res2]
if { $txn2end == "commit" } {
error_check_good txn1_sees_txn1 $ret1 0
error_check_good txn1_sees_txn2 $ret2 0
} else {
error_check_good txn1_cantsee_txn2 [llength $res2] 0
}
error_check_good txn_$txn1end [$txn1 $txn1end] 0
how_many_locks 1 $e
set ret3 [catch {$db get $recno1} res3]
set ret4 [catch {$db get $recno2} res4]
if { $txn1end == "commit" } {
error_check_good txn1_sees_txn1 $ret3 0
error_check_good txn1_sees_txn2 $ret4 0
error_check_good txn1_has_record1 \
[is_substr $res3 "record1"] 1
} else {
error_check_good txn1_cantsee_txn2 $ret4 0
error_check_good txn1_aborted [llength $res3] 0
}
}
}
proc how_many_locks { expected env } {
set stat [$env lock_stat]
set str "Current number of locks"
set checked 0
foreach statpair $stat {
if { $checked == 1 } {
break
}
if { [is_substr [lindex $statpair 0] $str] != 0} {
set checked 1
set nlocks [lindex $statpair 1]
error_check_good expected_nlocks $nlocks $expected
}
}
error_check_good checked $checked 1
}