mirror of
https://github.com/berkeleydb/libdb.git
synced 2024-09-29 03:36:55 +00:00
121 lines
3.4 KiB
Tcl
121 lines
3.4 KiB
Tcl
# See the file LICENSE for redistribution information.
|
|
#
|
|
# Copyright (c) 1996, 2011 Oracle and/or its affiliates. All rights reserved.
|
|
#
|
|
# $Id$
|
|
#
|
|
|
|
# TEST lock001
|
|
# TEST Make sure that the basic lock tests work. Do some simple gets
|
|
# TEST and puts for a single locker.
|
|
proc lock001 { {iterations 1000} } {
|
|
source ./include.tcl
|
|
global lock_curid
|
|
global lock_maxid
|
|
|
|
set save_curid $lock_curid
|
|
set save_maxid $lock_maxid
|
|
|
|
# Set defaults
|
|
# Adjusted to make exact match of isqrt
|
|
#set conflicts { 3 0 0 0 0 0 1 0 1 1}
|
|
#set conflicts { 3 0 0 0 0 1 0 1 1}
|
|
|
|
set conflicts { 0 0 0 0 0 1 0 1 1}
|
|
set nmodes [isqrt [llength $conflicts]]
|
|
|
|
# Cleanup
|
|
env_cleanup $testdir
|
|
|
|
# Open the region we'll use for testing.
|
|
set eflags "-create -lock -home $testdir -mode 0644 \
|
|
-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]
|
|
# Get and release each type of lock
|
|
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
|
|
}
|
|
|
|
# Get a bunch of locks for the same locker; these should work
|
|
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 {}
|
|
# Check that reference counted locks work
|
|
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
|
|
|
|
# Finally try some failing locks
|
|
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
|
|
}
|
|
|
|
# Change the locker
|
|
set locker [$env lock_id]
|
|
set blocklist {}
|
|
# Skip NO_LOCK lock.
|
|
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
|
|
#error_check_good lock_get:e [is_substr $lockp $env] 1
|
|
#error_check_good lock_get:e [is_blocked $lockp] 0
|
|
}
|
|
# Now release original locks
|
|
release_list $locklist
|
|
|
|
# Now re-acquire blocking locks
|
|
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
|
|
}
|
|
|
|
# Now release new locks
|
|
release_list $locklist
|
|
error_check_good free_id [$env lock_id_free $locker] 0
|
|
|
|
error_check_good envclose [$env close] 0
|
|
|
|
}
|
|
|
|
# Blocked locks appear as lockmgrN.lockM\nBLOCKED
|
|
proc is_blocked { l } {
|
|
if { [string compare $l BLOCKED ] == 0 } {
|
|
return 1
|
|
} else {
|
|
return 0
|
|
}
|
|
}
|