1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 2003,2008 Oracle.  All rights reserved.
4#
5# $Id: lock006.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	lock006
8# TEST	Test lock_vec interface.  We do all the same things that
9# TEST	lock001 does, using lock_vec instead of lock_get and lock_put,
10# TEST	plus a few more things like lock-coupling.
11# TEST	1.  Get and release one at a time.
12# TEST 	2.  Release with put_obj (all locks for a given locker/obj).
13# TEST	3.  Release with put_all (all locks for a given locker).
14# TEST	Regularly check lock_stat to verify all locks have been
15# TEST	released.
16proc lock006 { } {
17	source ./include.tcl
18	global lock_curid
19	global lock_maxid
20
21	set save_curid $lock_curid
22	set save_maxid $lock_maxid
23
24	# Cleanup
25	env_cleanup $testdir
26
27	# Open the region we'll use for testing.
28	set eflags "-create -lock -home $testdir"
29	set env [eval {berkdb_env} $eflags]
30	error_check_good env [is_valid_env $env] TRUE
31	error_check_good lock_id_set \
32	     [$env lock_id_set $lock_curid $lock_maxid] 0
33
34	puts "Lock006: test basic lock operations using lock_vec interface"
35	set locker [$env lock_id]
36	set modes {ng write read iwrite iread iwr}
37
38	# Get and release each type of lock.
39	puts "\tLock006.a: get and release one at a time"
40	foreach m $modes {
41		set obj obj$m
42		set lockp [$env lock_vec $locker "get $obj $m"]
43		error_check_good lock_vec_get:a [is_blocked $lockp] 0
44		error_check_good lock_vec_get:a [is_valid_lock $lockp $env] TRUE
45		error_check_good lock_vec_put:a \
46		    [$env lock_vec $locker "put $lockp"] 0
47	}
48	how_many_locks 0 $env
49
50	# Get a bunch of locks for the same locker; these should work
51	set obj OBJECT
52	puts "\tLock006.b: Get many locks for 1 locker,\
53	    release with put_all."
54	foreach m $modes {
55		set lockp [$env lock_vec $locker "get $obj $m"]
56		error_check_good lock_vec_get:b [is_blocked $lockp] 0
57		error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE
58	}
59	how_many_locks 6 $env
60	error_check_good release [$env lock_vec $locker put_all] 0
61	how_many_locks 0 $env
62
63	puts "\tLock006.c: Get many locks for 1 locker,\
64	    release with put_obj."
65	foreach m $modes {
66		set lockp [$env lock_vec $locker "get $obj $m"]
67		error_check_good lock_vec_get:b [is_blocked $lockp] 0
68		error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE
69	}
70	error_check_good release [$env lock_vec $locker "put_obj $obj"] 0
71#	how_many_locks 0 $env
72	how_many_locks 6 $env
73
74	# Get many locks for the same locker on more than one object.
75	# Release with put_all.
76	set obj2 OBJECT2
77	puts "\tLock006.d: Get many locks on 2 objects for 1 locker,\
78	    release with put_all."
79	foreach m $modes {
80		set lockp [$env lock_vec $locker "get $obj $m"]
81		error_check_good lock_vec_get:b [is_blocked $lockp] 0
82		error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE
83	}
84	foreach m $modes {
85		set lockp [$env lock_vec $locker "get $obj2 $m"]
86		error_check_good lock_vec_get:b [is_blocked $lockp] 0
87		error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE
88	}
89	error_check_good release [$env lock_vec $locker put_all] 0
90#	how_many_locks 0 $env
91	how_many_locks 6 $env
92
93	# Check that reference counted locks work.
94	puts "\tLock006.e: reference counted locks."
95	for {set i 0} { $i < 10 } {incr i} {
96		set lockp [$env lock_vec -nowait $locker "get $obj write"]
97		error_check_good lock_vec_get:c [is_blocked $lockp] 0
98		error_check_good lock_vec_get:c [is_valid_lock $lockp $env] TRUE
99	}
100	error_check_good put_all [$env lock_vec $locker put_all] 0
101#	how_many_locks 0 $env
102	how_many_locks 6 $env
103
104	# Lock-coupling.  Get a lock on object 1.  Get a lock on object 2,
105	# release object 1, and so on.
106	puts "\tLock006.f: Lock-coupling."
107	set locker2 [$env lock_id]
108
109	foreach m { read write iwrite iread iwr } {
110		set lockp [$env lock_vec $locker "get OBJ0 $m"]
111		set iter 0
112		set nobjects 10
113		while { $iter < 3 } {
114			for { set i 1 } { $i <= $nobjects } { incr i } {
115				set lockv [$env lock_vec $locker \
116				    "get OBJ$i $m" "put $lockp"]
117
118				# Make sure another locker can get an exclusive
119				# lock on the object just released.
120				set lock2p [$env lock_vec -nowait $locker2 \
121				    "get OBJ[expr $i - 1] write" ]
122				error_check_good release_lock2 [$env lock_vec \
123				    $locker2 "put $lock2p"] 0
124
125				# Make sure another locker can't get an exclusive
126				# lock on the object just locked.
127				catch {$env lock_vec -nowait $locker2 \
128				    "get OBJ$i write"} ret
129				error_check_good not_granted \
130				    [is_substr $ret "not granted"] 1
131
132				set lockp [lindex $lockv 0]
133				if { $i == $nobjects } {
134					incr iter
135				}
136			}
137		}
138		error_check_good lock_put [$env lock_vec $locker "put $lockp"] 0
139#		how_many_locks 0 $env
140		how_many_locks 6 $env
141	}
142
143	# Finally try some failing locks.  Set up a write lock on object.
144	foreach m { write } {
145		set lockp [$env lock_vec $locker "get $obj $m"]
146		error_check_good lock_vec_get:d [is_blocked $lockp] 0
147		error_check_good lock_vec_get:d [is_valid_lock $lockp $env] TRUE
148	}
149
150	# Change the locker
151	set newlocker [$env lock_id]
152	# Skip NO_LOCK.
153	puts "\tLock006.g: Change the locker, try to acquire read and write."
154	foreach m { read write iwrite iread iwr } {
155		catch {$env lock_vec -nowait $newlocker "get $obj $m"} ret
156		error_check_good lock_vec_get:d [is_substr $ret "not granted"] 1
157	}
158
159	# Now release original locks
160	error_check_good put_all [$env lock_vec $locker {put_all}] 0
161	error_check_good free_id [$env lock_id_free $locker] 0
162
163	# Now re-acquire blocking locks
164	puts "\tLock006.h: Re-acquire blocking locks."
165	foreach m { read write iwrite iread iwr } {
166		set lockp [$env lock_vec -nowait $newlocker "get $obj $m"]
167		error_check_good lock_get:e [is_valid_lock $lockp $env] TRUE
168		error_check_good lock_get:e [is_blocked $lockp] 0
169	}
170
171	# Now release new locks
172	error_check_good put_all [$env lock_vec $newlocker {put_all}] 0
173	error_check_good free_id [$env lock_id_free $newlocker] 0
174
175	error_check_good envclose [$env close] 0
176
177}
178
179# Blocked locks appear as lockmgrN.lockM\nBLOCKED
180proc is_blocked { l } {
181	if { [string compare $l BLOCKED ] == 0 } {
182		return 1
183	} else {
184		return 0
185	}
186}
187