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