lock001.tcl

这是linux下运行的mysql软件包,可用于linux 下安装 php + mysql + apach 的网络配置

# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2002
#	Sleepycat Software.  All rights reserved.
#
# $Id: lock001.tcl,v 11.19 2002/04/25 19:30:28 sue Exp $
#

# TEST	lock001
# TEST	Make sure that the basic lock tests work.  Do some simple gets
# TEST	and puts for a single locker.
proc lock001 { {iterations 1000} {maxlocks 1000} } {
	source ./include.tcl
	global lock_curid
	global lock_maxid

	set save_curid $lock_curid
	set save_maxid $lock_maxid

	# Set defaults
	# Adjusted to make exact match of isqrt
	#set conflicts { 3 0 0 0 0 0 1 0 1 1}
	#set conflicts { 3 0 0 0 0 1 0 1 1}

	set conflicts { 0 0 0 0 0 1 0 1 1}
	set nmodes [isqrt [llength $conflicts]]

	# Cleanup
	env_cleanup $testdir

	# Open the region we'll use for testing.
	set eflags "-create -lock -home $testdir -mode 0644 \
	    -lock_max $maxlocks -lock_conflict {$nmodes {$conflicts}}"
	set env [eval {berkdb_env} $eflags]
	error_check_good env [is_valid_env $env] TRUE
	error_check_good lock_id_set \
	     [$env lock_id_set $lock_curid $lock_maxid] 0

	puts "Lock001: test basic lock operations"
	set locker [$env lock_id]
	# Get and release each type of lock
	puts "\tLock001.a: get and release each type of lock"
	foreach m {ng write read} {
		set obj obj$m
		set lockp [$env lock_get $m $locker $obj]
		error_check_good lock_get:a [is_blocked $lockp] 0
		error_check_good lock_get:a [is_substr $lockp $env] 1
		set ret [ $lockp put ]
		error_check_good lock_put $ret 0
	}

	# Get a bunch of locks for the same locker; these should work
	set obj OBJECT
	puts "\tLock001.b: Get a bunch of locks for the same locker"
	foreach m {ng write read} {
		set lockp [$env lock_get $m $locker $obj ]
		lappend locklist $lockp
		error_check_good lock_get:b [is_blocked $lockp] 0
		error_check_good lock_get:b [is_substr $lockp $env] 1
	}
	release_list $locklist

	set locklist {}
	# Check that reference counted locks work
	puts "\tLock001.c: reference counted locks."
	for {set i 0} { $i < 10 } {incr i} {
		set lockp [$env lock_get -nowait write $locker $obj]
		error_check_good lock_get:c [is_blocked $lockp] 0
		error_check_good lock_get:c [is_substr $lockp $env] 1
		lappend locklist $lockp
	}
	release_list $locklist

	# Finally try some failing locks
	set locklist {}
	foreach i {ng write read} {
		set lockp [$env lock_get $i $locker $obj]
		lappend locklist $lockp
		error_check_good lock_get:d [is_blocked $lockp] 0
		error_check_good lock_get:d [is_substr $lockp $env] 1
	}

	# Change the locker
	set locker [$env lock_id]
	set blocklist {}
	# Skip NO_LOCK lock.
	puts "\tLock001.d: Change the locker, acquire read and write."
	foreach i {write read} {
		catch {$env lock_get -nowait $i $locker $obj} ret
		error_check_good lock_get:e [is_substr $ret "not granted"] 1
		#error_check_good lock_get:e [is_substr $lockp $env] 1
		#error_check_good lock_get:e [is_blocked $lockp] 0
	}
	# Now release original locks
	release_list $locklist

	# Now re-acquire blocking locks
	set locklist {}
	puts "\tLock001.e: Re-acquire blocking locks."
	foreach i {write read} {
		set lockp [$env lock_get -nowait $i $locker $obj ]
		error_check_good lock_get:f [is_substr $lockp $env] 1
		error_check_good lock_get:f [is_blocked $lockp] 0
		lappend locklist $lockp
	}

	# Now release new locks
	release_list $locklist
	error_check_good free_id [$env lock_id_free $locker] 0

	error_check_good envclose [$env close] 0

}

# Blocked locks appear as lockmgrN.lockM\nBLOCKED
proc is_blocked { l } {
	if { [string compare $l BLOCKED ] == 0 } {
		return 1
	} else {
		return 0
	}
}