1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: lock002.tcl,v 12.8 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	lock002
8# TEST	Exercise basic multi-process aspects of lock.
9proc lock002 { {conflicts {0 0 0 0 0 1 0 1 1} } } {
10	source ./include.tcl
11
12	puts "Lock002: Basic multi-process lock tests."
13
14	env_cleanup $testdir
15
16	set nmodes [isqrt [llength $conflicts]]
17
18	# Open the lock
19	mlock_open $nmodes $conflicts
20	mlock_wait
21}
22
23# Make sure that we can create a region; destroy it, attach to it,
24# detach from it, etc.
25proc mlock_open { nmodes conflicts } {
26	source ./include.tcl
27	global lock_curid
28	global lock_maxid
29
30	puts "\tLock002.a multi-process open/close test"
31
32	# Open/Create region here.  Then close it and try to open from
33	# other test process.
34	set env_cmd [concat "berkdb_env -create -mode 0644 -lock \
35	    -lock_conflict" [list [list $nmodes $conflicts]] "-home $testdir"]
36	set local_env [eval $env_cmd]
37	$local_env lock_id_set $lock_curid $lock_maxid
38	error_check_good env_open [is_valid_env $local_env] TRUE
39
40	set ret [$local_env close]
41	error_check_good env_close $ret 0
42
43	# Open from other test process
44	set env_cmd "berkdb_env -mode 0644 -home $testdir"
45
46	set f1 [open |$tclsh_path r+]
47	puts $f1 "source $test_path/test.tcl"
48
49	set remote_env [send_cmd $f1 $env_cmd]
50	error_check_good remote:env_open [is_valid_env $remote_env] TRUE
51
52	# Now make sure that we can reopen the region.
53	set local_env [eval $env_cmd]
54	error_check_good env_open [is_valid_env $local_env] TRUE
55	set ret [$local_env close]
56	error_check_good env_close $ret 0
57
58	# Try closing the remote region
59	set ret [send_cmd $f1 "$remote_env close"]
60	error_check_good remote:lock_close $ret 0
61
62	# Try opening for create.  Will succeed because region exists.
63	set env_cmd [concat "berkdb_env -create -mode 0644 -lock \
64	    -lock_conflict" [list [list $nmodes $conflicts]] "-home $testdir"]
65	set local_env [eval $env_cmd]
66	error_check_good remote:env_open [is_valid_env $local_env] TRUE
67
68	# close locally
69	reset_env $local_env
70
71	# Close and exit remote
72	set ret [send_cmd $f1 "reset_env $remote_env"]
73
74	catch { close $f1 } result
75}
76
77proc mlock_wait { } {
78	source ./include.tcl
79
80	puts "\tLock002.b multi-process get/put wait test"
81
82	# Open region locally
83	set env_cmd "berkdb_env -home $testdir"
84	set local_env [eval $env_cmd]
85	error_check_good env_open [is_valid_env $local_env] TRUE
86
87	# Open region remotely
88	set f1 [open |$tclsh_path r+]
89
90	puts $f1 "source $test_path/test.tcl"
91
92	set remote_env [send_cmd $f1 $env_cmd]
93	error_check_good remote:env_open [is_valid_env $remote_env] TRUE
94
95	# Get a write lock locally; try for the read lock
96	# remotely.  We hold the locks for several seconds
97	# so that we can use timestamps to figure out if the
98	# other process waited.
99	set locker1 [$local_env lock_id]
100	set local_lock [$local_env lock_get write $locker1 object1]
101	error_check_good lock_get [is_valid_lock $local_lock $local_env] TRUE
102
103	# Now request a lock that we expect to hang; generate
104	# timestamps so we can tell if it actually hangs.
105	set locker2 [send_cmd $f1 "$remote_env lock_id"]
106	set remote_lock [send_timed_cmd $f1 1 \
107	    "set lock \[$remote_env lock_get write $locker2 object1\]"]
108
109	# Now sleep before releasing lock
110	tclsleep 5
111	set result [$local_lock put]
112	error_check_good lock_put $result 0
113
114	# Now get the result from the other script
115	set result [rcv_result $f1]
116	error_check_good lock_get:remote_time [expr $result > 4] 1
117
118	# Now get the remote lock
119	set remote_lock [send_cmd $f1 "puts \$lock"]
120	error_check_good remote:lock_get \
121	    [is_valid_lock $remote_lock $remote_env] TRUE
122
123	# Now make the other guy wait 5 seconds and then release his
124	# lock while we try to get a write lock on it.
125	set start [timestamp -r]
126
127	set ret [send_cmd $f1 "tclsleep 5"]
128
129	set ret [send_cmd $f1 "$remote_lock put"]
130
131	set local_lock [$local_env lock_get write $locker1 object1]
132	error_check_good lock_get:time \
133	    [expr [expr [timestamp -r] - $start] > 2] 1
134	error_check_good lock_get:local \
135	    [is_valid_lock $local_lock $local_env] TRUE
136
137	# Now check remote's result
138	set result [rcv_result $f1]
139	error_check_good lock_put:remote $result 0
140
141	# Clean up remote
142	set result [send_cmd $f1 "$remote_env lock_id_free $locker2" ]
143	error_check_good remote_free_id $result 0
144	set ret [send_cmd $f1 "reset_env $remote_env"]
145
146	close $f1
147
148	# Now close up locally
149	set ret [$local_lock put]
150	error_check_good lock_put $ret 0
151	error_check_good lock_id_free [$local_env lock_id_free $locker1] 0
152
153	reset_env $local_env
154}
155