diff options
Diffstat (limited to 'bdb/test/lockscript.tcl')
| -rw-r--r-- | bdb/test/lockscript.tcl | 51 |
1 files changed, 40 insertions, 11 deletions
diff --git a/bdb/test/lockscript.tcl b/bdb/test/lockscript.tcl index bd07d80b54b..812339a4a70 100644 --- a/bdb/test/lockscript.tcl +++ b/bdb/test/lockscript.tcl @@ -1,9 +1,9 @@ # See the file LICENSE for redistribution information. # -# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Copyright (c) 1996-2002 # Sleepycat Software. All rights reserved. # -# $Id: lockscript.tcl,v 11.11 2000/03/24 19:53:39 krinsky Exp $ +# $Id: lockscript.tcl,v 11.17 2002/02/20 17:08:23 sandstro Exp $ # # Random lock tester. # Usage: lockscript dir numiters numobjs sleepint degree readratio @@ -32,25 +32,28 @@ set numobjs [ lindex $argv 2 ] set sleepint [ lindex $argv 3 ] set degree [ lindex $argv 4 ] set readratio [ lindex $argv 5 ] -set locker [pid] # 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 -set e [berkdb env -create -lock -home $dir] -error_check_good env_open [is_substr $e env] 1 - 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] @@ -61,20 +64,46 @@ for { set iter 0 } { $iter < $numiters } { incr iter } { } else { set rw write } - puts "[timestamp] $locker $lnum: $rw $obj" + puts "[timestamp -c] $locker $lnum: $rw $obj" # Do get; add to list - set lockp [$e lock_get $rw $locker $obj] + 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 - tclsleep [berkdb random_int 1 $sleepint] + 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] $locker released 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 } @@ -82,7 +111,7 @@ for { set iter 0 } { $iter < $numiters } { incr iter } { set ret [$e close] error_check_good env_close $ret 0 -puts "[timestamp] $locker Complete" +puts "[timestamp -c] $locker Complete" flush stdout exit |