← 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/test093.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/test093.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
 
# TEST  test093
9
 
# TEST  Test using set_bt_compare.
10
 
# TEST
11
 
# TEST  Use the first 10,000 entries from the dictionary.
12
 
# TEST  Insert each with self as key and data; retrieve each.
13
 
# TEST  After all are entered, retrieve all; compare output to original.
14
 
# TEST  Close file, reopen, do retrieve and re-verify.
15
 
proc test093 { method {nentries 10000} {tnum "93"} args} {
16
 
        source ./include.tcl
17
 
        global btvals
18
 
        global btvalsck
19
 
        global errorInfo
20
 
 
21
 
        set dbargs [convert_args $method $args]
22
 
        set omethod [convert_method $method]
23
 
 
24
 
        if { [is_btree $method] != 1 } {
25
 
                puts "Test0$tnum: skipping for method $method."
26
 
                return
27
 
        }
28
 
        set txnenv 0
29
 
        set eindex [lsearch -exact $dbargs "-env"]
30
 
        if { $eindex != -1 } {
31
 
                set testfile test0$tnum.db
32
 
                incr eindex
33
 
                set env [lindex $dbargs $eindex]
34
 
                set rpcenv [is_rpcenv $env]
35
 
                if { $rpcenv == 1 } {
36
 
                        puts "Test0$tnum: skipping for RPC"
37
 
                        return
38
 
                }
39
 
                set txnenv [is_txnenv $env]
40
 
                if { $txnenv == 1 } {
41
 
                        append dbargs " -auto_commit "
42
 
                        if { $nentries == 10000 } {
43
 
                                set nentries 100
44
 
                        }
45
 
                }
46
 
                set testdir [get_home $env]
47
 
                cleanup $testdir $env
48
 
        }
49
 
        puts "Test0$tnum: $method ($args) $nentries using btcompare"
50
 
 
51
 
 
52
 
        test093_run $omethod $dbargs $nentries $tnum test093_cmp1 test093_sort1
53
 
        test093_runbig $omethod $dbargs $nentries $tnum \
54
 
            test093_cmp1 test093_sort1
55
 
        test093_run $omethod $dbargs $nentries $tnum test093_cmp2 test093_sort2
56
 
        #
57
 
        # Don't bother running the second, really slow, comparison
58
 
        # function on test093_runbig (file contents).
59
 
 
60
 
        # Clean up so verification doesn't fail.  (There's currently
61
 
        # no way to specify a comparison function to berkdb dbverify.)
62
 
        # If we are using an env, then testfile should just be the db name.
63
 
        # Otherwise it is the test directory and the name.
64
 
        set eindex [lsearch -exact $dbargs "-env"]
65
 
        if { $eindex == -1 } {
66
 
                set env NULL
67
 
        } else {
68
 
                incr eindex
69
 
                set env [lindex $dbargs $eindex]
70
 
                set testdir [get_home $env]
71
 
        }
72
 
        cleanup $testdir $env
73
 
}
74
 
 
75
 
