← 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/txn003.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/txn003.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
 
 
9
 
# TEST  txn003
10
 
# TEST  Test abort/commit/prepare of txns with outstanding child txns.
11
 
proc txn003 { {tnum "03"} } {
12
 
        source ./include.tcl
13
 
        global txn_curid
14
 
        global txn_maxid
15
 
 
16
 
        puts -nonewline "Txn0$tnum: Outstanding child transaction test"
17
 
 
18
 
        if { $tnum != "03" } {
19
 
                puts " (with ID wrap)"
20
 
        } else {
21
 
                puts ""
22
 
        }
23
 
        env_cleanup $testdir
24
 
        set testfile txn003.db
25
 
 
26
 
        set env_cmd "berkdb_env_noerr -create -txn -home $testdir"
27
 
        set env [eval $env_cmd]
28
 
        error_check_good dbenv [is_valid_env $env] TRUE
29
 
        error_check_good txn_id_set \
30
 
             [$env txn_id_set $txn_curid $txn_maxid] 0
31
 
 
32
 
        set oflags {-auto_commit -create -btree -mode 0644 -env $env $testfile}
33
 
        set db [eval {berkdb_open} $oflags]
34
 
        error_check_good db_open [is_valid_db $db] TRUE
35
 
 
36
 
        #
37
 
        # Put some data so that we can check commit or abort of child
38
 
        #
39
 
        set key 1
40
 
        set origdata some_data
41
 
        set newdata this_is_new_data
42
 
        set newdata2 some_other_new_data
43
 
 
44
 
        error_check_good db_put [$db put -auto_commit $key $origdata] 0
45
 
        error_check_good dbclose [$db close] 0
46
 
 
47
 
        set db [eval {berkdb_open} $oflags]
48
 
        error_check_good db_open [is_valid_db $db] TRUE
49
 
 
50
 
        txn003_check $db $key "Origdata" $origdata
51
 
 
52
 
        puts "\tTxn0$tnum.a: Parent abort"
53
 
        set parent [$env txn]
54
 
        error_check_good txn_begin [is_valid_txn $parent $env] TRUE
55
 
        set child [$env txn -parent $parent]
56
 
        error_check_good txn_begin [is_valid_txn $child $env] TRUE
57
 
        error_check_good db_put [$db put -txn $child $key $newdata] 0
58
 
        error_check_good parent_abort [$parent abort] 0
59
 
        txn003_check $db $key "parent_abort" $origdata
60
 
        # Check child handle is invalid
61
 
        set stat [catch {$child abort} ret]
62
 
        error_check_good child_handle $stat 1
63
 
        error_check_good child_h2 [is_substr $ret "invalid command name"] 1
64
 
 
65
 
        puts "\tTxn0$tnum.b: Parent commit"
66
 
        set parent [$env txn]
67
 
        error_check_good txn_begin [is_valid_txn $parent $env] TRUE
68
 
        set child [$env txn -parent $parent]
69
 
        error_check_good txn_begin [is_valid_txn $child $env] TRUE
70
 
        error_check_good db_put [$db put -txn $child $key $newdata] 0
71
 
        error_check_good parent_commit [$parent commit] 0
72
 
        txn003_check $db $key "parent_commit" $newdata
73
 
        # Check child handle is invalid
74
 
        set stat [catch {$child abort} ret]
75
 
        error_check_good child_handle $stat 1
76
 
        error_check_good child_h2 [is_substr $ret "invalid command name"] 1
77
 
        error_check_good dbclose [$db close] 0
78
 
        error_check_good env_close [$env close] 0
79
 
 
80
 
        #
81
 
        # Since the data check assumes what has come before, the 'commit'
82
 
        # operation must be last.
83
 
        #
84
 
        set hdr "\tTxn0$tnum"
85
 
        set rlist {
86
 
                {begin          ".c"}
87
 
                {prepare        ".d"}
88
 
                {abort          ".e"}
89
 
                {commit         ".f"}
90
 
        }
91
 
        set count 0
92
 
        foreach pair $rlist {
93
 
                incr count
94
 
                set op [lindex $pair 0]
95
 
                set msg [lindex $pair 1]
96
 
                set msg $hdr$msg
97
 
                txn003_body $env_cmd $testfile $testdir $key $newdata2 $msg $op
98
 
                set env [eval $env_cmd]
99
 
                error_check_good dbenv [is_valid_env $env] TRUE
100
 
 
101
 
                berkdb debug_check
102
 
                set db [eval {berkdb_open} $oflags]
103
 
                error_check_good db_open [is_valid_db $db] TRUE
104
 
                #
105
 
                # For prepare we'll then just
106
 
                # end up aborting after we test what we need to.
107
 
                # So set gooddata to the same as abort.
108
 
                switch $op {
109
 
                        abort {
110
 
                                set gooddata $newdata
111
 
                        }
112
 
                        begin {
113
 
                                set gooddata $newdata
114
 
                        }
115
 
                        commit {
116
 
                                set gooddata $newdata2
117
 
                        }
118
 
                        prepare {
119
 
                                set gooddata $newdata
120
 
                        }
121
 
                }
122
 
                txn003_check $db $key "parent_$op" $gooddata
123
 
                error_check_good dbclose [$db close] 0
124
 
                error_check_good env_close [$env close] 0
125
 
        }
126
 
 
127
 
        # We can't do the attempted child discard on Windows
128
 
        # because it will leave open files that can't be removed.
129
 
        # Skip the remainder of the test for Windows.
130
 
        if { $is_windows_test == 1 } {
131
 
                puts "Skipping remainder of test for Windows"
132
 
                return
133
 
        }
134
 
        puts "\tTxn0$tnum.g: Attempt child prepare"
135
 
        set env [eval $env_cmd]
136
 
        error_check_good dbenv [is_valid_env $env] TRUE
137
 
        berkdb debug_check
138
 
        set db [eval {berkdb_open_noerr} $oflags]
139
 
        error_check_good db_open [is_valid_db $db] TRUE
140
 
 
141
 
        set parent [$env txn]
142
 
        error_check_good txn_begin [is_valid_txn $parent $env] TRUE
143
 
        set child [$env txn -parent $parent]
144
 
        error_check_good txn_begin [is_valid_txn $child $env] TRUE
145
 
        error_check_good db_put [$db put -txn $child $key $newdata] 0
146
 
        set gid [make_gid child_prepare:$child]
147
 
        set stat [catch {$child prepare $gid} ret]
148
 
        error_check_good child_prepare $stat 1
149
 
        error_check_good child_prep_err [is_substr $ret "txn prepare"] 1
150
 
 
151
 
        puts "\tTxn0$tnum.h: Attempt child discard"
152
 
        set stat [catch {$child discard} ret]
153
 
        error_check_good child_discard $stat 1
154
 
 
155
 
        # We just panic'd the region, so the next operations will fail.
156
 
        # No matter, we still have to clean up all the handles.
157
 
 
158
 
        set stat [catch {$parent commit} ret]
159
 
        error_check_good parent_commit $stat 1
160
 
        error_check_good parent_commit:fail [is_substr $ret "DB_RUNRECOVERY"] 1
161
 
 
162
 
        set stat [catch {$db close} ret]
163
 
        error_check_good db_close $stat 1
164
 
        error_check_good db_close:fail [is_substr $ret "DB_RUNRECOVERY"] 1
165
 
 
166
 
        set stat [catch {$env close} ret]
167
 
        error_check_good env_close $stat 1
168
 
        error_check_good env_close:fail [is_substr $ret "DB_RUNRECOVERY"] 1
169
 
}
170
 
 
171
 
