← 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/test094.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/test094.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  test094
9
 
# TEST  Test using set_dup_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 test094 { method {nentries 10000} {ndups 10} {tnum "94"} args} {
16
 
        source ./include.tcl
17
 
        global errorInfo
18
 
 
19
 
        set dbargs [convert_args $method $args]
20
 
        set omethod [convert_method $method]
21
 
 
22
 
        if { [is_btree $method] != 1 && [is_hash $method] != 1 } {
23
 
                puts "Test0$tnum: skipping for method $method."
24
 
                return
25
 
        }
26
 
 
27
 
        set txnenv 0
28
 
        set eindex [lsearch -exact $dbargs "-env"]
29
 
        # Create the database and open the dictionary
30
 
        #
31
 
        # If we are using an env, then testfile should just be the db name.
32
 
        # Otherwise it is the test directory and the name.
33
 
        if { $eindex == -1 } {
34
 
                set testfile $testdir/test0$tnum-a.db
35
 
                set env NULL
36
 
        } else {
37
 
                set testfile test0$tnum-a.db
38
 
                incr eindex
39
 
                set env [lindex $dbargs $eindex]
40
 
                set rpcenv [is_rpcenv $env]
41
 
                if { $rpcenv == 1 } {
42
 
                        puts "Test0$tnum: skipping for RPC"
43
 
                        return
44
 
                }
45
 
                set txnenv [is_txnenv $env]
46
 
                if { $txnenv == 1 } {
47
 
                        append dbargs " -auto_commit "
48
 
                        if { $nentries == 10000 } {
49
 
                                set nentries 100
50
 
                        }
51
 
                        reduce_dups nentries ndups
52
 
                }
53
 
                set testdir [get_home $env]
54
 
        }
55
 
        puts "Test0$tnum: $method ($args) $nentries \
56
 
            with $ndups dups using dupcompare"
57
 
 
58
 
        cleanup $testdir $env
59
 
 
60
 
        set db [eval {berkdb_open_noerr -dupcompare test094_cmp \
61
 
            -dup -dupsort -create -mode 0644} $omethod $dbargs {$testfile}]
62
 
        error_check_good dbopen [is_valid_db $db] TRUE
63
 
 
64
 
        set did [open $dict]
65
 
        set t1 $testdir/t1
66
 
        set pflags ""
67
 
        set gflags ""
68
 
        set txn ""
69
 
        puts "\tTest0$tnum.a: $nentries put/get duplicates loop"
70
 
        # Here is the loop where we put and get each key/data pair
71
 
        set count 0
72
 
        set dlist {}
73
 
        for {set i 0} {$i < $ndups} {incr i} {
74
 
                set dlist [linsert $dlist 0 $i]
75
 
        }
76
 
        while { [gets $did str] != -1 && $count < $nentries } {
77
 
                set key $str
78
 
                for {set i 0} {$i < $ndups} {incr i} {
79
 
                        set data $i:$str
80
 
                        if { $txnenv == 1 } {
81
 
                                set t [$env txn]
82
 
                                error_check_good txn [is_valid_txn $t $env] TRUE
83
 
                                set txn "-txn $t"
84
 
                        }
85
 
                        set ret [eval {$db put} \
86
 
                            $txn $pflags {$key [chop_data $omethod $data]}]
87
 
                        error_check_good put $ret 0
88
 
                        if { $txnenv == 1 } {
89
 
                                error_check_good txn [$t commit] 0
90
 
                        }
91
 
                }
92
 
 
93
 
                set ret [eval {$db get} $gflags {$key}]
94
 
                error_check_good get [llength $ret] $ndups
95
 
                incr count
96
 
        }
97
 
        close $did
98
 
        # Now we will get each key from the DB and compare the results
99
 
        # to the original.
100
 
        puts "\tTest0$tnum.b: traverse checking duplicates before close"
101
 
        if { $txnenv == 1 } {
102
 
                set t [$env txn]
103
 
                error_check_good txn [is_valid_txn $t $env] TRUE
104
 
                set txn "-txn $t"
105
 
        }
106
 
        dup_check $db $txn $t1 $dlist
107
 
        if { $txnenv == 1 } {
108
 
                error_check_good txn [$t commit] 0
109
 
        }
110
 
        error_check_good db_close [$db close] 0
111
 
 
112
 
        # Set up second testfile so truncate flag is not needed.
113
 
        # If we are using an env, then testfile should just be the db name.
114
 
        # Otherwise it is the test directory and the name.
115
 
        if { $eindex == -1 } {
116
 
                set testfile $testdir/test0$tnum-b.db
117
 
                set env NULL
118
 
        } else {
119
 
                set testfile test0$tnum-b.db
120
 
                set env [lindex $dbargs $eindex]
121
 
                set testdir [get_home $env]
122
 
        }
123
 
        cleanup $testdir $env
124
 
 
125
 
        #
126
 
        # Test dupcompare with data items big enough to force offpage dups.
127
 
        #
128
 
        puts "\tTest0$tnum.c: big key put/get dup loop key=filename data=filecontents"
