← Back to branch summary

~ubuntu-branches/ubuntu/natty/evolution-data-server/natty

« back to all changes in this revision

Viewing changes to libdb/test/test030.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/test030.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  test030
9
 
# TEST  Test DB_NEXT_DUP Functionality.
10
 
proc test030 { method {nentries 10000} args } {
11
 
        global rand_init
12
 
        source ./include.tcl
13
 
 
14
 
        set args [convert_args $method $args]
15
 
        set omethod [convert_method $method]
16
 
 
17
 
        if { [is_record_based $method] == 1 ||
18
 
            [is_rbtree $method] == 1 } {
19
 
                puts "Test030 skipping for method $method"
20
 
                return
21
 
        }
22
 
        berkdb srand $rand_init
23
 
 
24
 
        # Create the database and open the dictionary
25
 
        set txnenv 0
26
 
        set eindex [lsearch -exact $args "-env"]
27
 
        #
28
 
        # If we are using an env, then testfile should just be the db name.
29
 
        # Otherwise it is the test directory and the name.
30
 
        if { $eindex == -1 } {
31
 
                set testfile $testdir/test030.db
32
 
                set cntfile $testdir/cntfile.db
33
 
                set env NULL
34
 
        } else {
35
 
                set testfile test030.db
36
 
                set cntfile cntfile.db
37
 
                incr eindex
38
 
                set env [lindex $args $eindex]
39
 
                set txnenv [is_txnenv $env]
40
 
                if { $txnenv == 1 } {
41
 
                        append args " -auto_commit "
42
 
                        #
43
 
                        # If we are using txns and running with the
44
 
                        # default, set the default down a bit.
45
 
                        #
46
 
                        if { $nentries == 10000 } {
47
 
                                set nentries 100
48
 
                        }
49
 
                }
50
 
                set testdir [get_home $env]
51
 
        }
52
 
 
53
 
        puts "Test030: $method ($args) $nentries DB_NEXT_DUP testing"
54
 
        set t1 $testdir/t1
55
 
        set t2 $testdir/t2
56
 
        set t3 $testdir/t3
57
 
        cleanup $testdir $env
58
 
 
59
 
        set db [eval {berkdb_open -create \
60
 
                -mode 0644 -dup} $args {$omethod $testfile}]
61
 
        error_check_good dbopen [is_valid_db $db] TRUE
62
 
 
63
 
        # Use a second DB to keep track of how many duplicates
64
 
        # we enter per key
65
 
 
66
 
        set cntdb [eval {berkdb_open -create \
67
 
                -mode 0644} $args {-btree $cntfile}]
68
 
        error_check_good dbopen:cntfile [is_valid_db $db] TRUE
69
 
 
70
 
        set pflags ""
71
 
        set gflags ""
72
 
        set txn ""
73
 
        set count 0
74
 
 
75
 
        # Here is the loop where we put and get each key/data pair
76
 
        # We will add between 1 and 10 dups with values 1 ... dups
77
 
        # We'll verify each addition.
78
 
 
79
 
        set did [open $dict]
80
 
        puts "\tTest030.a: put and get duplicate keys."
81
 
        if { $txnenv == 1 } {
82
 
                set t [$env txn]
83
 
                error_check_good txn [is_valid_txn $t $env] TRUE
84
 
                set txn "-txn $t"
85
 
        }
86
 
        set dbc [eval {$db cursor} $txn]
87
 
 
88
 
        while { [gets $did str] != -1 && $count < $nentries } {
89
 
                set ndup [berkdb random_int 1 10]
90
 
 
91
 
                for { set i 1 } { $i <= $ndup } { incr i 1 } {
92
 
                        set ctxn ""
93
 
                        if { $txnenv == 1 } {
94
 
                                set ct [$env txn]
95
 
                                error_check_good txn \
96
 
                                    [is_valid_txn $ct $env] TRUE
97
 
                                set ctxn "-txn $ct"
98
 
                        }
99
 
                        set ret [eval {$cntdb put} \
100
 
                            $ctxn $pflags {$str [chop_data $method $ndup]}]
101
 
                        error_check_good put_cnt $ret 0
102
 
                        if { $txnenv == 1 } {
103
 
                                error_check_good txn [$ct commit] 0
104
 
                        }
105
 
                        set datastr $i:$str
106
 
                        set ret [eval {$db put} \
107
 
                            $txn $pflags {$str [chop_data $method $datastr]}]
108
 
                        error_check_good put $ret 0
109
 
                }
110
 
 
111
 
                # Now retrieve all the keys matching this key
112
 
                set x 0
113
 
                for {set ret [$dbc get -set $str]} \
114
 
                    {[llength $ret] != 0} \
115
 
                    {set ret [$dbc get -nextdup] } {
116
 
                        incr x
117
 
 
118
 
                        if { [llength $ret] == 0 } {
119
 
                                break
120
 
                        }
121
 
 
122
 
                        set k [lindex [lindex $ret 0] 0]
123
 
                        if { [string compare $k $str] != 0 } {
124
 
                                break
125
 
                        }
126
 
 
127
 
                        set datastr [lindex [lindex $ret 0] 1]
128
 
                        set d [data_of $datastr]
129
 
                        error_check_good Test030:put $d $str
130
 
 
131
 
                        set id [ id_of $datastr ]
132
 
                        error_check_good Test030:dup# $id $x
133
 
                }
134
 
                error_check_good Test030:numdups $x $ndup
135
 
                incr count
136
 
        }
137
 
        close $did
138
 
 
139
 
        # Verify on sequential pass of entire file
140
 
        puts "\tTest030.b: sequential check"
141
 
 
142
 
        # We can't just set lastkey to a null string, since that might
143
 
        # be a key now!
144
 
        set lastkey "THIS STRING WILL NEVER BE A KEY"
145
 
 
146
 
        for {set ret [$dbc get -first]} \
147
 
            {[llength $ret] != 0} \
148
 
            {set ret [$dbc get -next] } {
149
 
 
150
 
                # Outer loop should always get a new key
151
 
 
152
 
                set k [lindex [lindex $ret 0] 0]
153
 
                error_check_bad outer_get_loop:key $k $lastkey
154
 
 
155
 
                set datastr [lindex [lindex $ret 0] 1]
156
 
                set d [data_of $datastr]
157
 
                set id [ id_of $datastr ]
158
 
 
159
 
                error_check_good outer_get_loop:data $d $k
160
 
                error_check_good outer_get_loop:id $id 1
161
 
 
162
 
                set lastkey $k
163
 
                # Figure out how may dups we should have
164
 
                if { $txnenv == 1 } {
165
 
                        set ct [$env txn]
166
 
                        error_check_good txn [is_valid_txn $ct $env] TRUE
167
 
                        set ctxn "-txn $ct"
168
 
                }
169
 
                set ret [eval {$cntdb get} $ctxn $pflags {$k}]
170
 
                set ndup [lindex [lindex $ret 0] 1]
171
 
                if { $txnenv == 1 } {
172
 
                        error_check_good txn [$ct commit] 0
173
 
                }
174
 
 
175
 
                set howmany 1
176
 
                for { set ret [$dbc get -nextdup] } \
177
 
                    { [llength $ret] != 0 } \
178
 
                    { set ret [$dbc get -nextdup] } {
179
 
                        incr howmany
180
 
 
181
 
                        set k [lindex [lindex $ret 0] 0]
182
 
                        error_check_good inner_get_loop:key $k $lastkey
183
 
 
184
 
                        set datastr [lindex [lindex $ret 0] 1]
185
 
                        set d [data_of $datastr]
186
 
                        set id [ id_of $datastr ]
187
 
 
188
 
                        error_check_good inner_get_loop:data $d $k
189
 
                        error_check_good inner_get_loop:id $id $howmany
190
 
 
191
 
                }
192
 
                error_check_good ndups_found $howmany $ndup
193
 
        }
194
 
 
195
 
        # Verify on key lookup
196
 
        puts "\tTest030.c: keyed check"
197
 
        set cnt_dbc [$cntdb cursor]
198
 
        for {set ret [$cnt_dbc get -first]} \
199
 
            {[llength $ret] != 0} \
200
 
            {set ret [$cnt_dbc get -next] } {
201
 
                set k [lindex [lindex $ret 0] 0]
202
 
 
203
 
                set howmany [lindex [lindex $ret 0] 1]
204
 
                error_check_bad cnt_seq:data [string length $howmany] 0
205
 
 
206
 
                set i 0
207
 
                for {set ret [$dbc get -set $k]} \
208
 
                    {[llength $ret] != 0} \
209
 
                    {set ret [$dbc get -nextdup] } {
210
 
                        incr i
211
 
 
212
 
                        set k [lindex [lindex $ret 0] 0]
213
 
 
214
 
                        set datastr [lindex [lindex $ret 0] 1]
215
 
                        set d [data_of $datastr]
216
 
                        set id [ id_of $datastr ]
217
 
 
218
 
                        error_check_good inner_get_loop:data $d $k
219
 
                        error_check_good inner_get_loop:id $id $i
220
 
                }
221
 
                error_check_good keyed_count $i $howmany
222
 
 
223
 
        }
224
 
        error_check_good cnt_curs_close [$cnt_dbc close] 0
225
 
        error_check_good db_curs_close [$dbc close] 0
226
 
        if { $txnenv == 1 } {
227
 
                error_check_good txn [$t commit] 0
228
 
        }
229
 
        error_check_good cnt_file_close [$cntdb close] 0
230
 
        error_check_good db_file_close [$db close] 0
231
 
}