← 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/test073.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/test073.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  test073
9
 
# TEST  Test of cursor stability on duplicate pages.
10
 
# TEST
11
 
# TEST  Does the following:
12
 
# TEST  a. Initialize things by DB->putting ndups dups and
13
 
# TEST     setting a reference cursor to point to each.
14
 
# TEST  b. c_put ndups dups (and correspondingly expanding
15
 
# TEST     the set of reference cursors) after the last one, making sure
16
 
# TEST     after each step that all the reference cursors still point to
17
 
# TEST     the right item.
18
 
# TEST  c. Ditto, but before the first one.
19
 
# TEST  d. Ditto, but after each one in sequence first to last.
20
 
# TEST  e. Ditto, but after each one in sequence from last to first.
21
 
# TEST     occur relative to the new datum)
22
 
# TEST  f. Ditto for the two sequence tests, only doing a
23
 
# TEST     DBC->c_put(DB_CURRENT) of a larger datum instead of adding a
24
 
# TEST     new one.
25
 
proc test073 { method {pagesize 512} {ndups 50} {tnum 73} args } {
26
 
        source ./include.tcl
27
 
        global alphabet
28
 
 
29
 
        set omethod [convert_method $method]
30
 
        set args [convert_args $method $args]
31
 
 
32
 
        set txnenv 0
33
 
        set eindex [lsearch -exact $args "-env"]
34
 
        #
35
 
        # If we are using an env, then testfile should just be the db name.
36
 
        # Otherwise it is the test directory and the name.
37
 
        if { $eindex == -1 } {
38
 
                set testfile $testdir/test0$tnum.db
39
 
                set env NULL
40
 
        } else {
41
 
                set testfile test0$tnum.db
42
 
                incr eindex
43
 
                set env [lindex $args $eindex]
44
 
                set txnenv [is_txnenv $env]
45
 
                if { $txnenv == 1 } {
46
 
                        append args " -auto_commit "
47
 
                }
48
 
                set testdir [get_home $env]
49
 
        }
50
 
        cleanup $testdir $env
51
 
 
52
 
        set key "the key"
53
 
        set txn ""
54
 
 
55
 
        puts -nonewline "Test0$tnum $omethod ($args): "
56
 
        if { [is_record_based $method] || [is_rbtree $method] } {
57
 
                puts "Skipping for method $method."
58
 
                return
59
 
        } else {
60
 
                puts "cursor stability on duplicate pages."
61
 
        }
62
 
        set pgindex [lsearch -exact $args "-pagesize"]
63
 
        if { $pgindex != -1 } {
64
 
                puts "Test073: skipping for specific pagesizes"
65
 
                return
66
 
        }
67
 
 
68
 
        append args " -pagesize $pagesize -dup"
69
 
 
70
 
        set db [eval {berkdb_open \
71
 
             -create -mode 0644} $omethod $args $testfile]
72
 
        error_check_good "db open" [is_valid_db $db] TRUE
73
 
 
74
 
        # Number of outstanding keys.
75
 
        set keys 0
76
 
 
77
 
        puts "\tTest0$tnum.a.1: Initializing put loop; $ndups dups, short data."
78
 
 
79
 
        for { set i 0 } { $i < $ndups } { incr i } {
80
 
                set datum [makedatum_t73 $i 0]
81
 
 
82
 
                if { $txnenv == 1 } {
83
 
                        set t [$env txn]
84
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
85
 
                        set txn "-txn $t"
86
 
                }
87
 
                set ret [eval {$db put} $txn {$key $datum}]
88
 
                error_check_good "db put ($i)" $ret 0
89
 
                if { $txnenv == 1 } {
90
 
                        error_check_good txn [$t commit] 0
91
 
                }
92
 
 
93
 
                set is_long($i) 0
94
 
                incr keys
95
 
        }
96
 
 
97
 
        puts "\tTest0$tnum.a.2: Initializing cursor get loop; $keys dups."
98
 
        if { $txnenv == 1 } {
99
 
                set t [$env txn]
100
 
                error_check_good txn [is_valid_txn $t $env] TRUE
101
 
                set txn "-txn $t"
102
 
        }
103
 
        for { set i 0 } { $i < $keys } { incr i } {
104
 
                set datum [makedatum_t73 $i 0]
105
 
 
106
 
                set dbc($i) [eval {$db cursor} $txn]
107
 
                error_check_good "db cursor ($i)"\
108
 
                    [is_valid_cursor $dbc($i) $db] TRUE
109
 
                error_check_good "dbc get -get_both ($i)"\
110
 
                    [$dbc($i) get -get_both $key $datum]\
111
 
                    [list [list $key $datum]]
112
 
        }
113
 
 
114
 
        puts "\tTest0$tnum.b: Cursor put (DB_KEYLAST); $ndups new dups,\
115
 
            short data."
116
 
 
117
 
        for { set i 0 } { $i < $ndups } { incr i } {
118
 
                # !!! keys contains the number of the next dup
119
 
                # to be added (since they start from zero)
120
 
 
121
 
                set datum [makedatum_t73 $keys 0]
122
 
                set curs [eval {$db cursor} $txn]
123
 
                error_check_good "db cursor create" [is_valid_cursor $curs $db]\
124
 
                    TRUE
125
 
                error_check_good "c_put(DB_KEYLAST, $keys)"\
126
 
                    [$curs put -keylast $key $datum] 0
127
 
 
128
 
                set dbc($keys) $curs
129
 
                set is_long($keys) 0
130
 
                incr keys
131
 
 
132
 
                verify_t73 is_long dbc $keys $key
133
 
        }
134
 
 
135
 
        puts "\tTest0$tnum.c: Cursor put (DB_KEYFIRST); $ndups new dups,\
136
 
            short data."
137
 
 
138
 
        for { set i 0 } { $i < $ndups } { incr i } {
139
 
                # !!! keys contains the number of the next dup
140
 
                # to be added (since they start from zero)
141
 
 
142
 
                set datum [makedatum_t73 $keys 0]
143
 
                set curs [eval {$db cursor} $txn]
144
 
                error_check_good "db cursor create" [is_valid_cursor $curs $db]\
145
 
                    TRUE
146
 
                error_check_good "c_put(DB_KEYFIRST, $keys)"\
147
 
                    [$curs put -keyfirst $key $datum] 0
148
 
 
149
 
                set dbc($keys) $curs
150
 
                set is_long($keys) 0
151
 
                incr keys
152
 
 
153
 
                verify_t73 is_long dbc $keys $key
154
 
        }
155
 
 
156
 
        puts "\tTest0$tnum.d: Cursor put (DB_AFTER) first to last;\
157
 
            $keys new dups, short data"
158
 
        # We want to add a datum after each key from 0 to the current
159
 
        # value of $keys, which we thus need to save.
160
 
        set keysnow $keys
161
 
        for { set i 0 } { $i < $keysnow } { incr i } {
162
 
                set datum [makedatum_t73 $keys 0]
163
 
                set curs [eval {$db cursor} $txn]
164
 
                error_check_good "db cursor create" [is_valid_cursor $curs $db]\
165
 
                    TRUE
166
 
 
167
 
                # Which datum to insert this guy after.
168
 
                set curdatum [makedatum_t73 $i 0]
169
 
                error_check_good "c_get(DB_GET_BOTH, $i)"\
170
 
                    [$curs get -get_both $key $curdatum]\
171
 
                    [list [list $key $curdatum]]
172
 
                error_check_good "c_put(DB_AFTER, $i)"\
173
 
                    [$curs put -after $datum] 0
174
 
 
175
 
                set dbc($keys) $curs
176
 
                set is_long($keys) 0
177
 
                incr keys
178
 
 
179
 
                verify_t73 is_long dbc $keys $key
180
 
        }
181
 
 
182
 
        puts "\tTest0$tnum.e: Cursor put (DB_BEFORE) last to first;\
183
 
            $keys new dups, short data"
184
 
 
185
 
        for { set i [expr $keys - 1] } { $i >= 0 } { incr i -1 } {
186
 
                set datum [makedatum_t73 $keys 0]
187
 
                set curs [eval {$db cursor} $txn]
188
 
                error_check_good "db cursor create" [is_valid_cursor $curs $db]\
189
 
                    TRUE
190
 
 
191
 
                # Which datum to insert this guy before.
192
 
                set curdatum [makedatum_t73 $i 0]
193
 
                error_check_good "c_get(DB_GET_BOTH, $i)"\
194
 
                    [$curs get -get_both $key $curdatum]\
195
 
                    [list [list $key $curdatum]]
196
 
                error_check_good "c_put(DB_BEFORE, $i)"\
197
 
                    [$curs put -before $datum] 0
198
 
 
199
 
                set dbc($keys) $curs
200
 
                set is_long($keys) 0
201
 
                incr keys
202
 
 
203
 
                if { $i % 10 == 1 } {
204
 
                        verify_t73 is_long dbc $keys $key
205
 
                }
206
 
        }
207
 
        verify_t73 is_long dbc $keys $key
208
 
 
209
 
        puts "\tTest0$tnum.f: Cursor put (DB_CURRENT), first to last,\
210
 
            growing $keys data."
211
 
        set keysnow $keys
212
 
        for { set i 0 } { $i < $keysnow } { incr i } {
213
 
                set olddatum [makedatum_t73 $i 0]
214
 
                set newdatum [makedatum_t73 $i 1]
215
 
                set curs [eval {$db cursor} $txn]
216
 
                error_check_good "db cursor create" [is_valid_cursor $curs $db]\
217
 
                    TRUE
218
 
 
219
 
                error_check_good "c_get(DB_GET_BOTH, $i)"\
220
 
                    [$curs get -get_both $key $olddatum]\
221
 
                    [list [list $key $olddatum]]
222
 
                error_check_good "c_put(DB_CURRENT, $i)"\
223
 
                    [$curs put -current $newdatum] 0
224
 
 
225
 
                error_check_good "cursor close" [$curs close] 0
226
 
 
227
 
                set is_long($i) 1
228
 
 
229
 
                if { $i % 10 == 1 } {
230
 
                        verify_t73 is_long dbc $keys $key
231
 
                }
232
 
        }
233
 
        verify_t73 is_long dbc $keys $key
234
 
 
235
 
        # Close cursors.
236
 
        puts "\tTest0$tnum.g: Closing cursors."
237
 
        for { set i 0 } { $i < $keys } { incr i } {
238
 
                error_check_good "dbc close ($i)" [$dbc($i) close] 0
239
 
        }
240
 
        if { $txnenv == 1 } {
241
 
                error_check_good txn [$t commit] 0
242
 
        }
243
 
        error_check_good "db close" [$db close] 0
244
 
}
245
 
 
246
 
