← Back to branch summary

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

« back to all changes in this revision

Viewing changes to db/test/txn.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/txn.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1996-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: txn.tcl,v 11.20 2001/06/13 18:04:16 sue Exp $
 
7
#
 
8
# Options are:
 
9
# -dir <directory in which to store memp>
 
10
# -max <max number of concurrent transactions>
 
11
# -iterations <iterations>
 
12
# -stat
 
13
proc txn_usage {} {
 
14
        puts "txn -dir <directory> -iterations <number of ops> \
 
15
            -max <max number of transactions> -stat"
 
16
}
 
17
 
 
18
proc txntest { args } {
 
19
        source ./include.tcl
 
20
 
 
21
        # Set defaults
 
22
        set iterations 50
 
23
        set max 1024
 
24
        set dostat 0
 
25
        set flags ""
 
26
        for { set i 0 } { $i < [llength $args] } {incr i} {
 
27
                switch -regexp -- [lindex $args $i] {
 
28
                        -d.* { incr i; set testdir [lindex $args $i] }
 
29
                        -f.* { incr i; set flags [lindex $args $i] }
 
30
                        -i.* { incr i; set iterations [lindex $args $i] }
 
31
                        -m.* { incr i; set max [lindex $args $i] }
 
32
                        -s.* { set dostat 1 }
 
33
                        default {
 
34
                                puts -nonewline "FAIL:[timestamp] Usage: "
 
35
                                txn_usage
 
36
                                return
 
37
                        }
 
38
                }
 
39
        }
 
40
        if { $max < $iterations } {
 
41
                set max $iterations
 
42
        }
 
43
 
 
44
        # Now run the various functionality tests
 
45
        txn001 $testdir $max $iterations $flags
 
46
        txn002 $testdir $max $iterations
 
47
        txn003 $testdir
 
48
}
 
49
 
 
50
proc txn001 { dir max ntxns flags} {
 
51
        source ./include.tcl
 
52
 
 
53
        puts "Txn001: Basic begin, commit, abort"
 
54
 
 
55
        # Open environment
 
56
        env_cleanup $dir
 
57
 
 
58
        set env [eval {berkdb \
 
59
            env -create -mode 0644 -txn -txn_max $max -home $dir} $flags]
 
60
        error_check_good evn_open [is_valid_env $env] TRUE
 
61
        txn001_suba $ntxns $env
 
62
        txn001_subb $ntxns $env
 
63
        txn001_subc $ntxns $env
 
64
        # Close and unlink the file
 
65
        error_check_good env_close:$env [$env close] 0
 
66
}
 
67
 
 
68
proc txn001_suba { ntxns env } {
 
69
        source ./include.tcl
 
70
 
 
71
        # We will create a bunch of transactions and commit them.
 
72
        set txn_list {}
 
73
        set tid_list {}
 
74
        puts "Txn001.a: Beginning/Committing $ntxns Transactions in $env"
 
75
        for { set i 0 } { $i < $ntxns } { incr i } {
 
76
                set txn [$env txn]
 
77
                error_check_good txn_begin [is_valid_txn $txn $env] TRUE
 
78
 
 
79
                lappend txn_list $txn
 
80
 
 
81
                set tid [$txn id]
 
82
                error_check_good tid_check [lsearch $tid_list $tid] -1
 
83
 
 
84
                lappend tid_list $tid
 
85
        }
 
86
 
 
87
        # Now commit them all
 
88
        foreach t $txn_list {
 
89
                error_check_good txn_commit:$t [$t commit] 0
 
90
        }
 
91
}
 
92
 
 
93
proc txn001_subb { ntxns env } {
 
94
        # We will create a bunch of transactions and abort them.
 
95
        set txn_list {}
 
96
        set tid_list {}
 
97
        puts "Txn001.b: Beginning/Aborting Transactions"
 
98
        for { set i 0 } { $i < $ntxns } { incr i } {
 
99
                set txn [$env txn]
 
100
                error_check_good txn_begin [is_valid_txn $txn $env] TRUE
 
101
 
 
102
                lappend txn_list $txn
 
103
 
 
104
                set tid [$txn id]
 
105
                error_check_good tid_check [lsearch $tid_list $tid] -1
 
106
 
 
107
                lappend tid_list $tid
 
108
        }
 
109
 
 
110
        # Now abort them all
 
111
        foreach t $txn_list {
 
112
                error_check_good txn_abort:$t [$t abort] 0
 
113
        }
 
114
}
 
