gecko-dev/db/test/mlock.tcl

176 строки
4.5 KiB
Tcl

# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998
# Sleepycat Software. All rights reserved.
#
# @(#)mlock.tcl 10.4 (Sleepycat) 4/10/98
#
# Exercise multi-process aspects of lock.
proc lock004 { {maxlocks 1000} {conflicts {0 0 0 0 0 1 0 1 1} } } {
source ./include.tcl
puts "Lock004: Basic multi-process lock tests."
lock_cleanup $testdir
set nmodes [isqrt [llength $conflicts]]
# Open the lock
mlock_open $maxlocks $nmodes $conflicts
mlock_wait
set r [lock_unlink $testdir 0]
error_check_good lock_unlink $r 0
}
# Make sure that we can create a region; destroy it, attach to it,
# detach from it, etc.
proc mlock_open { maxl nmodes conf } {
source ./include.tcl
puts "Lock004.a multi-process open/close test"
# Open/Create region here. Then close it and try to open from
# other test process.
set lp [lock_open "" $DB_CREATE 0644 \
-maxlocks $maxl -nmodes $nmodes -conflicts $conf]
error_check_bad lock_open $lp NULL
set ret [ $lp close ]
error_check_good lock_close $ret 0
set f1 [open |./dbtest r+]
puts $f1 "set lp \[lock_open \"\" 0 0 \]"
puts $f1 "puts \$lp"
puts $f1 "flush stdout"
flush $f1
set r [gets $f1 result]
error_check_bad remote:lock_open $r -1
error_check_bad remote:lock_open $result NULL
# Now make sure that we can reopen the region.
set lp [lock_open "" 0 0]
error_check_bad lock_open $lp NULL
error_check_good lock_open [is_substr $lp lockmgr] 1
# Try closing the remote region
puts $f1 "set ret \[\$lp close\]"
puts $f1 "puts \$ret"
puts $f1 "flush stdout"
flush $f1
set r [gets $f1 result]
error_check_good remote:lock_close $result 0
# Try opening for create. Will succeed because region exists.
puts $f1 "set lp \[lock_open \"\" $DB_CREATE 0644 -maxlocks $maxl -nmodes $nmodes -conflicts $conf\]"
puts $f1 "puts \$lp"
puts $f1 "flush stdout"
flush $f1
set r [gets $f1 result]
error_check_bad remote:lock_open $result NULL
error_check_good remote:lock_open [is_substr $result lockmgr] 1
# close locally
set r [$lp close]
error_check_good lock_close $r 0
# Close and exit remote
puts $f1 "set r \[\$lp close\]"
puts $f1 "puts \$r"
puts $f1 "flush stdout"
flush $f1
set r [gets $f1 result]
error_check_good remote_lock_close $result 0
catch { close $f1 } result
puts "Exiting mlock_open"
}
proc mlock_wait { } {
source ./include.tcl
puts "Entering wait test"
# Open region locally
set lp [lock_open "" 0 0]
error_check_bad lock_open $lp NULL
# Open region remotely
set f1 [open |./dbtest r+]
puts $f1 "set lp \[lock_open \"\" 0 0 \]"
puts $f1 "puts \$lp"
puts $f1 "flush stdout"
flush $f1
debug_check
exec $SLEEP 5
set r [gets $f1 result]
error_check_bad remote:lock_open $r -1
error_check_bad remote:lock_open $result NULL
# Get a write lock locally; try for the read lock
# remotely. We hold the locks for several seconds
# so that we can use timestamps to figure out if the
# other process waited.
set locker 1
set l1 [$lp get $locker object1 $DB_LOCK_WRITE 0]
error_check_bad lock_get $l1 NULL
error_check_good lock_get [is_substr $l1 $lp] 1
# Now request a lock that we expect to hang; generate
# timestamps so we can tell if it actually hangs.
set locker 2
puts $f1 "set start \[timestamp -r\]"
puts $f1 "set l \[\$lp get $locker object1 $DB_LOCK_READ 0\]"
puts $f1 "puts \[expr \[timestamp -r\] - \$start\]"
puts $f1 "flush stdout"
flush $f1
# Now sleep before releasing lock
exec $SLEEP 5
set result [$l1 put]
error_check_good lock_put $result 0
# Now get the result from the other script
set r [gets $f1 result]
error_check_good lock_get:remote_time [expr $result > 4] 1
# Now make the other guy wait 5 second and then release his
# lock while we try to get a write lock on it
puts $f1 "exec $SLEEP 5"
puts $f1 "set r \[\$l put\]"
puts $f1 "puts \$r"
puts $f1 "flush stdout"
flush $f1
set locker 1
set start [timestamp -r]
set l [$lp get $locker object1 $DB_LOCK_WRITE 0]
error_check_good lock_get:time \
[expr [expr [timestamp -r] - $start] > 4] 1
error_check_bad lock_get:local $l NULL
error_check_good lock_get:local [is_substr $l $lp] 1
# Now check remote's result
set r [gets $f1 result]
error_check_good lock_put:remote $result 0
# Clean up remote
puts $f1 "set r \[\$lp close\]"
puts $f1 "puts \$r"
puts $f1 "flush stdout"
flush $f1
set r [gets $f1 result]
error_check_good lock_close:remote $result 0
close $f1
# Now close up locally
set r [$l put]
error_check_good lock_put $r 0
set r [$lp close]
error_check_good lock_close $r 0
}