# !!!: This procedure is also used by test087.
247
 
proc makedatum_t73 { num is_long } {
248
 
        global alphabet
249
 
        if { $is_long == 1 } {
250
 
                set a $alphabet$alphabet$alphabet
251
 
        } else {
252
 
                set a abcdefghijklm
253
 
        }
254
 
 
255
 
        # format won't do leading zeros, alas.
256
 
        if { $num / 1000 > 0 } {
257
 
                set i $num
258
 
        } elseif { $num / 100 > 0 } {
259
 
                set i 0$num
260
 
        } elseif { $num / 10 > 0 } {
261
 
                set i 00$num
262
 
        } else {
263
 
                set i 000$num
264
 
        }
265
 
 
266
 
        return $i$a
267
 
}
268
 
 
269
 
# !!!: This procedure is also used by test087.
270
 
proc verify_t73 { is_long_array curs_array numkeys key } {
271
 
        upvar $is_long_array is_long
272
 
        upvar $curs_array dbc
273
 
        upvar db db
274
 
 
275
 
        #useful for debugging, perhaps.
276
 
        eval $db sync
277
 
 
278
 
        for { set j 0 } { $j < $numkeys } { incr j } {
279
 
                set dbt [$dbc($j) get -current]
280
 
                set k [lindex [lindex $dbt 0] 0]
281
 
                set d [lindex [lindex $dbt 0] 1]
282
 
 
283
 
                error_check_good\
284
 
                    "cursor $j key correctness (with $numkeys total items)"\
285
 
                    $k $key
286
 
                error_check_good\
287
 
                    "cursor $j data correctness (with $numkeys total items)"\
288
 
                    $d [makedatum_t73 $j $is_long($j)]
289
 
        }
290
 
}