proc test093_run { method dbargs nentries tnum cmpfunc sortfunc } {
76
 
        source ./include.tcl
77
 
        global btvals
78
 
        global btvalsck
79
 
 
80
 
        # Create the database and open the dictionary
81
 
        set eindex [lsearch -exact $dbargs "-env"]
82
 
        #
83
 
        # If we are using an env, then testfile should just be the db name.
84
 
        # Otherwise it is the test directory and the name.
85
 
        set txnenv 0
86
 
        if { $eindex == -1 } {
87
 
                set testfile $testdir/test0$tnum.db
88
 
                set env NULL
89
 
        } else {
90
 
                set testfile test0$tnum.db
91
 
                incr eindex
92
 
                set env [lindex $dbargs $eindex]
93
 
                set txnenv [is_txnenv $env]
94
 
                set testdir [get_home $env]
95
 
        }
96
 
        cleanup $testdir $env
97
 
 
98
 
        set db [eval {berkdb_open -btcompare $cmpfunc \
99
 
             -create -mode 0644} $method $dbargs $testfile]
100
 
        error_check_good dbopen [is_valid_db $db] TRUE
101
 
        set did [open $dict]
102
 
 
103
 
        set t1 $testdir/t1
104
 
        set t2 $testdir/t2
105
 
        set t3 $testdir/t3
106
 
        set pflags ""
107
 
        set gflags ""
108
 
        set txn ""
109
 
        set btvals {}
110
 
        set btvalsck {}
111
 
        set checkfunc test093_check
112
 
        puts "\tTest0$tnum.a: put/get loop"
113
 
        # Here is the loop where we put and get each key/data pair
114
 
        set count 0
115
 
        while { [gets $did str] != -1 && $count < $nentries } {
116
 
                set key $str
117
 
                set str [reverse $str]
118
 
                if { $txnenv == 1 } {
119
 
                        set t [$env txn]
120
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
121
 
                        set txn "-txn $t"
122
 
                }
123
 
                set ret [eval \
124
 
                    {$db put} $txn $pflags {$key [chop_data $method $str]}]
125
 
                error_check_good put $ret 0
126
 
                if { $txnenv == 1 } {
127
 
                        error_check_good txn [$t commit] 0
128
 
                }
129
 
 
130
 
                lappend btvals $key
131
 
 
132
 
                set ret [eval {$db get} $gflags {$key}]
133
 
                error_check_good \
134
 
                    get $ret [list [list $key [pad_data $method $str]]]
135
 
 
136
 
                incr count
137
 
        }
138
 
        close $did
139
 
        # Now we will get each key from the DB and compare the results
140
 
        # to the original.
141
 
        puts "\tTest0$tnum.b: dump file"
142
 
        if { $txnenv == 1 } {
143
 
                set t [$env txn]
144
 
                error_check_good txn [is_valid_txn $t $env] TRUE
145
 
                set txn "-txn $t"
146
 
        }
147
 
        dump_file $db $txn $t1 $checkfunc
148
 
        if { $txnenv == 1 } {
149
 
                error_check_good txn [$t commit] 0
150
 
        }
151
 
        error_check_good db_close [$db close] 0
152
 
 
153
 
        # Now compare the keys to see if they match the dictionary (or ints)
154
 
        set q q
155
 
        filehead $nentries $dict $t2
156
 
        filesort $t2 $t3
157
 
        file rename -force $t3 $t2
158
 
        filesort $t1 $t3
159
 
 
160
 
        error_check_good Test0$tnum:diff($t3,$t2) \
161
 
            [filecmp $t3 $t2] 0
162
 
 
163
 
        puts "\tTest0$tnum.c: dump file in order"
164
 
        # Now, reopen the file and run the last test again.
165
 
        # We open it here, ourselves, because all uses of the db
166
 
        # need to have the correct comparison func set.  Then
167
 
        # call dump_file_direction directly.
168
 
        set btvalsck {}
169
 
        set db [eval {berkdb_open -btcompare $cmpfunc -rdonly} \
170
 
             $dbargs $method $testfile]
171
 
        error_check_good dbopen [is_valid_db $db] TRUE
172
 
        if { $txnenv == 1 } {
173
 
                set t [$env txn]
174
 
                error_check_good txn [is_valid_txn $t $env] TRUE
175
 
                set txn "-txn $t"
176
 
        }
177
 
        dump_file_direction $db $txn $t1 $checkfunc "-first" "-next"
178
 
        if { $txnenv == 1 } {
179
 
                error_check_good txn [$t commit] 0
180
 
        }
181
 
        error_check_good db_close [$db close] 0
182
 
 
183
 
        #
184
 
        # We need to sort btvals according to the comparison function.
185
 
        # Once that is done, btvalsck and btvals should be the same.
186
 
        puts "\tTest0$tnum.d: check file order"
187
 
 
188
 
        $sortfunc
189
 
 
190
 
        error_check_good btvals:len [llength $btvals] [llength $btvalsck]
191
 
        for {set i 0} {$i < $nentries} {incr i} {
192
 
                error_check_good vals:$i [lindex $btvals $i] \
193
 
                    [lindex $btvalsck $i]
194
 
        }
195
 
}
196
 
 
197
 
