libdb/test/tcl/lock006.tcl

# See the file LICENSE for redistribution information.
#
# Copyright (c) 2003, 2011 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$
#
# TEST	lock006
# TEST	Test lock_vec interface.  We do all the same things that
# TEST	lock001 does, using lock_vec instead of lock_get and lock_put,
# TEST	plus a few more things like lock-coupling.
# TEST	1.  Get and release one at a time.
# TEST 	2.  Release with put_obj (all locks for a given locker/obj).
# TEST	3.  Release with put_all (all locks for a given locker).
# TEST	Regularly check lock_stat to verify all locks have been
# TEST	released.
proc lock006 { } {
	source ./include.tcl
	global lock_curid
	global lock_maxid

	set save_curid $lock_curid
	set save_maxid $lock_maxid

	# Cleanup
	env_cleanup $testdir

	# Open the region we'll use for testing.
	set eflags "-create -lock -home $testdir"
	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 "Lock006: test basic lock operations using lock_vec interface"
	set locker [$env lock_id]
	set modes {ng write read iwrite iread iwr}

	# Get and release each type of lock.
	puts "\tLock006.a: get and release one at a time"
	foreach m $modes {
		set obj obj$m
		set lockp [$env lock_vec $locker "get $obj $m"]
		error_check_good lock_vec_get:a [is_blocked $lockp] 0
		error_check_good lock_vec_get:a [is_valid_lock $lockp $env] TRUE
		error_check_good lock_vec_put:a \
		    [$env lock_vec $locker "put $lockp"] 0
	}
	how_many_locks 0 $env

	# Get a bunch of locks for the same locker; these should work
	set obj OBJECT
	puts "\tLock006.b: Get many locks for 1 locker,\
	    release with put_all."
	foreach m $modes {
		set lockp [$env lock_vec $locker "get $obj $m"]
		error_check_good lock_vec_get:b [is_blocked $lockp] 0
		error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE
	}
	how_many_locks 6 $env
	error_check_good release [$env lock_vec $locker put_all] 0
	how_many_locks 0 $env

	puts "\tLock006.c: Get many locks for 1 locker,\
	    release with put_obj."
	foreach m $modes {
		set lockp [$env lock_vec $locker "get $obj $m"]
		error_check_good lock_vec_get:b [is_blocked $lockp] 0
		error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE
	}
	error_check_good release [$env lock_vec $locker "put_obj $obj"] 0
#	how_many_locks 0 $env
	how_many_locks 6 $env

	# Get many locks for the same locker on more than one object.
	# Release with put_all.
	set obj2 OBJECT2
	puts "\tLock006.d: Get many locks on 2 objects for 1 locker,\
	    release with put_all."
	foreach m $modes {
		set lockp [$env lock_vec $locker "get $obj $m"]
		error_check_good lock_vec_get:b [is_blocked $lockp] 0
		error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE
	}
	foreach m $modes {
		set lockp [$env lock_vec $locker "get $obj2 $m"]
		error_check_good lock_vec_get:b [is_blocked $lockp] 0
		error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE
	}
	error_check_good release [$env lock_vec $locker put_all] 0
#	how_many_locks 0 $env
	how_many_locks 6 $env

	# Check that reference counted locks work.
	puts "\tLock006.e: reference counted locks."
	for {set i 0} { $i < 10 } {incr i} {
		set lockp [$env lock_vec -nowait $locker "get $obj write"]
		error_check_good lock_vec_get:c [is_blocked $lockp] 0
		error_check_good lock_vec_get:c [is_valid_lock $lockp $env] TRUE
	}
	error_check_good put_all [$env lock_vec $locker put_all] 0
#	how_many_locks 0 $env
	how_many_locks 6 $env

	# Lock-coupling.  Get a lock on object 1.  Get a lock on object 2,
	# release object 1, and so on.
	puts "\tLock006.f: Lock-coupling."
	set locker2 [$env lock_id]

	foreach m { read write iwrite iread iwr } {
		set lockp [$env lock_vec $locker "get OBJ0 $m"]
		set iter 0
		set nobjects 10
		while { $iter < 3 } {
			for { set i 1 } { $i <= $nobjects } { incr i } {
				set lockv [$env lock_vec $locker \
				    "get OBJ$i $m" "put $lockp"]

				# Make sure another locker can get an exclusive
				# lock on the object just released.
				set lock2p [$env lock_vec -nowait $locker2 \
				    "get OBJ[expr $i - 1] write" ]
				error_check_good release_lock2 [$env lock_vec \
				    $locker2 "put $lock2p"] 0

				# Make sure another locker can't get an exclusive
				# lock on the object just locked.
				catch {$env lock_vec -nowait $locker2 \
				    "get OBJ$i write"} ret
				error_check_good not_granted \
				    [is_substr $ret "not granted"] 1

				set lockp [lindex $lockv 0]
				if { $i == $nobjects } {
					incr iter
				}
			}
		}
		error_check_good lock_put [$env lock_vec $locker "put $lockp"] 0
#		how_many_locks 0 $env
		how_many_locks 6 $env
	}

	# Finally try some failing locks.  Set up a write lock on object.
	foreach m { write } {
		set lockp [$env lock_vec $locker "get $obj $m"]
		error_check_good lock_vec_get:d [is_blocked $lockp] 0
		error_check_good lock_vec_get:d [is_valid_lock $lockp $env] TRUE
	}

	# Change the locker
	set newlocker [$env lock_id]
	# Skip NO_LOCK.
	puts "\tLock006.g: Change the locker, try to acquire read and write."
	foreach m { read write iwrite iread iwr } {
		catch {$env lock_vec -nowait $newlocker "get $obj $m"} ret
		error_check_good lock_vec_get:d [is_substr $ret "not granted"] 1
	}

	# Now release original locks
	error_check_good put_all [$env lock_vec $locker {put_all}] 0
	error_check_good free_id [$env lock_id_free $locker] 0

	# Now re-acquire blocking locks
	puts "\tLock006.h: Re-acquire blocking locks."
	foreach m { read write iwrite iread iwr } {
		set lockp [$env lock_vec -nowait $newlocker "get $obj $m"]
		error_check_good lock_get:e [is_valid_lock $lockp $env] TRUE
		error_check_good lock_get:e [is_blocked $lockp] 0
	}

	# Now release new locks
	error_check_good put_all [$env lock_vec $newlocker {put_all}] 0
	error_check_good free_id [$env lock_id_free $newlocker] 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
	}
}