← 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/recd006.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/recd006.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  recd006
9
 
# TEST  Nested transactions.
10
 
proc recd006 { method {select 0} 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 || [is_rbtree $method] == 1 } {
18
 
                puts "Recd006 skipping for method $method"
19
 
                return
20
 
        }
21
 
        puts "Recd006: $method nested transactions"
22
 
 
23
 
        # Create the database and environment.
24
 
        env_cleanup $testdir
25
 
 
26
 
        set dbfile recd006.db
27
 
        set testfile $testdir/$dbfile
28
 
 
29
 
        puts "\tRecd006.a: create database"
30
 
        set oflags "-create $args $omethod $testfile"
31
 
        set db [eval {berkdb_open} $oflags]
32
 
        error_check_good dbopen [is_valid_db $db] TRUE
33
 
 
34
 
        # Make sure that we have enough entries to span a couple of
35
 
        # different pages.
36
 
        set did [open $dict]
37
 
        set count 0
38
 
        while { [gets $did str] != -1 && $count < 1000 } {
39
 
                if { [string compare $omethod "-recno"] == 0 } {
40
 
                        set key [expr $count + 1]
41
 
                } else {
42
 
                        set key $str
43
 
                }
44
 
 
45
 
                set ret [$db put -nooverwrite $key $str]
46
 
                error_check_good put $ret 0
47
 
 
48
 
                incr count
49
 
        }
50
 
        close $did
51
 
 
52
 
        # Variables used below:
53
 
        # p1: a pair of keys that are likely to be on the same page.
54
 
        # p2: a pair of keys that are likely to be on the same page,
55
 
        # but on a page different than those in p1.
56
 
        set dbc [$db cursor]
57
 
        error_check_good dbc [is_substr $dbc $db] 1
58
 
 
59
 
        set ret [$dbc get -first]
60
 
        error_check_bad dbc_get:DB_FIRST [llength $ret] 0
61
 
        set p1 [lindex [lindex $ret 0] 0]
62
 
        set kvals($p1) [lindex [lindex $ret 0] 1]
63
 
 
64
 
        set ret [$dbc get -next]
65
 
        error_check_bad dbc_get:DB_NEXT [llength $ret] 0
66
 
        lappend p1 [lindex [lindex $ret 0] 0]
67
 
        set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1]
68
 
 
69
 
        set ret [$dbc get -last]
70
 
        error_check_bad dbc_get:DB_LAST [llength $ret] 0
71
 
        set p2 [lindex [lindex $ret 0] 0]
72
 
        set kvals($p2) [lindex [lindex $ret 0] 1]
73
 
 
74
 
        set ret [$dbc get -prev]
75
 
        error_check_bad dbc_get:DB_PREV [llength $ret] 0
76
 
        lappend p2 [lindex [lindex $ret 0] 0]
77
 
        set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1]
78
 
 
79
 
        error_check_good dbc_close [$dbc close] 0
80
 
        error_check_good db_close [$db close] 0
81
 
 
82
 
        # Now create the full transaction environment.
83
 
        set eflags "-create -txn -home $testdir"
84
 
 
85
 
        puts "\tRecd006.b: creating environment"
86
 
        set env_cmd "berkdb_env $eflags"
87
 
        set dbenv [eval $env_cmd]
88
 
        error_check_bad dbenv $dbenv NULL
89
 
 
90
 
        # Reset the environment.
91
 
        reset_env $dbenv
92
 
 
93
 
        set p1 [list $p1]
94
 
        set p2 [list $p2]
95
 
 
96
 
        # List of recovery tests: {CMD MSG} pairs