proc txn003_body { env_cmd testfile dir key newdata2 msg op } {
172
 
        source ./include.tcl
173
 
 
174
 
        berkdb debug_check
175
 
        sentinel_init
176
 
        set gidf $dir/gidfile
177
 
        fileremove -f $gidf
178
 
        set pidlist {}
179
 
        puts "$msg.0: Executing child script to prepare txns"
180
 
        berkdb debug_check
181
 
        set p [exec $tclsh_path $test_path/wrap.tcl txnscript.tcl \
182
 
            $testdir/txnout $env_cmd $testfile $gidf $key $newdata2 &]
183
 
        lappend pidlist $p
184
 
        watch_procs $pidlist 5
185
 
        set f1 [open $testdir/txnout r]
186
 
        set r [read $f1]
187
 
        puts $r
188
 
        close $f1
189
 
        fileremove -f $testdir/txnout
190
 
 
191
 
        berkdb debug_check
192
 
        puts -nonewline "$msg.1: Running recovery ... "
193
 
        flush stdout
194
 
        berkdb debug_check
195
 
        set env [eval $env_cmd "-recover"]
196
 
        error_check_good dbenv-recover [is_valid_env $env] TRUE
197
 
        puts "complete"
198
 
 
199
 
        puts "$msg.2: getting txns from txn_recover"
200
 
        set txnlist [$env txn_recover]
201
 
        error_check_good txnlist_len [llength $txnlist] 1
202
 
        set tpair [lindex $txnlist 0]
203
 
 
204
 
        set gfd [open $gidf r]
205
 
        set ret [gets $gfd parentgid]
206
 
        close $gfd
207
 
        set txn [lindex $tpair 0]
208
 
        set gid [lindex $tpair 1]
209
 
        if { $op == "begin" } {
210
 
                puts "$msg.2: $op new txn"
211
 
        } else {
212
 
                puts "$msg.2: $op parent"
213
 
        }
214
 
        error_check_good gidcompare $gid $parentgid
215
 
        if { $op == "prepare" } {
216
 
                set gid [make_gid prepare_recover:$txn]
217
 
                set stat [catch {$txn $op $gid} ret]
218
 
                error_check_good prep_error $stat 1
219
 
                error_check_good prep_err \
220
 
                    [is_substr $ret "transaction already prepared"] 1
221
 
                error_check_good txn:prep_abort [$txn abort] 0
222
 
        } elseif { $op == "begin" } {
223
 
                set stat [catch {$env txn} ret]
224
 
                error_check_good begin_error $stat 1
225
 
                error_check_good begin_err \
226
 
                    [is_substr $ret "not yet committed transactions is incomplete"] 1
227
 
                error_check_good txn:prep_abort [$txn abort] 0
228
 
        } else {
229
 
                error_check_good txn:$op [$txn $op] 0
230
 
        }
231
 
        error_check_good envclose [$env close] 0
232
 
}
233
 
 
234
 
proc txn003_check { db key msg gooddata } {
235
 
        set kd [$db get $key]
236
 
        set data [lindex [lindex $kd 0] 1]
237
 
        error_check_good $msg $data $gooddata
238
 
}