1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: lock003.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	lock003
8# TEST	Exercise multi-process aspects of lock.  Generate a bunch of parallel
9# TEST	testers that try to randomly obtain locks;  make sure that the locks
10# TEST	correctly protect corresponding objects.
11proc lock003 { {iter 500} {max 1000} {procs 5} } {
12	source ./include.tcl
13	global lock_curid
14	global lock_maxid
15
16	set ldegree 5
17	set objs 75
18	set reads 65
19	set wait 1
20	set conflicts { 0 0 0 0 0 1 0 1 1}
21	set seeds {}
22
23	puts "Lock003: Multi-process random lock test"
24
25	# Clean up after previous runs
26	env_cleanup $testdir
27
28	# Open/create the lock region
29	puts "\tLock003.a: Create environment"
30	set e [berkdb_env -create -lock -home $testdir]
31	error_check_good env_open [is_substr $e env] 1
32	$e lock_id_set $lock_curid $lock_maxid
33
34	error_check_good env_close [$e close] 0
35
36	# Now spawn off processes
37	set pidlist {}
38
39	for { set i 0 } {$i < $procs} {incr i} {
40		if { [llength $seeds] == $procs } {
41			set s [lindex $seeds $i]
42		}
43#		puts "$tclsh_path\
44#		    $test_path/wrap.tcl \
45#		    lockscript.tcl $testdir/$i.lockout\
46#		    $testdir $iter $objs $wait $ldegree $reads &"
47		set p [exec $tclsh_path $test_path/wrap.tcl \
48		    lockscript.tcl $testdir/lock003.$i.out \
49		    $testdir $iter $objs $wait $ldegree $reads &]
50		lappend pidlist $p
51	}
52
53	puts "\tLock003.b: $procs independent processes now running"
54	watch_procs $pidlist 30 10800
55
56	# Check for test failure
57	set errstrings [eval findfail [glob $testdir/lock003.*.out]]
58	foreach str $errstrings {
59		puts "FAIL: error message in .out file: $str"
60	}
61
62	# Remove log files
63	for { set i 0 } {$i < $procs} {incr i} {
64		fileremove -f $testdir/lock003.$i.out
65	}
66}
67
68# Create and destroy flag files to show we have an object locked, and
69# verify that the correct files exist or don't exist given that we've
70# just read or write locked a file.
71proc lock003_create { rw obj } {
72	source ./include.tcl
73
74	set pref $testdir/L3FLAG
75	set f [open $pref.$rw.[pid].$obj w]
76	close $f
77}
78
79proc lock003_destroy { obj } {
80	source ./include.tcl
81
82	set pref $testdir/L3FLAG
83	set f [glob -nocomplain $pref.*.[pid].$obj]
84	error_check_good l3_destroy [llength $f] 1
85	fileremove $f
86}
87
88proc lock003_vrfy { rw obj } {
89	source ./include.tcl
90
91	set pref $testdir/L3FLAG
92	if { [string compare $rw "write"] == 0 } {
93		set fs [glob -nocomplain $pref.*.*.$obj]
94		error_check_good "number of other locks on $obj" [llength $fs] 0
95	} else {
96		set fs [glob -nocomplain $pref.write.*.$obj]
97		error_check_good "number of write locks on $obj" [llength $fs] 0
98	}
99}
100
101