115
 
 
116
proc txn001_subc { ntxns env } {
 
117
        # We will create a bunch of transactions and commit them.
 
118
        set txn_list {}
 
119
        set tid_list {}
 
120
        puts "Txn001.c: Beginning/Prepare/Committing Transactions"
 
121
        for { set i 0 } { $i < $ntxns } { incr i } {
 
122
                set txn [$env txn]
 
123
                error_check_good txn_begin [is_valid_txn $txn $env] TRUE
 
124
 
 
125
                lappend txn_list $txn
 
126
 
 
127
                set tid [$txn id]
 
128
                error_check_good tid_check [lsearch $tid_list $tid] -1
 
129
 
 
130
                lappend tid_list $tid
 
131
        }
 
132
 
 
133
        # Now prepare them all
 
134
        foreach t $txn_list {
 
135
                error_check_good txn_prepare:$t \
 
136
                    [$t prepare [make_gid global:$t]] 0
 
137
        }
 
138
 
 
139
        # Now commit them all
 
140
        foreach t $txn_list {
 
141
                error_check_good txn_commit:$t [$t commit] 0
 
142
        }
 
143
 
 
144
}
 
145
 
 
146
# Verify that read-only transactions do not create any log records
 
147
proc txn002 { dir max ntxns } {
 
148
        source ./include.tcl
 
149
 
 
150
        puts "Txn002: Read-only transaction test"
 
151
 
 
152
        env_cleanup $dir
 
153
        set env [berkdb \
 
154
            env -create -mode 0644 -txn -txn_max $max -home $dir]
 
155
        error_check_good dbenv [is_valid_env $env] TRUE
 
156
 
 
157
        # We will create a bunch of transactions and commit them.
 
158
        set txn_list {}
 
159
        set tid_list {}
 
160
        puts "Txn002.a: Beginning/Committing Transactions"
 
161
        for { set i 0 } { $i < $ntxns } { incr i } {
 
162
                set txn [$env txn]
 
163
                error_check_good txn_begin [is_valid_txn $txn $env] TRUE
 
164
 
 
165
                lappend txn_list $txn
 
166
 
 
167
                set tid [$txn id]
 
168
                error_check_good tid_check [lsearch $tid_list $tid] -1
 
169
 
 
170
                lappend tid_list $tid
 
171
        }
 
172
 
 
173
        # Now commit them all
 
174
        foreach t $txn_list {
 
175
                error_check_good txn_commit:$t [$t commit] 0
 
176
        }
 
177
 
 
178
        # Now verify that there aren't any log records.
 
179
        set r [$env log_get -first]
 
180
        error_check_good log_get:$r [llength $r] 0
 
181
 
 
182
        error_check_good env_close:$r [$env close] 0
 
183
}
 
184
 
 
185
# Test abort/commit/prepare of txns with outstanding child txns.
 
