← 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/test032.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/test032.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  test032
9
 
# TEST  DB_GET_BOTH, DB_GET_BOTH_RANGE
10
 
# TEST
11
 
# TEST  Use the first 10,000 entries from the dictionary.  Insert each with
12
 
# TEST  self as key and "ndups" duplicates.   For the data field, prepend the
13
 
# TEST  letters of the alphabet in a random order so we force the duplicate
14
 
# TEST  sorting code to do something.  By setting ndups large, we can make
15
 
# TEST  this an off-page test.
16
 
# TEST
17
 
# TEST  Test the DB_GET_BOTH functionality by retrieving each dup in the file
18
 
# TEST  explicitly.  Test the DB_GET_BOTH_RANGE functionality by retrieving
19
 
# TEST  the unique key prefix (cursor only).  Finally test the failure case.
20
 
proc test032 { method {nentries 10000} {ndups 5} {tnum 32} args } {
21
 
        global alphabet rand_init
22
 
        source ./include.tcl
23
 
 
24
 
        set args [convert_args $method $args]
25
 
        set omethod [convert_method $method]
26
 
 
27
 
        berkdb srand $rand_init
28
 
 
29
 
        # Create the database and open the dictionary
30
 
        set txnenv 0
31
 
        set eindex [lsearch -exact $args "-env"]
32
 
        #
33
 
        # If we are using an env, then testfile should just be the db name.
34
 
        # Otherwise it is the test directory and the name.
35
 
        if { $eindex == -1 } {
36
 
                set testfile $testdir/test0$tnum.db
37
 
                set checkdb $testdir/checkdb.db
38
 
                set env NULL
39
 
        } else {
40
 
                set testfile test0$tnum.db
41
 
                set checkdb checkdb.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
 
                        # If we are using txns and running with the
49
 
                        # default, set the default down a bit.
50
 
                        #
51
 
                        if { $nentries == 10000 } {
52
 
                                set nentries 100
53
 
                        }
54
 
                        reduce_dups nentries ndups
55
 
                }
56
 
                set testdir [get_home $env]
57
 
        }
58
 
        set t1 $testdir/t1
59
 
        set t2 $testdir/t2
60
 
        set t3 $testdir/t3
61
 
        cleanup $testdir $env
62
 
 
63
 
        puts "Test0$tnum:\
64
 
            $method ($args) $nentries small sorted $ndups dup key/data pairs"
65
 
        if { [is_record_based $method] == 1 || \
66
 
            [is_rbtree $method] == 1 } {
67
 
                puts "Test0$tnum skipping for method $omethod"
68
 
                return
69
 
        }
70
 
        set db [eval {berkdb_open -create -mode 0644 \
71
 
            $omethod -dup -dupsort} $args {$testfile} ]
72
 
        error_check_good dbopen [is_valid_db $db] TRUE
73
 
        set did [open $dict]
74
 
 
75
 
        set check_db [eval {berkdb_open \
76
 
             -create -mode 0644} $args {-hash $checkdb}]
77
 
        error_check_good dbopen:check_db [is_valid_db $check_db] TRUE
78
 
 
79
 
        set pflags ""
80
 
        set gflags ""
81
 
        set txn ""
82
 
        set count 0
83
 
 
84
 
        # Here is the loop where we put and get each key/data pair
85
 
        puts "\tTest0$tnum.a: Put/get loop"
86
 
        if { $txnenv == 1 } {
87
 
                set t [$env txn]
88
 
                error_check_good txn [is_valid_txn $t $env] TRUE
89
 
                set txn "-txn $t"
90
 
        }
91
 
        set dbc [eval {$db cursor} $txn]
92
 
        error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE
93
 
        while { [gets $did str] != -1 && $count < $nentries } {
94
 
                # Re-initialize random string generator
95
 
                randstring_init $ndups
96
 
 
97
 
                set dups ""
98
 
                for { set i 1 } { $i <= $ndups } { incr i } {
99
 
                        set pref [randstring]
100
 
                        set dups $dups$pref
101
 
                        set datastr $pref:$str
102
 
                        set ret [eval {$db put} \
103
 
                            $txn $pflags {$str [chop_data $method $datastr]}]
104
 
                        error_check_good put $ret 0
105
 
                }
106
 
                set ret [eval {$check_db put} \
107
 
                    $txn $pflags {$str [chop_data $method $dups]}]
108
 
                error_check_good checkdb_put $ret 0
109
 
 
110
 
                # Now retrieve all the keys matching this key
111
 
                set x 0
112
 
                set lastdup ""
113
 
                for {set ret [$dbc get -set $str]} \
114
 
                    {[llength $ret] != 0} \
115
 
                    {set ret [$dbc get -nextdup] } {
116
 
                        set k [lindex [lindex $ret 0] 0]
117
 
                        if { [string compare $k $str] != 0 } {
118
 
                                break
119
 
                        }
120
 
                        set datastr [lindex [lindex $ret 0] 1]
121
 
                        if {[string length $datastr] == 0} {
122
 
                                break
123
 
                        }
124
 
                        if {[string compare $lastdup $datastr] > 0} {
125
 
                                error_check_good \
126
 
                                    sorted_dups($lastdup,$datastr) 0 1
127
 
                        }
128
 
                        incr x
129
 
                        set lastdup $datastr
130
 
                }
131
 
 
132
 
                error_check_good "Test0$tnum:ndups:$str" $x $ndups
133
 
                incr count
134
 
        }
