File: dead003.tcl

package info (click to toggle)
db5.3 5.3.28%2Bdfsg2-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 158,500 kB
  • sloc: ansic: 448,411; java: 111,824; tcl: 80,544; sh: 44,264; cs: 33,697; cpp: 21,604; perl: 14,557; xml: 10,799; makefile: 4,077; javascript: 1,998; yacc: 1,003; awk: 965; sql: 801; erlang: 342; python: 216; php: 24; asm: 14
file content (167 lines) | stat: -rw-r--r-- 4,415 bytes parent folder | download | duplicates (8)
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 2013 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$
#
# TEST	dead003
# TEST
# TEST	Same test as dead002, but explicitly specify DB_LOCK_OLDEST and
# TEST	DB_LOCK_YOUNGEST.  Verify the correct lock was aborted/granted.
proc dead003 { {procs "2 4 10"} {tests "ring clump"} {tnum "003"} {pri 0} } {
	source ./include.tcl
	global lock_curid
	global lock_maxid

	set detects { oldest youngest }
	set msg ""
	if { $pri == 1 } {
		set msg " with priority"
	}
	puts "Dead$tnum: Deadlock detector tests: $detects"

	# Create the environment.
	foreach d $detects {
		env_cleanup $testdir
		puts "\tDead$tnum.a: creating environment for $d"
		set env [berkdb_env \
		    -create -mode 0644 -home $testdir -lock -lock_detect $d]
		error_check_good lock_env:open [is_valid_env $env] TRUE

		foreach t $tests {
			foreach n $procs {
				if {$pri == 1 && $n == 2} {
					puts "Skipping test for $n procs \
					    with priority."
				}
				set pidlist ""
				sentinel_init
				set ret [$env lock_id_set \
				     $lock_curid $lock_maxid]
				error_check_good lock_id_set $ret 0

				# 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 testing priorities, set the oldest
					# and youngest lockers to a higher
					# priority, meaning the second oldest
					# or second youngest locker will be
					# aborted.
					if {$pri == 1} {
						if {$i == 0 || \
						    $i == [expr $n - 1]} {
							$env lock_set_priority \
							    $locker 1
						} else {
							$env lock_set_priority \
							    $locker 0
						}
						
					}
					puts "$tclsh_path\
					    test_path/ddscript.tcl $testdir \
					    $t $locker $i $n >& \
					    $testdir/dead$tnum.log.$i"
					set p [exec $tclsh_path \
					    $test_path/wrap.tcl \
					    ddscript.tcl \
					    $testdir/dead$tnum.log.$i $testdir \
					    $t $locker $i $n &]
					lappend pidlist $p
				}
				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.
				# In a clump, only one locker is not aborted.
				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 0 $dead $clean $other
				#
				# If we get here we know we have the
				# correct number of dead/clean procs, as
				# checked by dead_check above.  Now verify
				# that the right process was the one.
				puts "\tDead$tnum: Verify $d locks were aborted"
				if {$pri == 0} {
					set l ""
					if { $d == "oldest" } {
						set l [expr $n - 1]
					}
					if { $d == "youngest" } {
						set l 0
					}
					set did [open $testdir/dead$tnum.log.$l]
					while { [gets $did val] != -1 } {
						# If the line comes from the 
						# profiling tool, ignore it. 
						if { [string first \
						    "profiling:" $val] == 0 } { 
							continue
						}
						error_check_good check_abort \
						    $val 1
					}
					close $did
				} else {
					if {$d == "oldest" && $t == "clump"} {
						error_check_good check_abort \
						    $kept [expr $n - 1]
					}
					if {$d == "oldest" && $t == "ring"} {
						error_check_good check_abort \
						    $killed 1
					}
					if {$d == "youngest" && $t == "clump"} {
						error_check_good check_abort \
						    $kept 0
					}
					if {$d == "youngest" && $t == "ring"} {
						error_check_good check_abort \
						    $killed [expr $n - 2]
					}
				}
			}
		}

		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
	}
}