proc lock002 { {maxlocks 1000} {conflicts {0 0 0 0 0 1 0 1 1} } } {
source ./include.tcl
puts "Lock002: Basic multi-process lock tests."
env_cleanup $testdir
set nmodes [isqrt [llength $conflicts]]
mlock_open $maxlocks $nmodes $conflicts
mlock_wait
}
proc mlock_open { maxl nmodes conflicts } {
source ./include.tcl
global lock_curid
global lock_maxid
puts "\tLock002.a multi-process open/close test"
set env_cmd [concat "berkdb_env -create -mode 0644 \
-lock -lock_max $maxl -lock_conflict" \
[list [list $nmodes $conflicts]] "-home $testdir"]
set local_env [eval $env_cmd]
$local_env lock_id_set $lock_curid $lock_maxid
error_check_good env_open [is_valid_env $local_env] TRUE
set ret [$local_env close]
error_check_good env_close $ret 0
set env_cmd "berkdb_env -mode 0644 -home $testdir"
set f1 [open |$tclsh_path r+]
puts $f1 "source $test_path/test.tcl"
set remote_env [send_cmd $f1 $env_cmd]
error_check_good remote:env_open [is_valid_env $remote_env] TRUE
set local_env [eval $env_cmd]
error_check_good env_open [is_valid_env $local_env] TRUE
set ret [$local_env close]
error_check_good env_close $ret 0
set ret [send_cmd $f1 "$remote_env close"]
error_check_good remote:lock_close $ret 0
set env_cmd [concat "berkdb_env -create -mode 0644 \
-lock -lock_max $maxl -lock_conflict" \
[list [list $nmodes $conflicts]] "-home $testdir"]
set local_env [eval $env_cmd]
error_check_good remote:env_open [is_valid_env $local_env] TRUE
reset_env $local_env
set ret [send_cmd $f1 "reset_env $remote_env"]
catch { close $f1 } result
}
proc mlock_wait { } {
source ./include.tcl
puts "\tLock002.b multi-process get/put wait test"
set env_cmd "berkdb_env -lock -home $testdir"
set local_env [eval $env_cmd]
error_check_good env_open [is_valid_env $local_env] TRUE
set f1 [open |$tclsh_path r+]
puts $f1 "source $test_path/test.tcl"
set remote_env [send_cmd $f1 $env_cmd]
error_check_good remote:env_open [is_valid_env $remote_env] TRUE
set locker1 [$local_env lock_id]
set local_lock [$local_env lock_get write $locker1 object1]
error_check_good lock_get [is_valid_lock $local_lock $local_env] TRUE
set locker2 [send_cmd $f1 "$remote_env lock_id"]
set remote_lock [send_timed_cmd $f1 1 \
"set lock \[$remote_env lock_get write $locker2 object1\]"]
tclsleep 5
set result [$local_lock put]
error_check_good lock_put $result 0
set result [rcv_result $f1]
error_check_good lock_get:remote_time [expr $result > 4] 1
set remote_lock [send_cmd $f1 "puts \$lock"]
error_check_good remote:lock_get \
[is_valid_lock $remote_lock $remote_env] TRUE
set start [timestamp -r]
set ret [send_cmd $f1 "tclsleep 5"]
set ret [send_cmd $f1 "$remote_lock put"]
set local_lock [$local_env lock_get write $locker1 object1]
error_check_good lock_get:time \
[expr [expr [timestamp -r] - $start] > 2] 1
error_check_good lock_get:local \
[is_valid_lock $local_lock $local_env] TRUE
set result [rcv_result $f1]
error_check_good lock_put:remote $result 0
set result [send_cmd $f1 "$remote_env lock_id_free $locker2" ]
error_check_good remote_free_id $result 0
set ret [send_cmd $f1 "reset_env $remote_env"]
close $f1
set ret [$local_lock put]
error_check_good lock_put $ret 0
error_check_good lock_id_free [$local_env lock_id_free $locker1] 0
reset_env $local_env
}