97
 
        set rlist {
98
 
        { {nesttest DB TXNID ENV 1 $p1 $p2 commit commit}
99
 
                "Recd006.c: children (commit commit)"}
100
 
        { {nesttest DB TXNID ENV 0 $p1 $p2 commit commit}
101
 
                "Recd006.d: children (commit commit)"}
102
 
        { {nesttest DB TXNID ENV 1 $p1 $p2 commit abort}
103
 
                "Recd006.e: children (commit abort)"}
104
 
        { {nesttest DB TXNID ENV 0 $p1 $p2 commit abort}
105
 
                "Recd006.f: children (commit abort)"}
106
 
        { {nesttest DB TXNID ENV 1 $p1 $p2 abort abort}
107
 
                "Recd006.g: children (abort abort)"}
108
 
        { {nesttest DB TXNID ENV 0 $p1 $p2 abort abort}
109
 
                "Recd006.h: children (abort abort)"}
110
 
        { {nesttest DB TXNID ENV 1 $p1 $p2 abort commit}
111
 
                "Recd006.i: children (abort commit)"}
112
 
        { {nesttest DB TXNID ENV 0 $p1 $p2 abort commit}
113
 
                "Recd006.j: children (abort commit)"}
114
 
        }
115
 
 
116
 
        foreach pair $rlist {
117
 
                set cmd [subst [lindex $pair 0]]
118
 
                set msg [lindex $pair 1]
119
 
                if { $select != 0 } {
120
 
                        set tag [lindex $msg 0]
121
 
                        set tail [expr [string length $tag] - 2]
122
 
                        set tag [string range $tag $tail $tail]
123
 
                        if { [lsearch $select $tag] == -1 } {
124
 
                                continue
125
 
                        }
126
 
                }
127
 
                op_recover abort $testdir $env_cmd $dbfile $cmd $msg
128
 
                op_recover commit $testdir $env_cmd $dbfile $cmd $msg
129
 
        }
130
 
 
131
 
        puts "\tRecd006.k: Verify db_printlog can read logfile"
132
 
        set tmpfile $testdir/printlog.out
133
 
        set stat [catch {exec $util_path/db_printlog -h $testdir \
134
 
            > $tmpfile} ret]
135
 
        error_check_good db_printlog $stat 0
136
 
        fileremove $tmpfile
137
 
}
138
 
 
139
 
# Do the nested transaction test.
140
 
# We want to make sure that children inherit properly from their
141
 
# parents and that locks are properly handed back to parents
142
 
# and that the right thing happens on commit/abort.
143
 
# In particular:
144
 
#       Write lock on parent, properly acquired by child.
145
 
#       Committed operation on child gives lock to parent so that
146
 
#               other child can also get the lock.
147
 
#       Aborted op by child releases lock so other child can get it.
148
 
#       Correct database state if child commits
149
 
#       Correct database state if child aborts
150
 