186
proc txn003 { dir } {
 
187
        source ./include.tcl
 
188
 
 
189
        puts "Txn003: Outstanding child transaction test"
 
190
 
 
191
        env_cleanup $dir
 
192
        set testfile txn003.db
 
193
 
 
194
        set env_cmd "berkdb env -create -txn -home $dir"
 
195
        set env [eval $env_cmd]
 
196
        error_check_good dbenv [is_valid_env $env] TRUE
 
197
 
 
198
        set oflags {-create -btree -mode 0644 -env $env $testfile}
 
199
        set db [eval {berkdb open} $oflags]
 
200
        error_check_good db_open [is_valid_db $db] TRUE
 
201
 
 
202
        #
 
203
        # Put some data so that we can check commit or abort of child
 
204
        #
 
205
        set key 1
 
206
        set origdata some_data
 
207
        set newdata this_is_new_data
 
208
        set newdata2 some_other_new_data
 
209
 
 
210
        error_check_good db_put [$db put $key $origdata] 0
 
211
        error_check_good dbclose [$db close] 0
 
212
 
 
213
        set db [eval {berkdb open} $oflags]
 
214
        error_check_good db_open [is_valid_db $db] TRUE
 
215
 
 
216
        txn003_check $db $key "Origdata" $origdata
 
217
 
 
218
        puts "\tTxn003.a: Parent abort"
 
219
        set parent [$env txn]
 
220
        error_check_good txn_begin [is_valid_txn $parent $env] TRUE
 
221
        set child [$env txn -parent $parent]
 
222
        error_check_good txn_begin [is_valid_txn $child $env] TRUE
 
223
        error_check_good db_put [$db put -txn $child $key $newdata] 0
 
224
        error_check_good parent_abort [$parent abort] 0
 
225
        txn003_check $db $key "parent_abort" $origdata
 
226
        # Check child handle is invalid
 
227
        set stat [catch {$child abort} ret]
 
228
        error_check_good child_handle $stat 1
 
229
        error_check_good child_h2 [is_substr $ret "invalid command name"] 1
 
230
 
 
231
        puts "\tTxn003.b: Parent commit"
 
232
        set parent [$env txn]
 
233
        error_check_good txn_begin [is_valid_txn $parent $env] TRUE
 
234
        set child [$env txn -parent $parent]
 
235
        error_check_good txn_begin [is_valid_txn $child $env] TRUE
 
236
        error_check_good db_put [$db put -txn $child $key $newdata] 0
 
237
        error_check_good parent_commit [$parent commit] 0
 
238
        txn003_check $db $key "parent_commit" $newdata
 
239
        # Check child handle is invalid
 
240
        set stat [catch {$child abort} ret]
 
241
        error_check_good child_handle $stat 1
 
242
        error_check_good child_h2 [is_substr $ret "invalid command name"] 1
 
243
        error_check_good dbclose [$db close] 0
 
244
        error_check_good env_close [$env close] 0
 
245
 
 
246
        #
 
247
        # Since the data check assumes what has come before, the 'commit'
 
248
        # operation must be last.
 
249
        #
 
250
        set rlist {
 
251
                {begin          "\tTxn003.c"}
 
252
                {prepare        "\tTxn003.d"}
 
253
                {abort          "\tTxn003.e"}
 
254
                {commit         "\tTxn003.f"}
 
255
        }
 
256
        set count 0
 
257
        foreach pair $rlist {
 
258
                incr count
 
259
                set op [lindex $pair 0]
 
260
                set msg [lindex $pair 1]
 
261
                txn003_body $env_cmd $testfile $dir $key $newdata2 $msg $op
 
262
                set env [eval $env_cmd]
 
263
                error_check_good dbenv [is_valid_env $env] TRUE
 
264
 
 
265
                berkdb debug_check
 
266
                set db [eval {berkdb open} $oflags]
 
267
                error_check_good db_open [is_valid_db $db] TRUE
 
268
                #
 
269
                # For prepare we'll then just
 
270
                # end up aborting after we test what we need to.
 
271
                # So set gooddata to the same as abort.
 
272
                switch $op {
 
273
                        abort {
 
274
                                set gooddata $newdata
 
275
                        }
 
276
                        begin {
 
277
                                set gooddata $newdata
 
278
                        }
 
279
                        commit {
 
280
                                set gooddata $newdata2
 
281
                        }
 
282
                        prepare {
 
283
                                set gooddata $newdata
 
284
                        }
 
285
                }
 
286
                txn003_check $db $key "parent_$op" $gooddata
 
287
                error_check_good dbclose [$db close] 0
 
288
                error_check_good env_close [$env close] 0
 
289
        }
 
290
 
 
291
        puts "\tTxn003.g: Attempt child prepare"
 
292
        set env [eval $env_cmd]
 
293
        error_check_good dbenv [is_valid_env $env] TRUE
 
294
        berkdb debug_check
 
295
        set db [eval {berkdb open} $oflags]
 
296
        error_check_good db_open [is_valid_db $db] TRUE
 
297
 
 
298
        set parent [$env txn]
 
299
        error_check_good txn_begin [is_valid_txn $parent $env] TRUE
 
300
        set child [$env txn -parent $parent]
 
301
        error_check_good txn_begin [is_valid_txn $child $env] TRUE
 
302
        error_check_good db_put [$db put -txn $child $key $newdata] 0
 
303
        set gid [make_gid child_prepare:$child]
 
304
        set stat [catch {$child prepare $gid} ret]
 
305
        error_check_good child_prepare $stat 1
 
306
        error_check_good child_prep_err \
 
307
            [is_substr $ret "Prepare disallowed on child"] 1
 
308
 
 
309
        puts "\tTxn003.h: Attempt child discard"
 
310
        set stat [catch {$child discard} ret]
 
311
        error_check_good child_discard $stat 1
 
312
        error_check_good child_disc_err \
 
313
            [is_substr $ret "not a restored transaction"] 1
 
314
        #
 
315
        # Just commit everybody.  We are done.
 
316
        #
 
317
        error_check_good parent_commit [$parent commit] 0
 
318
        error_check_good dbclose [$db close] 0
 
319
        error_check_good env_close [$env close] 0
 
320
}
 
