mutex003.tcl 1.46 KB
Newer Older
unknown's avatar
unknown committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2002
#	Sleepycat Software.  All rights reserved.
#
# $Id: mutex003.tcl,v 11.24 2002/09/05 17:23:06 sandstro Exp $
#

# TEST	mutex003
# TEST	Generate a bunch of parallel testers that try to randomly obtain locks.
proc mutex003 { } {
	source ./include.tcl

	set nmutex 20
	set iter 500
	set procs 5
	set mdegree 3
	set wait 2
	puts "Mutex003: Multi-process random mutex test"

	env_cleanup $testdir

	puts "\tMutex003.a: Create environment"
	# Now open the region we'll use for multiprocess testing.
	set env [berkdb_env -create -mode 0644 -lock -home $testdir]
	error_check_good env_open [is_valid_env $env] TRUE

	set mutex [$env mutex 0644 $nmutex]
	error_check_good mutex_init [is_valid_mutex $mutex $env] TRUE

	error_check_good mutex_close [$mutex close] 0

	# Now spawn off processes
	puts "\tMutex003.b: Create $procs processes"
	set pidlist {}
	for { set i 0 } {$i < $procs} {incr i} {
		puts "$tclsh_path\
		    $test_path/mutexscript.tcl $testdir\
		    $iter $nmutex $wait $mdegree > $testdir/$i.mutexout &"
		set p [exec $tclsh_path $test_path/wrap.tcl \
		    mutexscript.tcl $testdir/$i.mutexout $testdir\
		    $iter $nmutex $wait $mdegree &]
		lappend pidlist $p
	}
	puts "\tMutex003.c: $procs independent processes now running"
	watch_procs $pidlist
	error_check_good env_close [$env close] 0
	# Remove output files
	for { set i 0 } {$i < $procs} {incr i} {
		fileremove -f $testdir/$i.mutexout
	}
}