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