← 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/sdb012.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/sdb012.tcl
1
 
# See the file LICENSE for redistribution information.
2
 
#
3
 
# Copyright (c) 1999-2002
4
 
#       Sleepycat Software.  All rights reserved.
5
 
#
6
 
# $Id$
7
 
#
8
 
# TEST  subdb012
9
 
# TEST  Test subdbs with locking and transactions
10
 
# TEST  Tests creating and removing subdbs while handles
11
 
# TEST  are open works correctly, and in the face of txns.
12
 
#
13
 
proc subdb012 { method args } {
14
 
        source ./include.tcl
15
 
 
16
 
        set args [convert_args $method $args]
17
 
        set omethod [convert_method $method]
18
 
 
19
 
        if { [is_queue $method] == 1 } {
20
 
                puts "Subdb012: skipping for method $method"
21
 
                return
22
 
        }
23
 
 
24
 
        # If we are using an env, then skip this test.  It needs its own.
25
 
        set eindex [lsearch -exact $args "-env"]
26
 
        if { $eindex != -1 } {
27
 
                incr eindex
28
 
                set env [lindex $args $eindex]
29
 
                puts "Subdb012 skipping for env $env"
30
 
                return
31
 
        }
32
 
        set encargs ""
33
 
        set largs [split_encargs $args encargs]
34
 
 
35
 
        puts "Subdb012: $method ($largs $encargs) subdb txn/locking tests"
36
 
 
37
 
        #
38
 
        # sdb012_body takes a txn list containing 4 elements.
39
 
        # {txn command for first subdb
40
 
        #  txn command for second subdb
41
 
        #  txn command for first subdb removal
42
 
        #  txn command for second subdb removal}
43
 
        #
44
 
        # The allowed commands are 'none' 'one', 'auto', 'abort', 'commit'.
45
 
        # 'none' is a special case meaning run without a txn.  In the
46
 
        # case where all 4 items are 'none', we run in a lock-only env.
47
 
        # 'one' is a special case meaning we create the subdbs together
48
 
        # in one single transaction.  It is indicated as the value for t1,
49
 
        # and the value in t2 indicates if that single txn should be
50
 
        # aborted or committed.  It is not used and has no meaning
51
 
        # in the removal case.  'auto' means use the -auto_commit flag
52
 
        # to the operation, and 'abort' and 'commit' do the obvious.
53
 
        #
54
 
        # First test locking w/o txns.  If any in tlist are 'none',
55
 
        # all must be none.
56
 
        #
57
 
        # Now run through the txn-based operations
58
 
        set count 0
59
 
        set sdb "Subdb012."
60
 
        set teststr "abcdefghijklmnopqrstuvwxyz"
61
 
        set testlet [split $teststr {}]
62
 
        foreach t1 { none one abort auto commit } {
63
 
                foreach t2 { none abort auto commit } {
64
 
                        if { $t1 == "one" } {
65
 
                                if { $t2 == "none" || $t2 == "auto"} {
66
 
                                        continue
67
 
                                }
68
 
                        }
69
 
                        set tlet [lindex $testlet $count]
70
 
                        foreach r1 { none abort auto commit } {
71
 
                                foreach r2 { none abort auto commit } {
72
 
                                        set tlist [list $t1 $t2 $r1 $r2]
73
 
                                        sdb012_body $testdir $omethod $largs \
74
 
                                            $encargs $sdb$tlet $tlist
75
 
                                }
76
 
                        }
77
 
                        incr count
78
 
                }
79
 
        }
80
 
 
81
 
}
82
 
 
83
 
proc s012 { method args } {
84
 
        source ./include.tcl
85
 
 
86
 
        set omethod [convert_method $method]
87
 
 
88
 
        set encargs ""
89
 
        set largs ""
90
 
 
91
 
        puts "Subdb012: $method ($largs $encargs) subdb txn/locking tests"
92
 
 
93
 
        set sdb "Subdb012."
94
 
        set tlet X
95
 
        set tlist $args
96
 
        error_check_good tlist [llength $tlist] 4
97
 
        sdb012_body $testdir $omethod $largs $encargs $sdb$tlet $tlist
98
 
}
99
 
 
100
 
#
101
 
# This proc checks the tlist values and returns the flags
102
 
# that should be used when opening the env.  If we are running
103
 
# with no txns, then just -lock, otherwise -txn.
104
 
#
105
 
proc sdb012_subsys { tlist } {
106
 
        set t1 [lindex $tlist 0]
107
 
        #
108
 
        # If we have no txns, all elements of the list should be none.
109
 
        # In that case we only run with locking turned on.
110
 
        # Otherwise, we use the full txn subsystems.
111
 
        #
112
 
        set allnone {none none none none}
113
 
        if { $allnone == $tlist } {
114
 
                set subsys "-lock"
115
 
        } else {
116
 
                set subsys "-txn"
117
 
        }
118
 
        return $subsys
119
 
}
120
 
 
121
 