proc nesttest { db parent env do p1 p2 child1 child2} {
151
 
        global kvals
152
 
        source ./include.tcl
153
 
 
154
 
        if { $do == 1 } {
155
 
                set func toupper
156
 
        } else {
157
 
                set func tolower
158
 
        }
159
 
 
160
 
        # Do an RMW on the parent to get a write lock.
161
 
        set p10 [lindex $p1 0]
162
 
        set p11 [lindex $p1 1]
163
 
        set p20 [lindex $p2 0]
164
 
        set p21 [lindex $p2 1]
165
 
 
166
 
        set ret [$db get -rmw -txn $parent $p10]
167
 
        set res $ret
168
 
        set Dret [lindex [lindex $ret 0] 1]
169
 
        if { [string compare $Dret $kvals($p10)] == 0 ||
170
 
            [string compare $Dret [string toupper $kvals($p10)]] == 0 } {
171
 
                set val 0
172
 
        } else {
173
 
                set val $Dret
174
 
        }
175
 
        error_check_good get_parent_RMW $val 0
176
 
 
177
 
        # OK, do child 1
178
 
        set kid1 [$env txn -parent $parent]
179
 
        error_check_good kid1 [is_valid_txn $kid1 $env] TRUE
180
 
 
181
 
        # Reading write-locked parent object should be OK
182
 
        #puts "\tRead write-locked parent object for kid1."
183
 
        set ret [$db get -txn $kid1 $p10]
184
 
        error_check_good kid1_get10 $ret $res
185
 
 
186
 
        # Now update this child
187
 
        set data [lindex [lindex [string $func $ret] 0] 1]
188
 
        set ret [$db put -txn $kid1 $p10 $data]
189
 
        error_check_good kid1_put10 $ret 0
190
 
 
191
 
        #puts "\tKid1 successful put."
192
 
 
193
 
        # Now start child2
194
 
        #puts "\tBegin txn for kid2."
195
 
        set kid2 [$env txn -parent $parent]
196
 
        error_check_good kid2 [is_valid_txn $kid2 $env] TRUE
197
 
 
198
 
        # Getting anything in the p1 set should deadlock, so let's
199
 
        # work on the p2 set.
200
 
        set data [string $func $kvals($p20)]
201
 
        #puts "\tPut data for kid2."
202
 
        set ret [$db put -txn $kid2 $p20 $data]
203
 
        error_check_good kid2_put20 $ret 0
204
 
 
205
 
        #puts "\tKid2 data put successful."
206
 
 
207
 
        # Now let's do the right thing to kid1
208
 
        puts -nonewline "\tKid1 $child1..."
209
 
        if { [string compare $child1 "commit"] == 0 } {
210
 
                error_check_good kid1_commit [$kid1 commit] 0
211
 
        } else {
212
 
                error_check_good kid1_abort [$kid1 abort] 0
213
 
        }
214
 
        puts "complete"
215
 
 
216
 
        # In either case, child2 should now be able to get the
217
 
        # lock, either because it is inherited by the parent
218
 
        # (commit) or because it was released (abort).
219
 
        set data [string $func $kvals($p11)]
220
 
        set ret [$db put -txn $kid2 $p11 $data]
221
 
        error_check_good kid2_put11 $ret 0
222
 
 
223
 
        # Now let's do the right thing to kid2
224
 
        puts -nonewline "\tKid2 $child2..."
225
 
        if { [string compare $child2 "commit"] == 0 } {
226
 
                error_check_good kid2_commit [$kid2 commit] 0
227
 
        } else {
228
 
                error_check_good kid2_abort [$kid2 abort] 0
229
 
        }
230
 
        puts "complete"
231
 
 
232
 
        # Now, let parent check that the right things happened.
233
 
        # First get all four values
234
 
        set p10_check [lindex [lindex [$db get -txn $parent $p10] 0] 0]
235
 
        set p11_check [lindex [lindex [$db get -txn $parent $p11] 0] 0]
236
 
        set p20_check [lindex [lindex [$db get -txn $parent $p20] 0] 0]
237
 
        set p21_check [lindex [lindex [$db get -txn $parent $p21] 0] 0]
238
 
 
239
 
        if { [string compare $child1 "commit"] == 0 } {
240
 
                error_check_good parent_kid1 $p10_check \
241
 
                    [string tolower [string $func $kvals($p10)]]
242
 
        } else {
243
 
                error_check_good \
244
 
                    parent_kid1 $p10_check [string tolower $kvals($p10)]
245
 
        }
246
 
        if { [string compare $child2 "commit"] == 0 } {
247
 
                error_check_good parent_kid2 $p11_check \
248
 
                    [string tolower [string $func $kvals($p11)]]
249
 
                error_check_good parent_kid2 $p20_check \
250
 
                    [string tolower [string $func $kvals($p20)]]
251
 
        } else {
252
 
                error_check_good parent_kid2 $p11_check $kvals($p11)
253
 
                error_check_good parent_kid2 $p20_check $kvals($p20)
254
 
        }
255
 
 
256
 
        # Now do a write on the parent for 21 whose lock it should
257
 
        # either have or should be available.
258
 
        set ret [$db put -txn $parent $p21 [string $func $kvals($p21)]]
259
 
        error_check_good parent_put21 $ret 0
260
 
 
261
 
        return 0
262
 
}