1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: lock001.tcl,v 12.7 2008/01/08 20:58:53 bostic Exp $
6#
7
8# TEST	lock001
9# TEST	Make sure that the basic lock tests work.  Do some simple gets
10# TEST	and puts for a single locker.
11proc lock001 { {iterations 1000} } {
12	source ./include.tcl
13	global lock_curid
14	global lock_maxid
15
16	set save_curid $lock_curid
17	set save_maxid $lock_maxid
18
19	# Set defaults
20	# Adjusted to make exact match of isqrt
21	#set conflicts { 3 0 0 0 0 0 1 0 1 1}
22	#set conflicts { 3 0 0 0 0 1 0 1 1}
23
24	set conflicts { 0 0 0 0 0 1 0 1 1}
25	set nmodes [isqrt [llength $conflicts]]
26
27	# Cleanup
28	env_cleanup $testdir
29
30	# Open the region we'll use for testing.
31	set eflags "-create -lock -home $testdir -mode 0644 \
32	    -lock_conflict {$nmodes {$conflicts}}"
33	set env [eval {berkdb_env} $eflags]
34	error_check_good env [is_valid_env $env] TRUE
35	error_check_good lock_id_set \
36	     [$env lock_id_set $lock_curid $lock_maxid] 0
37
38	puts "Lock001: test basic lock operations"
39	set locker [$env lock_id]
40	# Get and release each type of lock
41	puts "\tLock001.a: get and release each type of lock"
42	foreach m {ng write read} {
43		set obj obj$m
44		set lockp [$env lock_get $m $locker $obj]
45		error_check_good lock_get:a [is_blocked $lockp] 0
46		error_check_good lock_get:a [is_substr $lockp $env] 1
47		set ret [ $lockp put ]
48		error_check_good lock_put $ret 0
49	}
50
51	# Get a bunch of locks for the same locker; these should work
52	set obj OBJECT
53	puts "\tLock001.b: Get a bunch of locks for the same locker"
54	foreach m {ng write read} {
55		set lockp [$env lock_get $m $locker $obj ]
56		lappend locklist $lockp
57		error_check_good lock_get:b [is_blocked $lockp] 0
58		error_check_good lock_get:b [is_substr $lockp $env] 1
59	}
60	release_list $locklist
61
62	set locklist {}
63	# Check that reference counted locks work
64	puts "\tLock001.c: reference counted locks."
65	for {set i 0} { $i < 10 } {incr i} {
66		set lockp [$env lock_get -nowait write $locker $obj]
67		error_check_good lock_get:c [is_blocked $lockp] 0
68		error_check_good lock_get:c [is_substr $lockp $env] 1
69		lappend locklist $lockp
70	}
71	release_list $locklist
72
73	# Finally try some failing locks
74	set locklist {}
75	foreach i {ng write read} {
76		set lockp [$env lock_get $i $locker $obj]
77		lappend locklist $lockp
78		error_check_good lock_get:d [is_blocked $lockp] 0
79		error_check_good lock_get:d [is_substr $lockp $env] 1
80	}
81
82	# Change the locker
83	set locker [$env lock_id]
84	set blocklist {}
85	# Skip NO_LOCK lock.
86	puts "\tLock001.d: Change the locker, acquire read and write."
87	foreach i {write read} {
88		catch {$env lock_get -nowait $i $locker $obj} ret
89		error_check_good lock_get:e [is_substr $ret "not granted"] 1
90		#error_check_good lock_get:e [is_substr $lockp $env] 1
91		#error_check_good lock_get:e [is_blocked $lockp] 0
92	}
93	# Now release original locks
94	release_list $locklist
95
96	# Now re-acquire blocking locks
97	set locklist {}
98	puts "\tLock001.e: Re-acquire blocking locks."
99	foreach i {write read} {
100		set lockp [$env lock_get -nowait $i $locker $obj ]
101		error_check_good lock_get:f [is_substr $lockp $env] 1
102		error_check_good lock_get:f [is_blocked $lockp] 0
103		lappend locklist $lockp
104	}
105
106	# Now release new locks
107	release_list $locklist
108	error_check_good free_id [$env lock_id_free $locker] 0
109
110	error_check_good envclose [$env close] 0
111
112}
113
114# Blocked locks appear as lockmgrN.lockM\nBLOCKED
115proc is_blocked { l } {
116	if { [string compare $l BLOCKED ] == 0 } {
117		return 1
118	} else {
119		return 0
120	}
121}
122