#
122
 
# This proc parses the tlist and returns a list of 4 items that
123
 
# should be used in operations.  I.e. it will begin the txns as
124
 
# needed, or return a -auto_commit flag, etc.
125
 
#
126
 
proc sdb012_tflags { env tlist } {
127
 
        set ret ""
128
 
        set t1 ""
129
 
        foreach t $tlist {
130
 
                switch $t {
131
 
                one {
132
 
                        set t1 [$env txn]
133
 
                        error_check_good txnbegin [is_valid_txn $t1 $env] TRUE
134
 
                        lappend ret "-txn $t1"
135
 
                        lappend ret "-txn $t1"
136
 
                }
137
 
                auto {
138
 
                        lappend ret "-auto_commit"
139
 
                }
140
 
                abort -
141
 
                commit {
142
 
                        #
143
 
                        # If the previous command was a "one", skip over
144
 
                        # this commit/abort.  Otherwise start a new txn
145
 
                        # for the removal case.
146
 
                        #
147
 
                        if { $t1 == "" } {
148
 
                                set txn [$env txn]
149
 
                                error_check_good txnbegin [is_valid_txn $txn \
150
 
                                    $env] TRUE
151
 
                                lappend ret "-txn $txn"
152
 
                        } else {
153
 
                                set t1 ""
154
 
                        }
155
 
                }
156
 
                none {
157
 
                        lappend ret ""
158
 
                }
159
 
                default {
160
 
                        error "Txn command $t not implemented"
161
 
                }
162
 
                }
163
 
        }
164
 
        return $ret
165
 
}
166
 
 
167
 
#
168
 
# This proc parses the tlist and returns a list of 4 items that
169
 
# should be used in the txn conclusion operations.  I.e. it will
170
 
# give "" if using auto_commit (i.e. no final txn op), or a single
171
 
# abort/commit if both subdb's are in one txn.
172
 
#
173
 
proc sdb012_top { tflags tlist } {
174
 
        set ret ""
175
 
        set t1 ""
176
 
        #
177
 
        # We know both lists have 4 items.  Iterate over them
178
 
        # using multiple value lists so we know which txn goes
179
 
        # with each op.
180
 
        #
181
 
        # The tflags list is needed to extract the txn command
182
 
        # out for the operation.  The tlist list is needed to
183
 
        # determine what operation we are doing.
184
 
        #
185
 
        foreach t $tlist tf $tflags {
186
 
                switch $t {
187
 
                one {
188
 
                        set t1 [lindex $tf 1]
189
 
                }
190
 
                auto {
191
 
                        lappend ret "sdb012_nop"
192
 
                }
193
 
                abort -
194
 
                commit {
195
 
                        #
196
 
                        # If the previous command was a "one" (i.e. t1
197
 
                        # is set), append a correct command and then
198
 
                        # an empty one.
199
 
                        #
200
 
                        if { $t1 == "" } {
201
 
                                set txn [lindex $tf 1]
202
 
                                set top "$txn $t"
203
 
                                lappend ret $top
204
 
                        } else {
205
 
                                set top "$t1 $t"
206
 
                                lappend ret "sdb012_nop"
207
 
                                lappend ret $top
208
 
                                set t1 ""
209
 
                        }
210
 
                }
211
 
                none {
212
 
                        lappend ret "sdb012_nop"
213
 
                }
214
 
                }
215
 
        }
216
 
        return $ret
217
 
}
218
 
 
219
 
proc sdb012_nop { } {
220
 
        return 0
221
 
}
222
 
 
223
 
proc sdb012_isabort { tlist item } {
224
 
        set i [lindex $tlist $item]
225
 
        if { $i == "one" } {
226
 
                set i [lindex $tlist [expr $item + 1]]
227
 
        }
228
 
        if { $i == "abort" } {
229
 
                return 1
230
 
        } else {
231
 
                return 0
232
 
        }
233
 
}
234
 
 
235
 
