1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: lockscript.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# Random lock tester.
8# Usage: lockscript dir numiters numobjs sleepint degree readratio
9# dir: lock directory.
10# numiters: Total number of iterations.
11# numobjs: Number of objects on which to lock.
12# sleepint: Maximum sleep interval.
13# degree: Maximum number of locks to acquire at once
14# readratio: Percent of locks that should be reads.
15
16source ./include.tcl
17source $test_path/test.tcl
18
19set usage "lockscript dir numiters numobjs sleepint degree readratio"
20
21# Verify usage
22if { $argc != 6 } {
23	puts stderr "FAIL:[timestamp] Usage: $usage"
24	exit
25}
26
27# Initialize arguments
28set dir [lindex $argv 0]
29set numiters [ lindex $argv 1 ]
30set numobjs [ lindex $argv 2 ]
31set sleepint [ lindex $argv 3 ]
32set degree [ lindex $argv 4 ]
33set readratio [ lindex $argv 5 ]
34
35# Initialize random number generator
36global rand_init
37berkdb srand $rand_init
38
39
40catch { berkdb_env -create -lock -home $dir } e
41error_check_good env_open [is_substr $e env] 1
42catch { $e lock_id } locker
43error_check_good locker [is_valid_locker $locker] TRUE
44
45puts -nonewline "Beginning execution for $locker: $numiters $numobjs "
46puts "$sleepint $degree $readratio"
47flush stdout
48
49for { set iter 0 } { $iter < $numiters } { incr iter } {
50	set nlocks [berkdb random_int 1 $degree]
51	# We will always lock objects in ascending order to avoid
52	# deadlocks.
53	set lastobj 1
54	set locklist {}
55	set objlist {}
56	for { set lnum 0 } { $lnum < $nlocks } { incr lnum } {
57		# Pick lock parameters
58		set obj [berkdb random_int $lastobj $numobjs]
59		set lastobj [expr $obj + 1]
60		set x [berkdb random_int 1 100 ]
61		if { $x <= $readratio } {
62			set rw read
63		} else {
64			set rw write
65		}
66		puts "[timestamp -c] $locker $lnum: $rw $obj"
67
68		# Do get; add to list
69		catch {$e lock_get $rw $locker $obj} lockp
70		error_check_good lock_get [is_valid_lock $lockp $e] TRUE
71
72		# Create a file to flag that we've a lock of the given
73		# type, after making sure only other read locks exist
74		# (if we're read locking) or no other locks exist (if
75		# we're writing).
76		lock003_vrfy $rw $obj
77		lock003_create $rw $obj
78		lappend objlist [list $obj $rw]
79
80		lappend locklist $lockp
81		if {$lastobj > $numobjs} {
82			break
83		}
84	}
85	# Pick sleep interval
86	puts "[timestamp -c] $locker sleeping"
87	# We used to sleep 1 to $sleepint seconds.  This makes the test
88	# run for hours.  Instead, make it sleep for 10 to $sleepint * 100
89	# milliseconds, for a maximum sleep time of 0.5 s.
90	after [berkdb random_int 10 [expr $sleepint * 100]]
91	puts "[timestamp -c] $locker awake"
92
93	# Now release locks
94	puts "[timestamp -c] $locker released locks"
95
96	# Delete our locking flag files, then reverify.  (Note that the
97	# locking flag verification function assumes that our own lock
98	# is not currently flagged.)
99	foreach pair $objlist {
100		set obj [lindex $pair 0]
101		set rw [lindex $pair 1]
102		lock003_destroy $obj
103		lock003_vrfy $rw $obj
104	}
105
106	release_list $locklist
107	flush stdout
108}
109
110set ret [$e close]
111error_check_good env_close $ret 0
112
113puts "[timestamp -c] $locker Complete"
114flush stdout
115
116exit
117