← Back to branch summary

~ubuntu-branches/ubuntu/edgy/rpm/edgy

« back to all changes in this revision

Viewing changes to db/test/lock003.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2002-01-22 20:56:57 UTC
  • Revision ID: james.westby@ubuntu.com-20020122205657-l74j50mr9z8ofcl5
Tags: upstream-4.0.3
Import upstream version 4.0.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
db/test/lock003.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1996-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: lock003.tcl,v 11.19 2001/05/17 20:37:05 bostic Exp $
 
7
#
 
8
# Exercise multi-process aspects of lock.  Generate a bunch of parallel
 
9
# testers that try to randomly obtain locks;  make sure that the locks
 
10
# correctly protect corresponding objects.
 
11
proc lock003 { dir {iter 500} {max 1000} {procs 5} {ldegree 5} {objs 75} \
 
12
        {reads 65} {wait 1} {conflicts { 3 0 0 0 0 0 1 0 1 1}} {seeds {}} } {
 
13
        source ./include.tcl
 
14
 
 
15
        puts "Lock003: Multi-process random lock test"
 
16
 
 
17
        # Clean up after previous runs
 
18
        env_cleanup $dir
 
19
 
 
20
        # Open/create the lock region
 
21
        set e [berkdb env -create -lock -home $dir]
 
22
        error_check_good env_open [is_substr $e env] 1
 
23
 
 
24
        set ret [$e close]
 
25
        error_check_good env_close $ret 0
 
26
 
 
27
        # Now spawn off processes
 
28
        set pidlist {}
 
29
 
 
30
        for { set i 0 } {$i < $procs} {incr i} {
 
31
                if { [llength $seeds] == $procs } {
 
32
                        set s [lindex $seeds $i]
 
33
                }
 
34
                puts "$tclsh_path\
 
35
                    $test_path/wrap.tcl \
 
36
                    lockscript.tcl $dir/$i.lockout\
 
37
                    $dir $iter $objs $wait $ldegree $reads &"
 
38
                set p [exec $tclsh_path $test_path/wrap.tcl \
 
39
                    lockscript.tcl $testdir/lock003.$i.out \
 
40
                    $dir $iter $objs $wait $ldegree $reads &]
 
41
                lappend pidlist $p
 
42
        }
 
43
 
 
44
        puts "Lock003: $procs independent processes now running"
 
45
        watch_procs 30 10800
 
46
 
 
47
        # Check for test failure
 
48
        set e [eval findfail [glob $testdir/lock003.*.out]]
 
49
        error_check_good "FAIL: error message(s) in log files" $e 0
 
50
 
 
51
        # Remove log files
 
52
        for { set i 0 } {$i < $procs} {incr i} {
 
53
                fileremove -f $dir/lock003.$i.out
 
54
        }
 
55
}
 
56
 
 
57
# Create and destroy flag files to show we have an object locked, and
 
58
# verify that the correct files exist or don't exist given that we've
 
59
# just read or write locked a file.
 
60
proc lock003_create { rw obj } {
 
61
        source ./include.tcl
 
62
 
 
63
        set pref $testdir/L3FLAG
 
64
        set f [open $pref.$rw.[pid].$obj w]
 
65
        close $f
 
66
}
 
67
 
 
68
proc lock003_destroy { obj } {
 
69
        source ./include.tcl
 
70
 
 
71
        set pref $testdir/L3FLAG
 
72
        set f [glob -nocomplain $pref.*.[pid].$obj]
 
73
        error_check_good l3_destroy [llength $f] 1
 
74
        fileremove $f
 
75
}
 
76
 
 
77
proc lock003_vrfy { rw obj } {
 
78
        source ./include.tcl
 
79
 
 
80
        set pref $testdir/L3FLAG
 
81
        if { [string compare $rw "write"] == 0 } {
 
82
                set fs [glob -nocomplain $pref.*.*.$obj]
 
83
                error_check_good "number of other locks on $obj" [llength $fs] 0
 
84
        } else {
 
85
                set fs [glob -nocomplain $pref.write.*.$obj]
 
86
                error_check_good "number of write locks on $obj" [llength $fs] 0
 
87
        }
 
88
}
 
89