129
 
        set db [eval {berkdb_open -dupcompare test094_cmp -dup -dupsort \
130
 
             -create -mode 0644} $omethod $dbargs $testfile]
131
 
        error_check_good dbopen [is_valid_db $db] TRUE
132
 
 
133
 
        # Here is the loop where we put and get each key/data pair
134
 
        set file_list [get_file_list 1]
135
 
        if { [llength $file_list] > $nentries } {
136
 
                set file_list [lrange $file_list 1 $nentries]
137
 
        }
138
 
 
139
 
        set count 0
140
 
        foreach f $file_list {
141
 
                set fid [open $f r]
142
 
                fconfigure $fid -translation binary
143
 
                set cont [read $fid]
144
 
                close $fid
145
 
 
146
 
                set key $f
147
 
                for {set i 0} {$i < $ndups} {incr i} {
148
 
                        set data $i:$cont
149
 
                        if { $txnenv == 1 } {
150
 
                                set t [$env txn]
151
 
                                error_check_good txn [is_valid_txn $t $env] TRUE
152
 
                                set txn "-txn $t"
153
 
                        }
154
 
                        set ret [eval {$db put} \
155
 
                            $txn $pflags {$key [chop_data $omethod $data]}]
156
 
                        error_check_good put $ret 0
157
 
                        if { $txnenv == 1 } {
158
 
                                error_check_good txn [$t commit] 0
159
 
                        }
160
 
                }
161
 
 
162
 
                set ret [eval {$db get} $gflags {$key}]
163
 
                error_check_good get [llength $ret] $ndups
164
 
                incr count
165
 
        }
166
 
 
167
 
        puts "\tTest0$tnum.d: traverse checking duplicates before close"
168
 
        if { $txnenv == 1 } {
169
 
                set t [$env txn]
170
 
                error_check_good txn [is_valid_txn $t $env] TRUE
171
 
                set txn "-txn $t"
172
 
        }
173
 
        dup_file_check $db $txn $t1 $dlist
174
 
        if { $txnenv == 1 } {
175
 
                error_check_good txn [$t commit] 0
176
 
                set testdir [get_home $env]
177
 
        }
178
 
        error_check_good db_close [$db close] 0
179
 
 
180
 
        # Clean up the test directory, since there's currently
181
 
        # no way to specify a dup_compare function to berkdb dbverify
182
 
        # and without one it will fail.
183
 
        cleanup $testdir $env
184
 
}
185
 
 
186
 
# Simple dup comparison.
187
 
proc test094_cmp { a b } {
188
 
        return [string compare $b $a]
189
 
}
190
 
 
191
 
# Check if each key appears exactly [llength dlist] times in the file with
192
 
# the duplicate tags matching those that appear in dlist.
193
 
proc test094_dup_big { db txn tmpfile dlist {extra 0}} {
194
 
        source ./include.tcl
195
 
 
196
 
        set outf [open $tmpfile w]
197
 
        # Now we will get each key from the DB and dump to outfile
198
 
        set c [eval {$db cursor} $txn]
199
 
        set lastkey ""
200
 
        set done 0
201
 
        while { $done != 1} {
202
 
                foreach did $dlist {
203
 
                        set rec [$c get "-next"]
204
 
                        if { [string length $rec] == 0 } {
205
 
                                set done 1
206
 
                                break
207
 
                        }
208
 
                        set key [lindex [lindex $rec 0] 0]
209
 
                        set fulldata [lindex [lindex $rec 0] 1]
210
 
                        set id [id_of $fulldata]
211
 
                        set d [data_of $fulldata]
212
 
                        if { [string compare $key $lastkey] != 0 && \
213
 
                            $id != [lindex $dlist 0] } {
214
 
                                set e [lindex $dlist 0]
215
 
                                error "FAIL: \tKey \
216
 
                                    $key, expected dup id $e, got $id"
217
 
                        }
218
 
                        error_check_good dupget.data $d $key
219
 
                        error_check_good dupget.id $id $did
220
 
                        set lastkey $key
221
 
                }
222
 
                #
223
 
                # Some tests add an extra dup (like overflow entries)
224
 
                # Check id if it exists.
225
 
                if { $extra != 0} {
226
 
                        set okey $key
227
 
                        set rec [$c get "-next"]
228
 
                        if { [string length $rec] != 0 } {
229
 
                                set key [lindex [lindex $rec 0] 0]
230
 
                                #
231
 
                                # If this key has no extras, go back for
232
 
                                # next iteration.
233
 
                                if { [string compare $key $lastkey] != 0 } {
234
 
                                        set key $okey
235
 
                                        set rec [$c get "-prev"]
236
 
                                } else {
237
 
                                        set fulldata [lindex [lindex $rec 0] 1]
238
 
                                        set id [id_of $fulldata]
239
 
                                        set d [data_of $fulldata]
240
 
                                        error_check_bad dupget.data1 $d $key
241
 
                                        error_check_good dupget.id1 $id $extra
242
 
                                }
243
 
                        }
244
 
                }
245
 
                if { $done != 1 } {
246
 
                        puts $outf $key
247
 
                }
248
 
        }
249
 
        close $outf
250
 
        error_check_good curs_close [$c close] 0
251
 
}