proc test093_runbig { method dbargs nentries tnum cmpfunc sortfunc } {
198
 
        source ./include.tcl
199
 
        global btvals
200
 
        global btvalsck
201
 
 
202
 
        # Create the database and open the dictionary
203
 
        set eindex [lsearch -exact $dbargs "-env"]
204
 
        #
205
 
        # If we are using an env, then testfile should just be the db name.
206
 
        # Otherwise it is the test directory and the name.
207
 
        set txnenv 0
208
 
        if { $eindex == -1 } {
209
 
                set testfile $testdir/test0$tnum.db
210
 
                set env NULL
211
 
        } else {
212
 
                set testfile test0$tnum.db
213
 
                incr eindex
214
 
                set env [lindex $dbargs $eindex]
215
 
                set txnenv [is_txnenv $env]
216
 
                set testdir [get_home $env]
217
 
        }
218
 
        cleanup $testdir $env
219
 
 
220
 
        set db [eval {berkdb_open -btcompare $cmpfunc \
221
 
             -create -mode 0644} $method $dbargs $testfile]
222
 
        error_check_good dbopen [is_valid_db $db] TRUE
223
 
 
224
 
        set t1 $testdir/t1
225
 
        set t2 $testdir/t2
226
 
        set t3 $testdir/t3
227
 
        set t4 $testdir/t4
228
 
        set t5 $testdir/t5
229
 
        set pflags ""
230
 
        set gflags ""
231
 
        set txn ""
232
 
        set btvals {}
233
 
        set btvalsck {}
234
 
        set checkfunc test093_checkbig
235
 
        puts "\tTest0$tnum.e:\
236
 
            big key put/get loop key=filecontents data=filename"
237
 
 
238
 
        # Here is the loop where we put and get each key/data pair
239
 
        set file_list [get_file_list 1]
240
 
 
241
 
        set count 0
242
 
        foreach f $file_list {
243
 
                set fid [open $f r]
244
 
                fconfigure $fid -translation binary
245
 
                set key [read $fid]
246
 
                close $fid
247
 
 
248
 
                set key $f$key
249
 
 
250
 
                set fcopy [open $t5 w]
251
 
                fconfigure $fcopy -translation binary
252
 
                puts -nonewline $fcopy $key
253
 
                close $fcopy
254
 
 
255
 
                if { $txnenv == 1 } {
256
 
                        set t [$env txn]
257
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
258
 
                        set txn "-txn $t"
259
 
                }
260
 
                set ret [eval {$db put} $txn $pflags {$key \
261
 
                    [chop_data $method $f]}]
262
 
                error_check_good put_file $ret 0
263
 
                if { $txnenv == 1 } {
264
 
                        error_check_good txn [$t commit] 0
265
 
                }
266
 
 
267
 
                lappend btvals $key
268
 
 
269
 
                # Should really catch errors
270
 
                set fid [open $t4 w]
271
 
                fconfigure $fid -translation binary
272
 
                if [catch {eval {$db get} $gflags {$key}} data] {
273
 
                        puts -nonewline $fid $data
274
 
                } else {
275
 
                        # Data looks like {{key data}}
276
 
                        set key [lindex [lindex $data 0] 0]
277
 
                        puts -nonewline $fid $key
278
 
                }
279
 
                close $fid
280
 
                error_check_good \
281
 
                    Test093:diff($t5,$t4) [filecmp $t5 $t4] 0
282
 
 
283
 
                incr count
284
 
        }
285
 
 
286
 
        # Now we will get each key from the DB and compare the results
287
 
        # to the original.
288
 
        puts "\tTest0$tnum.f: big dump file"
289
 
        if { $txnenv == 1 } {
290
 
                set t [$env txn]
291
 
                error_check_good txn [is_valid_txn $t $env] TRUE
292
 
                set txn "-txn $t"
293
 
        }
294
 
        dump_file $db $txn $t1 $checkfunc
295
 
        if { $txnenv == 1 } {
296
 
                error_check_good txn [$t commit] 0
297
 
        }
298
 
        error_check_good db_close [$db close] 0
299
 
 
300
 
        puts "\tTest0$tnum.g: dump file in order"
301
 
        # Now, reopen the file and run the last test again.
302
 
        # We open it here, ourselves, because all uses of the db
303
 
        # need to have the correct comparison func set.  Then
304
 
        # call dump_file_direction directly.
305
 
 
306
 
        set btvalsck {}
307
 
        set db [eval {berkdb_open -btcompare $cmpfunc -rdonly} \
308
 
             $dbargs $method $testfile]
309
 
        error_check_good dbopen [is_valid_db $db] TRUE
310
 
        if { $txnenv == 1 } {
311
 
                set t [$env txn]
312
 
                error_check_good txn [is_valid_txn $t $env] TRUE
313
 
                set txn "-txn $t"
314
 
        }
315
 
        dump_file_direction $db $txn $t1 $checkfunc "-first" "-next"
316
 
        if { $txnenv == 1 } {
317
 
                error_check_good txn [$t commit] 0
318
 
        }
319
 
        error_check_good db_close [$db close] 0
320
 
 
321
 
        #
322
 
        # We need to sort btvals according to the comparison function.
323
 
        # Once that is done, btvalsck and btvals should be the same.
324
 
        puts "\tTest0$tnum.h: check file order"
325
 
 
326
 
        $sortfunc
327
 
        error_check_good btvals:len [llength $btvals] [llength $btvalsck]
328
 
 
329
 
        set end [llength $btvals]
330
 
        for {set i 0} {$i < $end} {incr i} {
331
 
                error_check_good vals:$i [lindex $btvals $i] \
332
 
                    [lindex $btvalsck $i]
333
 
        }
334
 
}
335
 
 
336
 
