MySQL数据库

开发平台：
Visual C++

lock002.tcl：源码内容
							# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998, 1999, 2000
#	Sleepycat Software.  All rights reserved.
#
#	$Id: lock002.tcl,v 11.10 2000/08/25 14:21:51 sue Exp $
#
# Exercise basic multi-process aspects of lock.
proc lock002 { {maxlocks 1000} {conflicts {0 0 0 0 0 1 0 1 1} } } {
	source ./include.tcl
	puts "Lock002: Basic multi-process lock tests."
	env_cleanup $testdir
	set nmodes [isqrt [llength $conflicts]]
	# Open the lock
	mlock_open $maxlocks $nmodes $conflicts
	mlock_wait
}
# Make sure that we can create a region; destroy it, attach to it,
# detach from it, etc.
proc mlock_open { maxl nmodes conflicts } {
	source ./include.tcl
	puts "Lock002.a multi-process open/close test"
	# Open/Create region here.  Then close it and try to open from
	# other test process.
	set env_cmd [concat "berkdb env -create -mode 0644 
	    -lock -lock_max $maxl -lock_conflict" 
	    [list [list $nmodes $conflicts]] "-home $testdir"]
	set local_env [eval $env_cmd]
	error_check_good env_open [is_valid_env $local_env] TRUE
	set ret [$local_env close]
	error_check_good env_close $ret 0
	# Open from other test process
	set env_cmd "berkdb env -mode 0644 -home $testdir"
	set f1 [open |$tclsh_path r+]
	puts $f1 "source $test_path/test.tcl"
	set remote_env [send_cmd $f1 $env_cmd]
	error_check_good remote:env_open [is_valid_env $remote_env] TRUE
	# Now make sure that we can reopen the region.
	set local_env [eval $env_cmd]
	error_check_good env_open [is_valid_env $local_env] TRUE
	set ret [$local_env close]
	error_check_good env_close $ret 0
	# Try closing the remote region
	set ret [send_cmd $f1 "$remote_env close"]
	error_check_good remote:lock_close $ret 0
	# Try opening for create.  Will succeed because region exists.
	set env_cmd [concat "berkdb env -create -mode 0644 
	    -lock -lock_max $maxl -lock_conflict" 
	    [list [list $nmodes $conflicts]] "-home $testdir"]
	set local_env [eval $env_cmd]
	error_check_good remote:env_open [is_valid_env $local_env] TRUE
	# close locally
	reset_env $local_env
	# Close and exit remote
	set ret [send_cmd $f1 "reset_env $remote_env"]
	catch { close $f1 } result
}
proc mlock_wait { } {
	source ./include.tcl
	puts "Lock002.b multi-process get/put wait test"
	# Open region locally
	set env_cmd "berkdb env -lock -home $testdir"
	set local_env [eval $env_cmd]
	error_check_good env_open [is_valid_env $local_env] TRUE
	# Open region remotely
	set f1 [open |$tclsh_path r+]
	puts $f1 "source $test_path/test.tcl"
	set remote_env [send_cmd $f1 $env_cmd]
	error_check_good remote:env_open [is_valid_env $remote_env] TRUE
	# 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 local_lock [$local_env lock_get write $locker object1]
	error_check_good lock_get [is_valid_lock $local_lock $local_env] TRUE
	# Now request a lock that we expect to hang; generate
	# timestamps so we can tell if it actually hangs.
	set locker 2
	set remote_lock [send_timed_cmd $f1 1 
	    "set lock [$remote_env lock_get write $locker object1]"]
	# Now sleep before releasing lock
	tclsleep 5
	set result [$local_lock put]
	error_check_good lock_put $result 0
	# Now get the result from the other script
	set result [rcv_result $f1]
	error_check_good lock_get:remote_time [expr $result > 4] 1
	# Now get the remote lock
	set remote_lock [send_cmd $f1 "puts $lock"]
	error_check_good remote:lock_get 
	    [is_valid_lock $remote_lock $remote_env] TRUE
	# Now make the other guy wait 5 second and then release his
	# lock while we try to get a write lock on it
	set start [timestamp -r]
	set ret [send_cmd $f1 "tclsleep 5"]
	set ret [send_cmd $f1 "$remote_lock put"]
	set locker 1
	set local_lock [$local_env lock_get write $locker object1]
	error_check_good lock_get:time 
	    [expr [expr [timestamp -r] - $start] > 2] 1
	error_check_good lock_get:local 
	    [is_valid_lock $local_lock $local_env] TRUE
	# Now check remote's result
	set result [rcv_result $f1]
	error_check_good lock_put:remote $result 0
	# Clean up remote
	set ret [send_cmd $f1 "reset_env $remote_env"]
	close $f1
	# Now close up locally
	set ret [$local_lock put]
	error_check_good lock_put $ret 0
	reset_env $local_env
}

						