proc sdb012_body { testdir omethod largs encargs msg tlist } {
236
 
 
237
 
        puts "\t$msg: $tlist"
238
 
        set testfile subdb012.db
239
 
        set subdb1 sub1
240
 
        set subdb2 sub2
241
 
 
242
 
        set subsys [sdb012_subsys $tlist]
243
 
        env_cleanup $testdir
244
 
        set env [eval {berkdb_env -create -home} $testdir $subsys $encargs]
245
 
        error_check_good dbenv [is_valid_env $env] TRUE
246
 
        error_check_good test_lock [$env test abort subdb_lock] 0
247
 
 
248
 
        #
249
 
        # Convert from our tlist txn commands into real flags we
250
 
        # will pass to commands.  Use the multiple values feature
251
 
        # of foreach to do this efficiently.
252
 
        #
253
 
        set tflags [sdb012_tflags $env $tlist]
254
 
        foreach {txn1 txn2 rem1 rem2} $tflags {break}
255
 
        foreach {top1 top2 rop1 rop2} [sdb012_top $tflags $tlist] {break}
256
 
 
257
 
# puts "txn1 $txn1, txn2 $txn2, rem1 $rem1, rem2 $rem2"
258
 
# puts "top1 $top1, top2 $top2, rop1 $rop1, rop2 $rop2"
259
 
        puts "\t$msg.0: Create sub databases in env with $subsys"
260
 
        set s1 [eval {berkdb_open -env $env -create -mode 0644} \
261
 
            $largs $txn1 {$omethod $testfile $subdb1}]
262
 
        error_check_good dbopen [is_valid_db $s1] TRUE
263
 
 
264
 
        set ret [eval $top1]
265
 
        error_check_good t1_end $ret 0
266
 
 
267
 
        set s2 [eval {berkdb_open -env $env -create -mode 0644} \
268
 
            $largs $txn2 {$omethod $testfile $subdb2}]
269
 
        error_check_good dbopen [is_valid_db $s2] TRUE
270
 
 
271
 
        puts "\t$msg.1: Subdbs are open; resolve txns if necessary"
272
 
        set ret [eval $top2]
273
 
        error_check_good t2_end $ret 0
274
 
 
275
 
        set t1_isabort [sdb012_isabort $tlist 0]
276
 
        set t2_isabort [sdb012_isabort $tlist 1]
277
 
        set r1_isabort [sdb012_isabort $tlist 2]
278
 
        set r2_isabort [sdb012_isabort $tlist 3]
279
 
 
280
 
# puts "t1_isabort $t1_isabort, t2_isabort $t2_isabort, r1_isabort $r1_isabort, r2_isabort $r2_isabort"
281
 
 
282
 
        puts "\t$msg.2: Subdbs are open; verify removal failures"
283
 
        # Verify removes of subdbs with open subdb's fail
284
 
        #
285
 
        # We should fail no matter what.  If we aborted, then the
286
 
        # subdb should not exist.  If we didn't abort, we should fail
287
 
        # with DB_LOCK_NOTGRANTED.
288
 
        #
289
 
        # XXX - Do we need -auto_commit for all these failing ones?
290
 
        set r [ catch {berkdb dbremove -env $env $testfile $subdb1} result ]
291
 
        error_check_bad dbremove1_open $r 0
292
 
        if { $t1_isabort } {
293
 
                error_check_good dbremove1_open_ab [is_substr \
294
 
                    $result "no such file"] 1
295
 
        } else {
296
 
                error_check_good dbremove1_open [is_substr \
297
 
                    $result DB_LOCK_NOTGRANTED] 1
298
 
        }
299
 
 
300
 
        set r [ catch {berkdb dbremove -env $env $testfile $subdb2} result ]
301
 
        error_check_bad dbremove2_open $r 0
302
 
        if { $t2_isabort } {
303
 
                error_check_good dbremove2_open_ab [is_substr \
304
 
                    $result "no such file"] 1
305
 
        } else {
306
 
                error_check_good dbremove2_open [is_substr \
307
 
                    $result DB_LOCK_NOTGRANTED] 1
308
 
        }
309
 
 
310
 
        # Verify file remove fails
311
 
        set r [catch {berkdb dbremove -env $env $testfile} result]
312
 
        error_check_bad dbremovef_open $r 0
313
 
 
314
 
        #
315
 
        # If both aborted, there should be no file??
316
 
        #
317
 
        if { $t1_isabort && $t2_isabort } {
318
 
                error_check_good dbremovef_open_ab [is_substr \
319
 
                    $result "no such file"] 1
320
 
        } else {
321
 
                error_check_good dbremovef_open [is_substr \
322
 
                    $result DB_LOCK_NOTGRANTED] 1
323
 
        }
324
 
 
325
 
        puts "\t$msg.3: Close subdb2; verify removals"
326
 
        error_check_good close_s2 [$s2 close] 0
327
 
        set r [ catch {eval {berkdb dbremove -env} \
328
 
            $env $rem2 $testfile $subdb2} result ]
329
 
        if { $t2_isabort } {
330
 
                error_check_bad dbrem2_ab $r 0
331
 
                error_check_good dbrem2_ab [is_substr \
332
 
                    $result "no such file"] 1
333
 
        } else {
334
 
                error_check_good dbrem2 $result 0
335
 
        }
336
 
        # Resolve subdb2 removal txn
337
 
        set r [eval $rop2]
338
 
        error_check_good rop2 $r 0
339
 
 
340
 
        set r [ catch {berkdb dbremove -env $env $testfile $subdb1} result ]
341
 
        error_check_bad dbremove1.2_open $r 0
342
 
        if { $t1_isabort } {
343
 
                error_check_good dbremove1.2_open_ab [is_substr \
344
 
                    $result "no such file"] 1
345
 
        } else {
346
 
                error_check_good dbremove1.2_open [is_substr \
347
 
                    $result DB_LOCK_NOTGRANTED] 1
348
 
        }
349
 
 
350
 
        # There are three cases here:
351
 
        # 1. if both t1 and t2 aborted, the file shouldn't exist
352
 
        # 2. if only t1 aborted, the file still exists and nothing is open
353
 
        # 3. if neither aborted a remove should fail because the first
354
 
        #        subdb is still open
355
 
        # In case 2, don't try the remove, because it should succeed
356
 
        # and we won't be able to test anything else.
357
 
        if { !$t1_isabort || $t2_isabort } {
358
 
                set r [catch {berkdb dbremove -env $env $testfile} result]
359
 
                if { $t1_isabort && $t2_isabort } {
360
 
                        error_check_bad dbremovef.2_open $r 0
361
 
                        error_check_good dbremove.2_open_ab [is_substr \
362
 
                            $result "no such file"] 1
363
 
                } else {
364
 
                        error_check_bad dbremovef.2_open $r 0
365
 
                        error_check_good dbremove.2_open [is_substr \
366
 
                            $result DB_LOCK_NOTGRANTED] 1
367
 
                }
368
 
        }
369
 
 
370
 
        puts "\t$msg.4: Close subdb1; verify removals"
371
 
        error_check_good close_s1 [$s1 close] 0
372
 
        set r [ catch {eval {berkdb dbremove -env} \
373
 
            $env $rem1 $testfile $subdb1} result ]
374
 
        if { $t1_isabort } {
375
 
                error_check_bad dbremove1_ab $r 0
376
 
                error_check_good dbremove1_ab [is_substr \
377
 
                    $result "no such file"] 1
378
 
        } else {
379
 
                error_check_good dbremove1 $result 0
380
 
        }
381
 
        # Resolve subdb1 removal txn
382
 
        set r [eval $rop1]
383
 
        error_check_good rop1 $r 0
384
 
 
385
 
 
386
 
        # Verify removal of subdb2.  All DB handles are closed now.
387
 
        # So we have two scenarios:
388
 
        #       1.  The removal of subdb2 above was successful and subdb2
389
 
        #           doesn't exist and we should fail that way.
390
 
        #       2.  The removal of subdb2 above was aborted, and this
391
 
        #           removal should succeed.
392
 
        #
393
 
        set r [ catch {berkdb dbremove -env $env $testfile $subdb2} result ]
394
 
        if { $r2_isabort && !$t2_isabort } {
395
 
                error_check_good dbremove2.1_ab $result 0
396
 
        } else {
397
 
                error_check_bad dbremove2.1 $r 0
398
 
                error_check_good dbremove2.1 [is_substr \
399
 
                    $result "no such file"] 1
400
 
        }
401
 
 
402
 
        # Verify removal of subdb1.  All DB handles are closed now.
403
 
        # So we have two scenarios:
404
 
        #       1.  The removal of subdb1 above was successful and subdb1
405
 
        #           doesn't exist and we should fail that way.
406
 
        #       2.  The removal of subdb1 above was aborted, and this
407
 
        #           removal should succeed.
408
 
        #
409
 
        set r [ catch {berkdb dbremove -env $env $testfile $subdb1} result ]
410
 
        if { $r1_isabort && !$t1_isabort } {
411
 
                error_check_good dbremove1.1 $result 0
412
 
        } else {
413
 
                error_check_bad dbremove_open $r 0
414
 
                error_check_good dbremove.1 [is_substr \
415
 
                    $result "no such file"] 1
416
 
        }
417
 
 
418
 
        puts "\t$msg.5: All closed; remove file"
419
 
        set r [catch {berkdb dbremove -env $env $testfile} result]
420
 
        if { $t1_isabort && $t2_isabort } {
421
 
                error_check_bad dbremove_final_ab $r 0
422
 
                error_check_good dbremove_file_abstr [is_substr \
423
 
                    $result "no such file"] 1
424
 
        } else {
425
 
                error_check_good dbremove_final $r 0
426
 
        }
427
 
        error_check_good envclose [$env close] 0
428
 
}