mariadb/bdb/test/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
}