blob: bdfd4e29c3382766cad70e877e58965f7f08a1d4 (
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 2012 Oracle and/or its affiliates. All rights reserved.
#
# $Id$
#
# TEST dead002
# TEST Same test as dead001, but use "detect on every collision" instead
# TEST of separate deadlock detector.
proc dead002 { { procs "2 4 10" } {tests "ring clump" } \
{timeout 0} {tnum 002} {pri 0} } {
source ./include.tcl
if {$timeout > 0 && $pri > 0} {
puts "Dead$tnum: Both timeout and priority cannot be set."
return
}
set msg ""
if { $pri == 1 } {
set msg " with priority"
}
puts "Dead$tnum: Deadlock detector tests (detect on every collision)"
env_cleanup $testdir
# Create the environment.
puts "\tDead$tnum.a: creating environment"
set lmode "default"
if { $timeout != 0 } {
set lmode "expire"
}
set env [berkdb_env \
-create -mode 0644 -home $testdir \
-lock -lock_timeout $timeout -lock_detect $lmode]
error_check_good lock_env:open [is_valid_env $env] TRUE
foreach t $tests {
foreach n $procs {
set pidlist ""
sentinel_init
# Fire off the tests
puts "\tDead$tnum: $n procs of test $t $msg"
for { set i 0 } { $i < $n } { incr i } {
set locker [$env lock_id]
if {$pri == 1} {
$env lock_set_priority $locker $i
}
puts "$tclsh_path $test_path/wrap.tcl \
ddscript.tcl $testdir/dead$tnum.log.$i \
$testdir $t $locker $i $n"
set p [exec $tclsh_path $test_path/wrap.tcl \
ddscript.tcl $testdir/dead$tnum.log.$i \
$testdir $t $locker $i $n &]
lappend pidlist $p
# If we're running with timeouts, pause so that
# locks will have a chance to time out.
if { $timeout != 0 } {
tclsleep 2
}
}
watch_procs $pidlist 5
# Now check output
# dead: the number of aborted lockers
# clean: the number of non-aborted lockers
# killed: the highest aborted locker
# kept: the highest non-aborted locker
# In a ring, only one locker is aborted. If testing
# priorities, it should be 0, the lowest priority.
# In a clump, only one locker is not aborted. If testing
# priorities, it should be n, the highest priority.
set dead 0
set clean 0
set other 0
set killed $n
set kept $n
for { set i 0 } { $i < $n } { incr i } {
set did [open $testdir/dead$tnum.log.$i]
while { [gets $did val] != -1 } {
# If the line comes from the
# profiling tool, ignore it.
if { [string first \
"profiling:" $val] == 0 } {
continue
}
switch $val {
DEADLOCK {
incr dead
set killed $i
}
1 {
incr clean
set kept $i
}
default { incr other }
}
}
close $did
}
puts "\tDead$tnum: dead check ..."
dead_check $t $n $timeout $dead $clean $other
if { $pri == 1 } {
if { $t == "ring" } {
# Only the lowest priority killed in a
# ring
error_check_good low_priority_killed \
$killed 0
} elseif { $t == "clump" } {
# All but the highest priority killed in a
# clump
error_check_good high_priority_kept \
$kept [expr $n - 1]
}
}
}
}
fileremove -f $testdir/dd.out
# Remove log files
for { set i 0 } { $i < $n } { incr i } {
fileremove -f $testdir/dead$tnum.log.$i
}
error_check_good lock_env:close [$env close] 0
}
|
