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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2002
# Sleepycat Software. All rights reserved.
#
# $Id: lockscript.tcl,v 1.1.1.1 2003/11/20 22:13:57 toshok Exp $
#
# Random lock tester.
# Usage: lockscript dir numiters numobjs sleepint degree readratio
# dir: lock directory.
# numiters: Total number of iterations.
# numobjs: Number of objects on which to lock.
# sleepint: Maximum sleep interval.
# degree: Maximum number of locks to acquire at once
# readratio: Percent of locks that should be reads.
source ./include.tcl
source $test_path/test.tcl
set usage "lockscript dir numiters numobjs sleepint degree readratio"
# Verify usage
if { $argc != 6 } {
puts stderr "FAIL:[timestamp] Usage: $usage"
exit
}
# Initialize arguments
set dir [lindex $argv 0]
set numiters [ lindex $argv 1 ]
set numobjs [ lindex $argv 2 ]
set sleepint [ lindex $argv 3 ]
set degree [ lindex $argv 4 ]
set readratio [ lindex $argv 5 ]
# Initialize random number generator
global rand_init
berkdb srand $rand_init
catch { berkdb_env -create -lock -home $dir } e
error_check_good env_open [is_substr $e env] 1
catch { $e lock_id } locker
error_check_good locker [is_valid_locker $locker] TRUE
puts -nonewline "Beginning execution for $locker: $numiters $numobjs "
puts "$sleepint $degree $readratio"
flush stdout
for { set iter 0 } { $iter < $numiters } { incr iter } {
set nlocks [berkdb random_int 1 $degree]
# We will always lock objects in ascending order to avoid
# deadlocks.
set lastobj 1
set locklist {}
set objlist {}
for { set lnum 0 } { $lnum < $nlocks } { incr lnum } {
# Pick lock parameters
set obj [berkdb random_int $lastobj $numobjs]
set lastobj [expr $obj + 1]
set x [berkdb random_int 1 100 ]
if { $x <= $readratio } {
set rw read
} else {
set rw write
}
puts "[timestamp -c] $locker $lnum: $rw $obj"
# Do get; add to list
catch {$e lock_get $rw $locker $obj} lockp
error_check_good lock_get [is_valid_lock $lockp $e] TRUE
# Create a file to flag that we've a lock of the given
# type, after making sure only other read locks exist
# (if we're read locking) or no other locks exist (if
# we're writing).
lock003_vrfy $rw $obj
lock003_create $rw $obj
lappend objlist [list $obj $rw]
lappend locklist $lockp
if {$lastobj > $numobjs} {
break
}
}
# Pick sleep interval
puts "[timestamp -c] $locker sleeping"
# We used to sleep 1 to $sleepint seconds. This makes the test
# run for hours. Instead, make it sleep for 10 to $sleepint * 100
# milliseconds, for a maximum sleep time of 0.5 s.
after [berkdb random_int 10 [expr $sleepint * 100]]
puts "[timestamp -c] $locker awake"
# Now release locks
puts "[timestamp -c] $locker released locks"
# Delete our locking flag files, then reverify. (Note that the
# locking flag verification function assumes that our own lock
# is not currently flagged.)
foreach pair $objlist {
set obj [lindex $pair 0]
set rw [lindex $pair 1]
lock003_destroy $obj
lock003_vrfy $rw $obj
}
release_list $locklist
flush stdout
}
set ret [$e close]
error_check_good env_close $ret 0
puts "[timestamp -c] $locker Complete"
flush stdout
exit
|