# Simple bt comparison.
337
 
proc test093_cmp1 { a b } {
338
 
        return [string compare $b $a]
339
 
}
340
 
 
341
 
# Simple bt sorting.
342
 
proc test093_sort1 {} {
343
 
        global btvals
344
 
        #
345
 
        # This one is easy, just sort in reverse.
346
 
        #
347
 
        set btvals [lsort -decreasing $btvals]
348
 
}
349
 
 
350
 
proc test093_cmp2 { a b } {
351
 
        set arev [reverse $a]
352
 
        set brev [reverse $b]
353
 
        return [string compare $arev $brev]
354
 
}
355
 
 
356
 
proc test093_sort2 {} {
357
 
        global btvals
358
 
 
359
 
        # We have to reverse them, then sorts them.
360
 
        # Then reverse them back to real words.
361
 
        set rbtvals {}
362
 
        foreach i $btvals {
363
 
                lappend rbtvals [reverse $i]
364
 
        }
365
 
        set rbtvals [lsort -increasing $rbtvals]
366
 
        set newbtvals {}
367
 
        foreach i $rbtvals {
368
 
                lappend newbtvals [reverse $i]
369
 
        }
370
 
        set btvals $newbtvals
371
 
}
372
 
 
373
 
# Check function for test093; keys and data are identical
374
 
proc test093_check { key data } {
375
 
        global btvalsck
376
 
 
377
 
        error_check_good "key/data mismatch" $data [reverse $key]
378
 
        lappend btvalsck $key
379
 
}
380
 
 
381
 
# Check function for test093 big keys;
382
 
proc test093_checkbig { key data } {
383
 
        source ./include.tcl
384
 
        global btvalsck
385
 
 
386
 
        set fid [open $data r]
387
 
        fconfigure $fid -translation binary
388
 
        set cont [read $fid]
389
 
        close $fid
390
 
        error_check_good "key/data mismatch" $key $data$cont
391
 
        lappend btvalsck $key
392
 
}
393