321
 
 
322
proc txn003_body { env_cmd testfile dir key newdata2 msg op } {
 
323
        source ./include.tcl
 
324
 
 
325
        berkdb debug_check
 
326
        sentinel_init
 
327
        set gidf $dir/gidfile
 
328
        fileremove -f $gidf
 
329
        set proclist {}
 
330
        puts "$msg.0: Executing child script to prepare txns"
 
331
        berkdb debug_check
 
332
        set p [exec $tclsh_path $test_path/wrap.tcl txnscript.tcl \
 
333
            $testdir/txnout $env_cmd $testfile $gidf $key $newdata2 &]
 
334
        lappend proclist $p
 
335
        watch_procs 5
 
336
        set f1 [open $testdir/txnout r]
 
337
        set r [read $f1]
 
338
        puts $r
 
339
        close $f1
 
340
        fileremove -f $testdir/txnout
 
341
 
 
342
        berkdb debug_check
 
343
        puts -nonewline "$msg.1: Running recovery ... "
 
344
        flush stdout
 
345
        berkdb debug_check
 
346
        set env [eval $env_cmd "-recover -verbose {recovery on}"]
 
347
        error_check_good dbenv-recover [is_valid_env $env] TRUE
 
348
        puts "complete"
 
349
 
 
350
        puts "$msg.2: getting txns from txn_recover"
 
351
        set txnlist [$env txn_recover]
 
352
        error_check_good txnlist_len [llength $txnlist] 1
 
353
        set tpair [lindex $txnlist 0]
 
354
 
 
355
        set gfd [open $gidf r]
 
356
        set ret [gets $gfd parentgid]
 
357
        close $gfd
 
358
        set txn [lindex $tpair 0]
 
359
        set gid [lindex $tpair 1]
 
360
        if { $op == "begin" } {
 
361
                puts "$msg.2: $op new txn"
 
362
        } else {
 
363
                puts "$msg.2: $op parent"
 
364
        }
 
365
        error_check_good gidcompare $gid $parentgid
 
366
        if { $op == "prepare" } {
 
367
                set gid [make_gid prepare_recover:$txn]
 
368
                set stat [catch {$txn $op $gid} ret]
 
369
                error_check_good prep_error $stat 1
 
370
                error_check_good prep_err \
 
371
                    [is_substr $ret "transaction already prepared"] 1
 
372
                error_check_good txn:prep_abort [$txn abort] 0
 
373
        } elseif { $op == "begin" } {
 
374
                set stat [catch {$env txn} ret]
 
375
                error_check_good begin_error $stat 1
 
376
                error_check_good begin_err \
 
377
                    [is_substr $ret "not yet committed transactions is incomplete"] 1
 
378
                error_check_good txn:prep_abort [$txn abort] 0
 
379
        } else {
 
380
                error_check_good txn:$op [$txn $op] 0
 
381
        }
 
382
        error_check_good envclose [$env close] 0
 
383
}
 
384
 
 
385
proc txn003_check { db key msg gooddata } {
 
386
        set kd [$db get $key]
 
387
        set data [lindex [lindex $kd 0] 1]
 
388
        error_check_good $msg $data $gooddata
 
389
}