← 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/recd010.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/recd010.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  recd010
9
 
# TEST  Test stability of btree duplicates across btree off-page dup splits
10
 
# TEST  and reverse splits and across recovery.
11
 
proc recd010 { method {select 0} args} {
12
 
        if { [is_btree $method] != 1 } {
13
 
                puts "Recd010 skipping for method $method."
14
 
                return
15
 
        }
16
 
 
17
 
        set pgindex [lsearch -exact $args "-pagesize"]
18
 
        if { $pgindex != -1 } {
19
 
                puts "Recd010: skipping for specific pagesizes"
20
 
                return
21
 
        }
22
 
        set largs $args
23
 
        append largs " -dup "
24
 
        recd010_main $method $select $largs
25
 
        append largs " -dupsort "
26
 
        recd010_main $method $select $largs
27
 
}
28
 
 
29
 
proc recd010_main { method select largs } {
30
 
        global fixed_len
31
 
        global kvals
32
 
        global kvals_dups
33
 
        source ./include.tcl
34
 
 
35
 
 
36
 
        set opts [convert_args $method $largs]
37
 
        set method [convert_method $method]
38
 
 
39
 
        puts "Recd010 ($opts): Test duplicates across splits and recovery"
40
 
 
41
 
        set testfile recd010.db
42
 
        env_cleanup $testdir
43
 
        #
44
 
        # Set pagesize small to generate lots of off-page dups
45
 
        #
46
 
        set page 512
47
 
        set mkeys 1000
48
 
        set firstkeys 5
49
 
        set data "data"
50
 
        set key "recd010_key"
51
 
 
52
 
        puts "\tRecd010.a: Create environment and database."
53
 
        set flags "-create -txn -home $testdir"
54
 
 
55
 
        set env_cmd "berkdb_env $flags"
56
 
        set dbenv [eval $env_cmd]
57
 
        error_check_good dbenv [is_valid_env $dbenv] TRUE
58
 
 
59
 
        set oflags "-env $dbenv -create -mode 0644 $opts $method"
60
 
        set db [eval {berkdb_open} -pagesize $page $oflags $testfile]
61
 
        error_check_good dbopen [is_valid_db $db] TRUE
62
 
 
63
 
        # Fill page with small key/data pairs.  Keep at leaf.
64
 
        puts "\tRecd010.b: Fill page with $firstkeys small dups."
65
 
        for { set i 1 } { $i <= $firstkeys } { incr i } {
66
 
                set ret [$db put $key $data$i]
67
 
                error_check_good dbput $ret 0
68
 
        }
69
 
        set kvals 1
70
 
        set kvals_dups $firstkeys
71
 
        error_check_good db_close [$db close] 0
72
 
        error_check_good env_close [$dbenv close] 0
73
 
 
74
 
        # List of recovery tests: {CMD MSG} pairs.
75
 
        if { $mkeys < 100 } {
76
 
                puts "Recd010 mkeys of $mkeys too small"
77
 
                return
78
 
        }
79
 
        set rlist {
80
 
        { {recd010_split DB TXNID 1 2 $mkeys}
81
 
            "Recd010.c: btree split 2 large dups"}
82
 
        { {recd010_split DB TXNID 0 2 $mkeys}
83
 
            "Recd010.d: btree reverse split 2 large dups"}
84
 
        { {recd010_split DB TXNID 1 10 $mkeys}
85
 
            "Recd010.e: btree split 10 dups"}
86
 
        { {recd010_split DB TXNID 0 10 $mkeys}
87
 
            "Recd010.f: btree reverse split 10 dups"}
88
 
        { {recd010_split DB TXNID 1 100 $mkeys}
89
 
            "Recd010.g: btree split 100 dups"}
90
 
        { {recd010_split DB TXNID 0 100 $mkeys}
91
 
            "Recd010.h: btree reverse split 100 dups"}
92
 
        }
93
 
 
94
 
        foreach pair $rlist {
95
 
                set cmd [subst [lindex $pair 0]]
96
 
                set msg [lindex $pair 1]
97
 
                if { $select != 0 } {
98
 
                        set tag [lindex $msg 0]
99
 
                        set tail [expr [string length $tag] - 2]
100
 
                        set tag [string range $tag $tail $tail]
101
 
                        if { [lsearch $select $tag] == -1 } {
102
 
                                continue
103
 
                        }
104
 
                }
105
 
                set reverse [string first "reverse" $msg]
106
 
                op_recover abort $testdir $env_cmd $testfile $cmd $msg
107
 
                recd010_check $testdir $testfile $opts abort $reverse $firstkeys
108
 
                op_recover commit $testdir $env_cmd $testfile $cmd $msg
109
 
                recd010_check $testdir $testfile $opts commit $reverse $firstkeys
110
 
        }
111
 
        puts "\tRecd010.i: Verify db_printlog can read logfile"
112
 
        set tmpfile $testdir/printlog.out
113
 
        set stat [catch {exec $util_path/db_printlog -h $testdir \
114
 
            > $tmpfile} ret]
115
 
        error_check_good db_printlog $stat 0
116
 
        fileremove $tmpfile
117
 
}
118
 
 
119
 
#
120
 
# This procedure verifies that the database has only numkeys number
121
 
# of keys and that they are in order.
122
 
#
123
 
