diff options
Diffstat (limited to 'bdb/test/ddoyscript.tcl')
| -rw-r--r-- | bdb/test/ddoyscript.tcl | 172 |
1 files changed, 0 insertions, 172 deletions
diff --git a/bdb/test/ddoyscript.tcl b/bdb/test/ddoyscript.tcl deleted file mode 100644 index 5478a1a98e0..00000000000 --- a/bdb/test/ddoyscript.tcl +++ /dev/null @@ -1,172 +0,0 @@ -# See the file LICENSE for redistribution information. -# -# Copyright (c) 1996-2002 -# Sleepycat Software. All rights reserved. -# -# $Id: ddoyscript.tcl,v 11.6 2002/02/20 16:35:18 sandstro Exp $ -# -# Deadlock detector script tester. -# Usage: ddoyscript dir lockerid numprocs -# dir: DBHOME directory -# lockerid: Lock id for this locker -# numprocs: Total number of processes running -# myid: id of this process -- -# the order that the processes are created is the same -# in which their lockerid's were allocated so we know -# that there is a locker age relationship that is isomorphic -# with the order releationship of myid's. - -source ./include.tcl -source $test_path/test.tcl -source $test_path/testutils.tcl - -set usage "ddoyscript dir lockerid numprocs oldoryoung" - -# Verify usage -if { $argc != 5 } { - puts stderr "FAIL:[timestamp] Usage: $usage" - exit -} - -# Initialize arguments -set dir [lindex $argv 0] -set lockerid [ lindex $argv 1 ] -set numprocs [ lindex $argv 2 ] -set old_or_young [lindex $argv 3] -set myid [lindex $argv 4] - -set myenv [berkdb_env -lock -home $dir -create -mode 0644] -error_check_bad lock_open $myenv NULL -error_check_good lock_open [is_substr $myenv "env"] 1 - -# There are two cases here -- oldest/youngest or a ring locker. - -if { $myid == 0 || $myid == [expr $numprocs - 1] } { - set waitobj NULL - set ret 0 - - if { $myid == 0 } { - set objid 2 - if { $old_or_young == "o" } { - set waitobj [expr $numprocs - 1] - } - } else { - if { $old_or_young == "y" } { - set waitobj 0 - } - set objid 4 - } - - # Acquire own read lock - if {[catch {$myenv lock_get read $lockerid $myid} selflock] != 0} { - puts $errorInfo - } else { - error_check_good selfget:$objid [is_substr $selflock $myenv] 1 - } - - # Acquire read lock - if {[catch {$myenv lock_get read $lockerid $objid} lock1] != 0} { - puts $errorInfo - } else { - error_check_good lockget:$objid [is_substr $lock1 $myenv] 1 - } - - tclsleep 10 - - if { $waitobj == "NULL" } { - # Sleep for a good long while - tclsleep 90 - } else { - # Acquire write lock - if {[catch {$myenv lock_get write $lockerid $waitobj} lock2] - != 0} { - puts $errorInfo - set ret ERROR - } else { - error_check_good lockget:$waitobj \ - [is_substr $lock2 $myenv] 1 - - # Now release it - if {[catch {$lock2 put} err] != 0} { - puts $errorInfo - set ret ERROR - } else { - error_check_good lockput:oy:$objid $err 0 - } - } - - } - - # Release self lock - if {[catch {$selflock put} err] != 0} { - puts $errorInfo - if { $ret == 0 } { - set ret ERROR - } - } else { - error_check_good selfput:oy:$myid $err 0 - if { $ret == 0 } { - set ret 1 - } - } - - # Release first lock - if {[catch {$lock1 put} err] != 0} { - puts $errorInfo - if { $ret == 0 } { - set ret ERROR - } - } else { - error_check_good lockput:oy:$objid $err 0 - if { $ret == 0 } { - set ret 1 - } - } - -} else { - # Make sure that we succeed if we're locking the same object as - # oldest or youngest. - if { [expr $myid % 2] == 0 } { - set mode read - } else { - set mode write - } - # Obtain first lock (should always succeed). - if {[catch {$myenv lock_get $mode $lockerid $myid} lock1] != 0} { - puts $errorInfo - } else { - error_check_good lockget:$myid [is_substr $lock1 $myenv] 1 - } - - tclsleep 30 - - set nextobj [expr $myid + 1] - if { $nextobj == [expr $numprocs - 1] } { - set nextobj 1 - } - - set ret 1 - if {[catch {$myenv lock_get write $lockerid $nextobj} lock2] != 0} { - if {[string match "*DEADLOCK*" $lock2] == 1} { - set ret DEADLOCK - } else { - set ret ERROR - } - } else { - error_check_good lockget:$nextobj [is_substr $lock2 $myenv] 1 - } - - # Now release the first lock - error_check_good lockput:$lock1 [$lock1 put] 0 - - if {$ret == 1} { - error_check_bad lockget:$nextobj $lock2 NULL - error_check_good lockget:$nextobj [is_substr $lock2 $myenv] 1 - error_check_good lockput:$lock2 [$lock2 put] 0 - } -} - -puts $ret -error_check_good lock_id_free [$myenv lock_id_free $lockerid] 0 -error_check_good envclose [$myenv close] 0 -exit |