135
 
        error_check_good cursor_close [$dbc close] 0
136
 
        if { $txnenv == 1 } {
137
 
                error_check_good txn [$t commit] 0
138
 
        }
139
 
        close $did
140
 
 
141
 
        # Now we will get each key from the DB and compare the results
142
 
        # to the original.
143
 
        puts "\tTest0$tnum.b: Checking file for correct duplicates (no cursor)"
144
 
        if { $txnenv == 1 } {
145
 
                set t [$env txn]
146
 
                error_check_good txn [is_valid_txn $t $env] TRUE
147
 
                set txn "-txn $t"
148
 
        }
149
 
        set check_c [eval {$check_db cursor} $txn]
150
 
        error_check_good check_c_open(2) \
151
 
            [is_valid_cursor $check_c $check_db] TRUE
152
 
 
153
 
        for {set ndx 0} {$ndx < [expr 4 * $ndups]} {incr ndx 4} {
154
 
                for {set ret [$check_c get -first]} \
155
 
                    {[llength $ret] != 0} \
156
 
                    {set ret [$check_c get -next] } {
157
 
                        set k [lindex [lindex $ret 0] 0]
158
 
                        set d [lindex [lindex $ret 0] 1]
159
 
                        error_check_bad data_check:$d [string length $d] 0
160
 
 
161
 
                        set pref [string range $d $ndx [expr $ndx + 3]]
162
 
                        set data $pref:$k
163
 
                        set ret [eval {$db get} $txn {-get_both $k $data}]
164
 
                        error_check_good \
165
 
                            get_both_data:$k $ret [list [list $k $data]]
166
 
                }
167
 
        }
168
 
 
169
 
        $db sync
170
 
 
171
 
        # Now repeat the above test using cursor ops
172
 
        puts "\tTest0$tnum.c: Checking file for correct duplicates (cursor)"
173
 
        set dbc [eval {$db cursor} $txn]
174
 
        error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE
175
 
 
176
 
        for {set ndx 0} {$ndx < [expr 4 * $ndups]} {incr ndx 4} {
177
 
                for {set ret [$check_c get -first]} \
178
 
                    {[llength $ret] != 0} \
179
 
                    {set ret [$check_c get -next] } {
180
 
                        set k [lindex [lindex $ret 0] 0]
181
 
                        set d [lindex [lindex $ret 0] 1]
182
 
                        error_check_bad data_check:$d [string length $d] 0
183
 
 
184
 
                        set pref [string range $d $ndx [expr $ndx + 3]]
185
 
                        set data $pref:$k
186
 
                        set ret [eval {$dbc get} {-get_both $k $data}]
187
 
                        error_check_good \
188
 
                            curs_get_both_data:$k $ret [list [list $k $data]]
189
 
 
190
 
                        set ret [eval {$dbc get} {-get_both_range $k $pref}]
191
 
                        error_check_good \
192
 
                            curs_get_both_range:$k $ret [list [list $k $data]]
193
 
                }
194
 
        }
195
 
 
196
 
        # Now check the error case
197
 
        puts "\tTest0$tnum.d: Check error case (no cursor)"
198
 
        for {set ret [$check_c get -first]} \
199
 
            {[llength $ret] != 0} \
200
 
            {set ret [$check_c get -next] } {
201
 
                set k [lindex [lindex $ret 0] 0]
202
 
                set d [lindex [lindex $ret 0] 1]
203
 
                error_check_bad data_check:$d [string length $d] 0
204
 
 
205
 
                set data XXX$k
206
 
                set ret [eval {$db get} $txn {-get_both $k $data}]
207
 
                error_check_good error_case:$k [llength $ret] 0
208
 
        }
209
 
 
210
 
        # Now check the error case
211
 
        puts "\tTest0$tnum.e: Check error case (cursor)"
212
 
        for {set ret [$check_c get -first]} \
213
 
            {[llength $ret] != 0} \
214
 
            {set ret [$check_c get -next] } {
215
 
                set k [lindex [lindex $ret 0] 0]
216
 
                set d [lindex [lindex $ret 0] 1]
217
 
                error_check_bad data_check:$d [string length $d] 0
218
 
 
219
 
                set data XXX$k
220
 
                set ret [eval {$dbc get} {-get_both $k $data}]
221
 
                error_check_good error_case:$k [llength $ret] 0
222
 
        }
223
 
 
224
 
        error_check_good check_c:close [$check_c close] 0
225
 
        error_check_good dbc_close [$dbc close] 0
226
 
        if { $txnenv == 1 } {
227
 
                error_check_good txn [$t commit] 0
228
 
        }
229
 
        error_check_good check_db:close [$check_db close] 0
230
 
        error_check_good db_close [$db close] 0
231
 
}