File: dead005.tcl

package info (click to toggle)
evolution-data-server 1.0.4-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 39,504 kB
  • ctags: 26,423
  • sloc: ansic: 175,347; tcl: 30,499; sh: 20,699; perl: 11,320; xml: 9,039; java: 7,653; cpp: 6,029; makefile: 4,866; awk: 1,338; yacc: 1,103; sed: 772; cs: 505; lex: 134; asm: 14
file content (87 lines) | stat: -rw-r--r-- 2,406 bytes parent folder | download | duplicates (3)
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
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2002
#	Sleepycat Software.  All rights reserved.
#
# $Id: dead005.tcl,v 1.1.1.1 2003/11/20 22:13:56 toshok Exp $
#
# Deadlock Test 5.
# Test out the minlocks, maxlocks, and minwrites options
# to the deadlock detector.
proc dead005 { { procs "4 6 10" } {tests "maxlocks minwrites minlocks" } } {
	source ./include.tcl

	puts "Dead005: minlocks, maxlocks, and minwrites deadlock detection tests"
	foreach t $tests {
		puts "Dead005.$t: creating environment"
		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 {
			minlocks { set to n }
			maxlocks { set to m }
			minwrites { set to w }
		}
		foreach n $procs {
			set dpid [exec $util_path/db_deadlock -vw -h $testdir \
			    -a $to >& $testdir/dd.out &]
			sentinel_init
			set pidlist ""

			# Fire off the tests
			puts "\tDead005: $t test with $n procs"
			for { set i 0 } { $i < $n } { incr i } {
				set locker [$env lock_id]
				puts "$tclsh_path $test_path/wrap.tcl \
				    $testdir/dead005.log.$i \
				    ddscript.tcl $testdir $t $locker $i $n"
				set p [exec $tclsh_path \
					$test_path/wrap.tcl \
					ddscript.tcl $testdir/dead005.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/dead005.log.$i]
				while { [gets $did val] != -1 } {
					switch $val {
						DEADLOCK { incr dead }
						1 { incr clean }
						default { incr other }
					}
				}
				close $did
			}
			tclkill $dpid
			puts "dead check..."
			dead_check $t $n 0 $dead $clean $other
			# Now verify that the correct participant
			# got deadlocked.
			switch $t {
				minlocks {set f 0}
				minwrites {set f 1}
				maxlocks {set f [expr $n - 1]}
			}
			set did [open $testdir/dead005.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/dead001.log.$i
		}
	}
}