proc lock001 { {iterations 1000} {maxlocks 1000} } {
source ./include.tcl
global lock_curid
global lock_maxid
set save_curid $lock_curid
set save_maxid $lock_maxid
set conflicts { 0 0 0 0 0 1 0 1 1}
set nmodes [isqrt [llength $conflicts]]
env_cleanup $testdir
set eflags "-create -lock -home $testdir -mode 0644 \
-lock_max $maxlocks -lock_conflict {$nmodes {$conflicts}}"
set env [eval {berkdb_env} $eflags]
error_check_good env [is_valid_env $env] TRUE
error_check_good lock_id_set \
[$env lock_id_set $lock_curid $lock_maxid] 0
puts "Lock001: test basic lock operations"
set locker [$env lock_id]
puts "\tLock001.a: get and release each type of lock"
foreach m {ng write read} {
set obj obj$m
set lockp [$env lock_get $m $locker $obj]
error_check_good lock_get:a [is_blocked $lockp] 0
error_check_good lock_get:a [is_substr $lockp $env] 1
set ret [ $lockp put ]
error_check_good lock_put $ret 0
}
set obj OBJECT
puts "\tLock001.b: Get a bunch of locks for the same locker"
foreach m {ng write read} {
set lockp [$env lock_get $m $locker $obj ]
lappend locklist $lockp
error_check_good lock_get:b [is_blocked $lockp] 0
error_check_good lock_get:b [is_substr $lockp $env] 1
}
release_list $locklist
set locklist {}
puts "\tLock001.c: reference counted locks."
for {set i 0} { $i < 10 } {incr i} {
set lockp [$env lock_get -nowait write $locker $obj]
error_check_good lock_get:c [is_blocked $lockp] 0
error_check_good lock_get:c [is_substr $lockp $env] 1
lappend locklist $lockp
}
release_list $locklist
set locklist {}
foreach i {ng write read} {
set lockp [$env lock_get $i $locker $obj]
lappend locklist $lockp
error_check_good lock_get:d [is_blocked $lockp] 0
error_check_good lock_get:d [is_substr $lockp $env] 1
}
set locker [$env lock_id]
set blocklist {}
puts "\tLock001.d: Change the locker, acquire read and write."
foreach i {write read} {
catch {$env lock_get -nowait $i $locker $obj} ret
error_check_good lock_get:e [is_substr $ret "not granted"] 1
}
release_list $locklist
set locklist {}
puts "\tLock001.e: Re-acquire blocking locks."
foreach i {write read} {
set lockp [$env lock_get -nowait $i $locker $obj ]
error_check_good lock_get:f [is_substr $lockp $env] 1
error_check_good lock_get:f [is_blocked $lockp] 0
lappend locklist $lockp
}
release_list $locklist
error_check_good free_id [$env lock_id_free $locker] 0
error_check_good envclose [$env close] 0
}
proc is_blocked { l } {
if { [string compare $l BLOCKED ] == 0 } {
return 1
} else {
return 0
}
}