blob: 91a8a2e90f625c33c6fb0c23f6b303880ef762a6 (
plain)
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2002
# Sleepycat Software. All rights reserved.
#
# $Id: lock003.tcl,v 11.25 2002/09/05 17:23:06 sandstro Exp $
#
# TEST lock003
# TEST Exercise multi-process aspects of lock. Generate a bunch of parallel
# TEST testers that try to randomly obtain locks; make sure that the locks
# TEST correctly protect corresponding objects.
proc lock003 { {iter 500} {max 1000} {procs 5} } {
source ./include.tcl
global lock_curid
global lock_maxid
set ldegree 5
set objs 75
set reads 65
set wait 1
set conflicts { 0 0 0 0 0 1 0 1 1}
set seeds {}
puts "Lock003: Multi-process random lock test"
# Clean up after previous runs
env_cleanup $testdir
# Open/create the lock region
puts "\tLock003.a: Create environment"
set e [berkdb_env -create -lock -home $testdir]
error_check_good env_open [is_substr $e env] 1
$e lock_id_set $lock_curid $lock_maxid
error_check_good env_close [$e close] 0
# Now spawn off processes
set pidlist {}
for { set i 0 } {$i < $procs} {incr i} {
if { [llength $seeds] == $procs } {
set s [lindex $seeds $i]
}
# puts "$tclsh_path\
# $test_path/wrap.tcl \
# lockscript.tcl $testdir/$i.lockout\
# $testdir $iter $objs $wait $ldegree $reads &"
set p [exec $tclsh_path $test_path/wrap.tcl \
lockscript.tcl $testdir/lock003.$i.out \
$testdir $iter $objs $wait $ldegree $reads &]
lappend pidlist $p
}
puts "\tLock003.b: $procs independent processes now running"
watch_procs $pidlist 30 10800
# Check for test failure
set e [eval findfail [glob $testdir/lock003.*.out]]
error_check_good "FAIL: error message(s) in log files" $e 0
# Remove log files
for { set i 0 } {$i < $procs} {incr i} {
fileremove -f $testdir/lock003.$i.out
}
}
# Create and destroy flag files to show we have an object locked, and
# verify that the correct files exist or don't exist given that we've
# just read or write locked a file.
proc lock003_create { rw obj } {
source ./include.tcl
set pref $testdir/L3FLAG
set f [open $pref.$rw.[pid].$obj w]
close $f
}
proc lock003_destroy { obj } {
source ./include.tcl
set pref $testdir/L3FLAG
set f [glob -nocomplain $pref.*.[pid].$obj]
error_check_good l3_destroy [llength $f] 1
fileremove $f
}
proc lock003_vrfy { rw obj } {
source ./include.tcl
set pref $testdir/L3FLAG
if { [string compare $rw "write"] == 0 } {
set fs [glob -nocomplain $pref.*.*.$obj]
error_check_good "number of other locks on $obj" [llength $fs] 0
} else {
set fs [glob -nocomplain $pref.write.*.$obj]
error_check_good "number of write locks on $obj" [llength $fs] 0
}
}
|