proc recd010_check { tdir testfile opts op reverse origdups } {
124
 
        global kvals
125
 
        global kvals_dups
126
 
        source ./include.tcl
127
 
 
128
 
        set db [eval {berkdb_open} $opts $tdir/$testfile]
129
 
        error_check_good dbopen [is_valid_db $db] TRUE
130
 
 
131
 
        set data "data"
132
 
 
133
 
        if { $reverse == -1 } {
134
 
                puts "\tRecd010_check: Verify split after $op"
135
 
        } else {
136
 
                puts "\tRecd010_check: Verify reverse split after $op"
137
 
        }
138
 
 
139
 
        set stat [$db stat]
140
 
        if { [expr ([string compare $op "abort"] == 0 && $reverse == -1) || \
141
 
                   ([string compare $op "commit"] == 0 && $reverse != -1)]} {
142
 
                set numkeys 0
143
 
                set allkeys [expr $numkeys + 1]
144
 
                set numdups $origdups
145
 
                #
146
 
                # If we abort the adding of dups, or commit
147
 
                # the removal of dups, either way check that
148
 
                # we are back at the beginning.  Check that:
149
 
                # - We have 0 internal pages.
150
 
                # - We have only 1 key (the original we primed the db
151
 
                # with at the beginning of the test).
152
 
                # - We have only the original number of dups we primed
153
 
                # the db with at the beginning of the test.
154
 
                #
155
 
                error_check_good stat:orig0 [is_substr $stat \
156
 
                        "{{Internal pages} 0}"] 1
157
 
                error_check_good stat:orig1 [is_substr $stat \
158
 
                        "{{Number of keys} 1}"] 1
159
 
                error_check_good stat:orig2 [is_substr $stat \
160
 
                        "{{Number of records} $origdups}"] 1
161
 
        } else {
162
 
                set numkeys $kvals
163
 
                set allkeys [expr $numkeys + 1]
164
 
                set numdups $kvals_dups
165
 
                #
166
 
                # If we abort the removal of dups, or commit the
167
 
                # addition of dups, check that:
168
 
                # - We have > 0 internal pages.
169
 
                # - We have the number of keys.
170
 
                #
171
 
                error_check_bad stat:new0 [is_substr $stat \
172
 
                        "{{Internal pages} 0}"] 1
173
 
                error_check_good stat:new1 [is_substr $stat \
174
 
                        "{{Number of keys} $allkeys}"] 1
175
 
        }
176
 
 
177
 
        set dbc [$db cursor]
178
 
        error_check_good dbcursor [is_valid_cursor $dbc $db] TRUE
179
 
        puts "\tRecd010_check: Checking key and duplicate values"
180
 
        set key "recd010_key"
181
 
        #
182
 
        # Check dups are there as they should be.
183
 
        #
184
 
        for {set ki 0} {$ki < $numkeys} {incr ki} {
185
 
                set datacnt 0
186
 
                for {set d [$dbc get -set $key$ki]} { [llength $d] != 0 } {
187
 
                    set d [$dbc get -nextdup]} {
188
 
                        set thisdata [lindex [lindex $d 0] 1]
189
 
                        if { $datacnt < 10 } {
190
 
                                set pdata $data.$ki.00$datacnt
191
 
                        } elseif { $datacnt < 100 } {
192
 
                                set pdata $data.$ki.0$datacnt
193
 
                        } else {
194
 
                                set pdata $data.$ki.$datacnt
195
 
                        }
196
 
                        error_check_good dup_check $thisdata $pdata
197
 
                        incr datacnt
198
 
                }
199
 
                error_check_good dup_count $datacnt $numdups
200
 
        }
201
 
        #
202
 
        # Check that the number of expected keys (allkeys) are
203
 
        # all of the ones that exist in the database.
204
 
        #
205
 
        set dupkeys 0
206
 
        set lastkey ""
207
 
        for {set d [$dbc get -first]} { [llength $d] != 0 } {
208
 
            set d [$dbc get -next]} {
209
 
                set thiskey [lindex [lindex $d 0] 0]
210
 
                if { [string compare $lastkey $thiskey] != 0 } {
211
 
                        incr dupkeys
212
 
                }
213
 
                set lastkey $thiskey
214
 
        }
215
 
        error_check_good key_check $allkeys $dupkeys
216
 
        error_check_good curs_close [$dbc close] 0
217
 
        error_check_good db_close [$db close] 0
218
 
}
219
 
 
220
 
proc recd010_split { db txn split nkeys mkeys } {
221
 
        global errorCode
222
 
        global kvals
223
 
        global kvals_dups
224
 
        source ./include.tcl
225
 
 
226
 
        set data "data"
227
 
        set key "recd010_key"
228
 
 
229
 
        set numdups [expr $mkeys / $nkeys]
230
 
 
231
 
        set kvals $nkeys
232
 
        set kvals_dups $numdups
233
 
        if { $split == 1 } {
234
 
                puts \
235
 
"\tRecd010_split: Add $nkeys keys, with $numdups duplicates each to force split."
236
 
                for {set k 0} { $k < $nkeys } { incr k } {
237
 
                        for {set i 0} { $i < $numdups } { incr i } {
238
 
                                if { $i < 10 } {
239
 
                                        set pdata $data.$k.00$i
240
 
                                } elseif { $i < 100 } {
241
 
                                        set pdata $data.$k.0$i
242
 
                                } else {
243
 
                                        set pdata $data.$k.$i
244
 
                                }
245
 
                                set ret [$db put -txn $txn $key$k $pdata]
246
 
                                error_check_good dbput:more $ret 0
247
 
                        }
248
 
                }
249
 
        } else {
250
 
                puts \
251
 
"\tRecd010_split: Delete $nkeys keys to force reverse split."
252
 
                for {set k 0} { $k < $nkeys } { incr k } {
253
 
                        error_check_good db_del:$k [$db del -txn $txn $key$k] 0
254
 
                }
255
 
        }
256
 
        return 0
257
 
}