File: dead005.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 (143 lines) | stat: -rw-r--r-- 3,669 bytes parent folder | download | duplicates (9)
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
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 2013 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$
#
# Deadlock Test 5.
# Test out the minlocks, maxlocks, and minwrites options
# to the deadlock detector.
proc dead005 { { procs "4 6 10" } \
    {tests "maxlocks maxwrites minlocks minwrites" } { tnum "005" } { pri 0 } } {
	source ./include.tcl

	set msg ""
	if { $pri == 1 } {
		set msg " with priority"
	}
	
	foreach t $tests {
		puts "Dead$tnum.$t: deadlock detection tests"
		env_cleanup $testdir

		# Create the environment.
		set env [berkdb_env -create -mode 0644 -lock -home $testdir]
		error_check_good lock_env:open [is_valid_env $env] TRUE
		case $t {
			maxlocks { set to m }
			maxwrites { set to W }
			minlocks { set to n }
			minwrites { set to w }
		}
		foreach n $procs {
			set dpid [exec $util_path/db_deadlock -v -t 0.100000 \
			    -h $testdir -a $to >& $testdir/dd.out &]
			sentinel_init
			set pidlist ""

			# Fire off the tests
			puts "\tDead$tnum: $t test with $n procs $msg"
			for { set i 0 } { $i < $n } { incr i } {
				set locker [$env lock_id]
				# Configure priorities, if necessary, such that
				# the absolute max or min is a higher priority.
				# The number of locks for each locker is set by
				# countlocks in testutils.tcl.
				if {$pri == 1} {
					if {$t == "maxlocks"} {
						set half [expr $n / 2]
						if {$i < $half} {
							set lk_pri 0
						} else {
							set lk_pri 1
						}
					} elseif {$t == "maxwrites"} {
						if {$i == 0 || $i == 1} {
							set lk_pri 0
						} else {
							set lk_pri 1
						}
					} elseif {$t == "minlocks"} {
						set half [expr $n / 2]
						if {$i >= $half} {
							set lk_pri 0
						} else {
							set lk_pri 1
						}
					} elseif {$t == "minwrites"} {
						if {$i == 0 || $i == 2} {
							set lk_pri 0
						} else {
							set lk_pri 1
						}
					}
					$env lock_set_priority $locker $lk_pri
				}
				puts "$tclsh_path $test_path/wrap.tcl \
				    $testdir/dead$tnum.log.$i \
				    ddscript.tcl $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
			}
			watch_procs $pidlist 5

			# Now check output
			set dead 0
			set clean 0
			set other 0
			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 }
						1 { incr clean }
						default { incr other }
					}
				}
				close $did
			}
			tclkill $dpid
			puts "\tDead$tnum: dead check..."
			dead_check $t $n 0 $dead $clean $other
			# Now verify that the correct participant
			# got deadlocked.
			if {$pri == 0} {
				switch $t {
					maxlocks {set f [expr $n - 1]}
					maxwrites {set f 2}
					minlocks {set f 0}
					minwrites {set f 1}
				}
			} else {
				switch $t {
					maxlocks {set f [expr [expr $n / 2] - 1]}
					maxwrites {set f 0}
					minlocks {set f [expr $n / 2]}
					minwrites {set f 0}
				}
			}

			set did [open $testdir/dead$tnum.log.$f]
			error_check_bad file:$t [gets $did val] -1
			error_check_good read($f):$t $val DEADLOCK
			close $did
		}
		error_check_good lock_env:close [$env close] 0
		# Windows needs files closed before deleting them, so pause
		tclsleep 2
		fileremove -f $testdir/dd.out
		# Remove log files
		for { set i 0 } { $i < $n } { incr i } {
			fileremove -f $testdir/dead$tnum.log.$i
		}
	}
}