summaryrefslogtreecommitdiff
path: root/db-4.8.30/test/lock006.tcl
blob: d68631ec3c0358aeb4160631293fdb267d3e5e22 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2003-2009 Oracle.  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
	}
}