← Back to branch summary

~ubuntu-branches/ubuntu/maverick/evolution-data-server/maverick-proposed

« back to all changes in this revision

Viewing changes to libdb/test/recd008.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Didier Roche
  • Date: 2010-05-17 17:02:06 UTC
  • mfrom: (1.1.79 upstream) (1.6.12 experimental)
  • Revision ID: james.westby@ubuntu.com-20100517170206-4ufr52vwrhh26yh0
Tags: 2.30.1-1ubuntu1
https://launchpad.net/bugs/42199
https://launchpad.net/bugs/229669
https://launchpad.net/bugs/173703
https://launchpad.net/bugs/360344
https://launchpad.net/bugs/508494
* Merge from debian experimental. Remaining change:
  (LP: #42199, #229669, #173703, #360344, #508494)
  + debian/control:
    - add Vcs-Bzr tag
    - don't use libgnome
    - Use Breaks instead of Conflicts against evolution 2.25 and earlier.
  + debian/evolution-data-server.install,
    debian/patches/45_libcamel_providers_version.patch:
    - use the upstream versioning, not a Debian-specific one 
  + debian/libedata-book1.2-dev.install, debian/libebackend-1.2-dev.install,
    debian/libcamel1.2-dev.install, debian/libedataserverui1.2-dev.install:
    - install html documentation
  + debian/rules:
    - don't build documentation it's shipped with the tarball

Show diffs side-by-side

added added

removed removed

Lines of Context:
libdb/test/recd008.tcl
1
 
# See the file LICENSE for redistribution information.
2
 
#
3
 
# Copyright (c) 1996-2002
4
 
#       Sleepycat Software.  All rights reserved.
5
 
#
6
 
# $Id$
7
 
#
8
 
# TEST  recd008
9
 
# TEST  Test deeply nested transactions and many-child transactions.
10
 
proc recd008 { method {breadth 4} {depth 4} args} {
11
 
        global kvals
12
 
        source ./include.tcl
13
 
 
14
 
        set args [convert_args $method $args]
15
 
        set omethod [convert_method $method]
16
 
 
17
 
        if { [is_record_based $method] == 1 } {
18
 
                puts "Recd008 skipping for method $method"
19
 
                return
20
 
        }
21
 
        puts "Recd008: $method $breadth X $depth deeply nested transactions"
22
 
 
23
 
        # Create the database and environment.
24
 
        env_cleanup $testdir
25
 
 
26
 
        set dbfile recd008.db
27
 
 
28
 
        puts "\tRecd008.a: create database"
29
 
        set db [eval {berkdb_open -create} $args $omethod $testdir/$dbfile]
30
 
        error_check_good dbopen [is_valid_db $db] TRUE
31
 
 
32
 
        # Make sure that we have enough entries to span a couple of
33
 
        # different pages.
34
 
        set did [open $dict]
35
 
        set count 0
36
 
        while { [gets $did str] != -1 && $count < 1000 } {
37
 
                if { [string compare $omethod "-recno"] == 0 } {
38
 
                        set key [expr $count + 1]
39
 
                } else {
40
 
                        set key $str
41
 
                }
42
 
                if { $count == 500} {
43
 
                        set p1 $key
44
 
                        set kvals($p1) $str
45
 
                }
46
 
                set ret [$db put $key $str]
47
 
                error_check_good put $ret 0
48
 
 
49
 
                incr count
50
 
        }
51
 
        close $did
52
 
        error_check_good db_close [$db close] 0
53
 
 
54
 
        set txn_max [expr int([expr pow($breadth,$depth)])]
55
 
        if { $txn_max < 20 } {
56
 
                set txn_max 20
57
 
        }
58
 
        puts "\tRecd008.b: create environment for $txn_max transactions"
59
 
 
60
 
        set eflags "-mode 0644 -create -txn_max $txn_max \
61
 
            -txn -home $testdir"
62
 
        set env_cmd "berkdb_env $eflags"
63
 
        set dbenv [eval $env_cmd]
64
 
        error_check_good env_open [is_valid_env $dbenv] TRUE
65
 
 
66
 
        reset_env $dbenv
67
 
 
68
 
        set rlist {
69
 
        { {recd008_parent abort ENV DB $p1 TXNID 1 1 $breadth $depth}
70
 
                "Recd008.c: child abort parent" }
71
 
        { {recd008_parent commit ENV DB $p1 TXNID 1 1 $breadth $depth}
72
 
                "Recd008.d: child commit parent" }
73
 
        }
74
 
        foreach pair $rlist {
75
 
                set cmd [subst [lindex $pair 0]]
76
 
                set msg [lindex $pair 1]
77
 
                op_recover abort $testdir $env_cmd $dbfile $cmd $msg
78
 
                recd008_setkval $dbfile $p1
79
 
                op_recover commit $testdir $env_cmd $dbfile $cmd $msg
80
 
                recd008_setkval $dbfile $p1
81
 
        }
82
 
 
83
 
        puts "\tRecd008.e: Verify db_printlog can read logfile"
84
 
        set tmpfile $testdir/printlog.out
85
 
        set stat [catch {exec $util_path/db_printlog -h $testdir \
86
 
            > $tmpfile} ret]
87
 
        error_check_good db_printlog $stat 0
88
 
        fileremove $tmpfile
89
 
}
90
 
 
91
 
proc recd008_setkval { dbfile p1 } {
92
 
        global kvals
93
 
        source ./include.tcl
94
 
 
95
 
        set db [berkdb_open $testdir/$dbfile]
96
 
        error_check_good dbopen [is_valid_db $db] TRUE
97
 
        set ret [$db get $p1]
98
 
        set kvals($p1) [lindex [lindex $ret 0] 1]
99
 
}
100
 
 
101
 
# This is a lot like the op_recover procedure.  We cannot use that
102
 
# because it was not meant to be called recursively.  This proc
103
 
# knows about depth/breadth and file naming so that recursive calls
104
 
# don't overwrite various initial and afterop files, etc.
105
 
#
106
 
# The basic flow of this is:
107
 
#       (Initial file)
108
 
#       Parent begin transaction (in op_recover)
109
 
#       Parent starts children
110
 
#               Recursively call recd008_recover
111
 
#               (children modify p1)
112
 
#       Parent modifies p1
113
 
#       (Afterop file)
114
 
#       Parent commit/abort (in op_recover)
115
 
#       (Final file)
116
 
#       Recovery test (in op_recover)
117
 
proc recd008_parent { op env db p1key parent b0 d0 breadth depth } {
118
 
        global kvals
119
 
        source ./include.tcl
120
 
 
121
 
        #
122
 
        # Save copy of original data
123
 
        # Acquire lock on data
124
 
        #
125
 
        set olddata $kvals($p1key)
126
 
        set ret [$db get -rmw -txn $parent $p1key]
127
 
        set Dret [lindex [lindex $ret 0] 1]
128
 
        error_check_good get_parent_RMW $Dret $olddata
129
 
 
130
 
        #
131
 
        # Parent spawns off children
132
 
        #
133
 
        set ret [recd008_txn $op $env $db $p1key $parent \
134
 
            $b0 $d0 $breadth $depth]
135
 
 
136
 
        puts "Child runs complete.  Parent modifies data."
137
 
 
138
 
        #
139
 
        # Parent modifies p1
140
 
        #
141
 
        set newdata $olddata.parent
142
 
        set ret [$db put -txn $parent $p1key $newdata]
143
 
        error_check_good db_put $ret 0
144
 
 
145
 
        #
146
 
        # Save value in kvals for later comparison
147
 
        #
148
 
        switch $op {
149
 
                "commit" {
150
 
                        set kvals($p1key) $newdata
151
 
                }
152
 
                "abort" {
153
 
                        set kvals($p1key) $olddata
154
 
                }
155
 
        }
156
 
        return 0
157
 
}
158
 
 
159
 
proc recd008_txn { op env db p1key parent b0 d0 breadth depth } {
160
 
        global log_log_record_types
161
 
        global kvals
162
 
        source ./include.tcl
163
 
 
164
 
        for {set d 1} {$d < $d0} {incr d} {
165
 
                puts -nonewline "\t"
166
 
        }
167
 
        puts "Recd008_txn: $op parent:$parent $breadth $depth ($b0 $d0)"
168
 
 
169
 
        # Save the initial file and open the environment and the file
170
 
        for {set b $b0} {$b <= $breadth} {incr b} {
171
 
                #
172
 
                # Begin child transaction
173
 
                #
174
 
                set t [$env txn -parent $parent]
175
 
                error_check_bad txn_begin $t NULL
176
 
                error_check_good txn_begin [is_valid_txn $t $env] TRUE
177
 
                set startd [expr $d0 + 1]
178
 
                set child $b:$startd:$t
179
 
                set olddata $kvals($p1key)
180
 
                set newdata $olddata.$child
181
 
                set ret [$db get -rmw -txn $t $p1key]
182
 
                set Dret [lindex [lindex $ret 0] 1]
183
 
                error_check_good get_parent_RMW $Dret $olddata
184
 
 
185
 
                #
186
 
                # Recursively call to set up nested transactions/children
187
 
                #
188
 
                for {set d $startd} {$d <= $depth} {incr d} {
189
 
                        set ret [recd008_txn commit $env $db $p1key $t \
190
 
                            $b $d $breadth $depth]
191
 
                        set ret [recd008_txn abort $env $db $p1key $t \
192
 
                            $b $d $breadth $depth]
193
 
                }
194
 
                #
195
 
                # Modifies p1.
196
 
                #
197
 
                set ret [$db put -txn $t $p1key $newdata]
198
 
                error_check_good db_put $ret 0
199
 
 
200
 
                #
201
 
                # Commit or abort
202
 
                #
203
 
                for {set d 1} {$d < $startd} {incr d} {
204
 
                        puts -nonewline "\t"
205
 
                }
206
 
                puts "Executing txn_$op:$t"
207
 
                error_check_good txn_$op:$t [$t $op] 0
208
 
                for {set d 1} {$d < $startd} {incr d} {
209
 
                        puts -nonewline "\t"
210
 
                }
211
 
                set ret [$db get -rmw -txn $parent $p1key]
212
 
                set Dret [lindex [lindex $ret 0] 1]
213
 
                switch $op {
214
 
                        "commit" {
215
 
                                puts "Command executed and committed."
216
 
                                error_check_good get_parent_RMW $Dret $newdata
217
 
                                set kvals($p1key) $newdata
218
 
                        }
219
 
                        "abort" {
220
 
                                puts "Command executed and aborted."
221
 
                                error_check_good get_parent_RMW $Dret $olddata
222
 
                                set kvals($p1key) $olddata
223
 
                        }
224
 
                }
225
 
        }
226
 
        return 0
227
 
}