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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2002
# Sleepycat Software. All rights reserved.
#
# $Id: lock002.tcl,v 1.1.1.1 2003/11/20 22:13:57 toshok Exp $
#
# TEST lock002
# TEST Exercise basic multi-process aspects of lock.
proc lock002 { {maxlocks 1000} {conflicts {0 0 0 0 0 1 0 1 1} } } {
source ./include.tcl
puts "Lock002: Basic multi-process lock tests."
env_cleanup $testdir
set nmodes [isqrt [llength $conflicts]]
# Open the lock
mlock_open $maxlocks $nmodes $conflicts
mlock_wait
}
# Make sure that we can create a region; destroy it, attach to it,
# detach from it, etc.
proc mlock_open { maxl nmodes conflicts } {
source ./include.tcl
global lock_curid
global lock_maxid
puts "\tLock002.a multi-process open/close test"
# Open/Create region here. Then close it and try to open from
# other test process.
set env_cmd [concat "berkdb_env -create -mode 0644 \
-lock -lock_max $maxl -lock_conflict" \
[list [list $nmodes $conflicts]] "-home $testdir"]
set local_env [eval $env_cmd]
$local_env lock_id_set $lock_curid $lock_maxid
error_check_good env_open [is_valid_env $local_env] TRUE
set ret [$local_env close]
error_check_good env_close $ret 0
# Open from other test process
set env_cmd "berkdb_env -mode 0644 -home $testdir"
set f1 [open |$tclsh_path r+]
puts $f1 "source $test_path/test.tcl"
set remote_env [send_cmd $f1 $env_cmd]
error_check_good remote:env_open [is_valid_env $remote_env] TRUE
# Now make sure that we can reopen the region.
set local_env [eval $env_cmd]
error_check_good env_open [is_valid_env $local_env] TRUE
set ret [$local_env close]
error_check_good env_close $ret 0
# Try closing the remote region
set ret [send_cmd $f1 "$remote_env close"]
error_check_good remote:lock_close $ret 0
# Try opening for create. Will succeed because region exists.
set env_cmd [concat "berkdb_env -create -mode 0644 \
-lock -lock_max $maxl -lock_conflict" \
[list [list $nmodes $conflicts]] "-home $testdir"]
set local_env [eval $env_cmd]
error_check_good remote:env_open [is_valid_env $local_env] TRUE
# close locally
reset_env $local_env
# Close and exit remote
set ret [send_cmd $f1 "reset_env $remote_env"]
catch { close $f1 } result
}
proc mlock_wait { } {
source ./include.tcl
puts "\tLock002.b multi-process get/put wait test"
# Open region locally
set env_cmd "berkdb_env -lock -home $testdir"
set local_env [eval $env_cmd]
error_check_good env_open [is_valid_env $local_env] TRUE
# Open region remotely
set f1 [open |$tclsh_path r+]
puts $f1 "source $test_path/test.tcl"
set remote_env [send_cmd $f1 $env_cmd]
error_check_good remote:env_open [is_valid_env $remote_env] TRUE
# Get a write lock locally; try for the read lock
# remotely. We hold the locks for several seconds
# so that we can use timestamps to figure out if the
# other process waited.
set locker1 [$local_env lock_id]
set local_lock [$local_env lock_get write $locker1 object1]
error_check_good lock_get [is_valid_lock $local_lock $local_env] TRUE
# Now request a lock that we expect to hang; generate
# timestamps so we can tell if it actually hangs.
set locker2 [send_cmd $f1 "$remote_env lock_id"]
set remote_lock [send_timed_cmd $f1 1 \
"set lock \[$remote_env lock_get write $locker2 object1\]"]
# Now sleep before releasing lock
tclsleep 5
set result [$local_lock put]
error_check_good lock_put $result 0
# Now get the result from the other script
set result [rcv_result $f1]
error_check_good lock_get:remote_time [expr $result > 4] 1
# Now get the remote lock
set remote_lock [send_cmd $f1 "puts \$lock"]
error_check_good remote:lock_get \
[is_valid_lock $remote_lock $remote_env] TRUE
# Now make the other guy wait 5 second and then release his
# lock while we try to get a write lock on it
set start [timestamp -r]
set ret [send_cmd $f1 "tclsleep 5"]
set ret [send_cmd $f1 "$remote_lock put"]
set local_lock [$local_env lock_get write $locker1 object1]
error_check_good lock_get:time \
[expr [expr [timestamp -r] - $start] > 2] 1
error_check_good lock_get:local \
[is_valid_lock $local_lock $local_env] TRUE
# Now check remote's result
set result [rcv_result $f1]
error_check_good lock_put:remote $result 0
# Clean up remote
set result [send_cmd $f1 "$remote_env lock_id_free $locker2" ]
error_check_good remote_free_id $result 0
set ret [send_cmd $f1 "reset_env $remote_env"]
close $f1
# Now close up locally
set ret [$local_lock put]
error_check_good lock_put $ret 0
error_check_good lock_id_free [$local_env lock_id_free $locker1] 0
reset_env $local_env
}
|
