← 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/test017.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/test017.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  test017
9
 
# TEST  Basic offpage duplicate test.
10
 
# TEST
11
 
# TEST  Run duplicates with small page size so that we test off page duplicates.
12
 
# TEST  Then after we have an off-page database, test with overflow pages too.
13
 
proc test017 { method {contents 0} {ndups 19} {tnum 17} args } {
14
 
        source ./include.tcl
15
 
 
16
 
        set args [convert_args $method $args]
17
 
        set omethod [convert_method $method]
18
 
 
19
 
        if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } {
20
 
                puts "Test0$tnum skipping for method $method"
21
 
                return
22
 
        }
23
 
        set pgindex [lsearch -exact $args "-pagesize"]
24
 
        if { $pgindex != -1 } {
25
 
                incr pgindex
26
 
                if { [lindex $args $pgindex] > 8192 } {
27
 
                        puts "Test0$tnum: Skipping for large pagesizes"
28
 
                        return
29
 
                }
30
 
        }
31
 
 
32
 
        # Create the database and open the dictionary
33
 
        set txnenv 0
34
 
        set eindex [lsearch -exact $args "-env"]
35
 
        #
36
 
        # If we are using an env, then testfile should just be the db name.
37
 
        # Otherwise it is the test directory and the name.
38
 
        if { $eindex == -1 } {
39
 
                set testfile $testdir/test0$tnum.db
40
 
                set env NULL
41
 
        } else {
42
 
                set testfile test0$tnum.db
43
 
                incr eindex
44
 
                set env [lindex $args $eindex]
45
 
                set txnenv [is_txnenv $env]
46
 
                if { $txnenv == 1 } {
47
 
                        append args " -auto_commit "
48
 
                }
49
 
                set testdir [get_home $env]
50
 
        }
51
 
        set t1 $testdir/t1
52
 
        set t2 $testdir/t2
53
 
        set t3 $testdir/t3
54
 
        set t4 $testdir/t4
55
 
 
56
 
        cleanup $testdir $env
57
 
 
58
 
        set db [eval {berkdb_open \
59
 
             -create -mode 0644 -dup} $args {$omethod $testfile}]
60
 
        error_check_good dbopen [is_valid_db $db] TRUE
61
 
 
62
 
        set pflags ""
63
 
        set gflags ""
64
 
        set txn ""
65
 
        set count 0
66
 
 
67
 
        set file_list [get_file_list 1]
68
 
        if { $txnenv == 1 } {
69
 
                set flen [llength $file_list]
70
 
                reduce_dups flen ndups
71
 
                set file_list [lrange $file_list 0 $flen]
72
 
        }
73
 
        puts "Test0$tnum: $method ($args) Off page duplicate tests with $ndups duplicates"
74
 
 
75
 
        set ovfl ""
76
 
        # Here is the loop where we put and get each key/data pair
77
 
        puts -nonewline "\tTest0$tnum.a: Creating duplicates with "
78
 
        if { $contents != 0 } {
79
 
                puts "file contents as key/data"
80
 
        } else {
81
 
                puts "file name as key/data"
82
 
        }
83
 
        foreach f $file_list {
84
 
                if { $contents != 0 } {
85
 
                        set fid [open $f r]
86
 
                        fconfigure $fid -translation binary
87
 
                        #
88
 
                        # Prepend file name to guarantee uniqueness
89
 
                        set filecont [read $fid]
90
 
                        set str $f:$filecont
91
 
                        close $fid
92
 
                } else {
93
 
                        set str $f
94
 
                }
95
 
                for { set i 1 } { $i <= $ndups } { incr i } {
96
 
                        set datastr $i:$str
97
 
                        if { $txnenv == 1 } {
98
 
                                set t [$env txn]
99
 
                                error_check_good txn [is_valid_txn $t $env] TRUE
100
 
                                set txn "-txn $t"
101
 
                        }
102
 
                        set ret [eval {$db put} \
103
 
                            $txn $pflags {$str [chop_data $method $datastr]}]
104
 
                        error_check_good put $ret 0
105
 
                        if { $txnenv == 1 } {
106
 
                                error_check_good txn [$t commit] 0
107
 
                        }
108
 
                }
109
 
 
110
 
                #
111
 
                # Save 10% files for overflow test
112
 
                #
113
 
                if { $contents == 0 && [expr $count % 10] == 0 } {
114
 
                        lappend ovfl $f
115
 
                }
116
 
                # Now retrieve all the keys matching this key
117
 
                set ret [$db get $str]
118
 
                error_check_bad $f:dbget_dups [llength $ret] 0
119
 
                error_check_good $f:dbget_dups1 [llength $ret] $ndups
120
 
                set x 1
121
 
                if { $txnenv == 1 } {
122
 
                        set t [$env txn]
123
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
124
 
                        set txn "-txn $t"
125
 
                }
126
 
                set dbc [eval {$db cursor} $txn]
127
 
                for {set ret [$dbc get "-set" $str]} \
128
 
                    {[llength $ret] != 0} \
129
 
                    {set ret [$dbc get "-next"] } {
130
 
                        set k [lindex [lindex $ret 0] 0]
131
 
                        if { [string compare $k $str] != 0 } {
132
 
                                break
133
 
                        }
134
 
                        set datastr [lindex [lindex $ret 0] 1]
135
 
                        set d [data_of $datastr]
136
 
                        if {[string length $d] == 0} {
137
 
                                break
138
 
                        }
139
 
                        error_check_good "Test0$tnum:get" $d $str
140
 
                        set id [ id_of $datastr ]
141
 
                        error_check_good "Test0$tnum:$f:dup#" $id $x
142
 
                        incr x
143
 
                }
144
 
                error_check_good "Test0$tnum:ndups:$str" [expr $x - 1] $ndups
145
 
                error_check_good cursor_close [$dbc close] 0
146
 
                if { $txnenv == 1 } {
147
 
                        error_check_good txn [$t commit] 0
148
 
                }
149
 
                incr count
150
 
        }
151
 
 
152
 
        # Now we will get each key from the DB and compare the results
153
 
        # to the original.
154
 
        puts "\tTest0$tnum.b: Checking file for correct duplicates"
155
 
        set dlist ""
156
 
        for { set i 1 } { $i <= $ndups } {incr i} {
157
 
                lappend dlist $i
158
 
        }
159
 
        set oid [open $t2.tmp w]
160
 
        set o1id [open $t4.tmp w]
161
 
        foreach f $file_list {
162
 
                for {set i 1} {$i <= $ndups} {incr i} {
163
 
                        puts $o1id $f
164
 
                }
165
 
                puts $oid $f
166
 
        }
167
 
        close $oid
168
 
        close $o1id
169
 
        filesort $t2.tmp $t2
170
 
        filesort $t4.tmp $t4
171
 
        fileremove $t2.tmp
172
 
        fileremove $t4.tmp
173
 
 
174
 
        if { $txnenv == 1 } {
175
 
                set t [$env txn]
176
 
                error_check_good txn [is_valid_txn $t $env] TRUE
177
 
                set txn "-txn $t"
178
 
        }
179
 
        dup_check $db $txn $t1 $dlist
180
 
        if { $txnenv == 1 } {
181
 
                error_check_good txn [$t commit] 0
182
 
        }
183
 
        if {$contents == 0} {
184
 
                filesort $t1 $t3
185
 
 
186
 
                error_check_good Test0$tnum:diff($t3,$t2) [filecmp $t3 $t2] 0
187
 
 
188
 
                # Now compare the keys to see if they match the file names
189
 
                if { $txnenv == 1 } {
190
 
                        set t [$env txn]
191
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
192
 
                        set txn "-txn $t"
193
 
                }
194
 
                dump_file $db $txn $t1 test017.check
195
 
                if { $txnenv == 1 } {
196
 
                        error_check_good txn [$t commit] 0
197
 
                }
198
 
                filesort $t1 $t3
199
 
 
200
 
                error_check_good Test0$tnum:diff($t3,$t4) [filecmp $t3 $t4] 0
201
 
        }
202
 
 
203
 
        error_check_good db_close [$db close] 0
204
 
        set db [eval {berkdb_open} $args $testfile]
205
 
        error_check_good dbopen [is_valid_db $db] TRUE
206
 
 
207
 
        puts "\tTest0$tnum.c: Checking file for correct duplicates after close"
208
 
        if { $txnenv == 1 } {
209
 
                set t [$env txn]
210
 
                error_check_good txn [is_valid_txn $t $env] TRUE
211
 
                set txn "-txn $t"
212
 
        }
213
 
        dup_check $db $txn $t1 $dlist
214
 
        if { $txnenv == 1 } {
215
 
                error_check_good txn [$t commit] 0
216
 
        }
217
 
 
218
 
        if {$contents == 0} {
219
 
                # Now compare the keys to see if they match the filenames
220
 
                filesort $t1 $t3
221
 
                error_check_good Test0$tnum:diff($t3,$t2) [filecmp $t3 $t2] 0
222
 
        }
223
 
        error_check_good db_close [$db close] 0
224
 
 
225
 
        puts "\tTest0$tnum.d: Verify off page duplicates and overflow status"
226
 
        set db [eval {berkdb_open} $args $testfile]
227
 
        error_check_good dbopen [is_valid_db $db] TRUE
228
 
        set stat [$db stat]
229
 
        if { [is_btree $method] } {
230
 
                error_check_bad stat:offpage \
231
 
                    [is_substr $stat "{{Internal pages} 0}"] 1
232
 
        }
233
 
        if {$contents == 0} {
234
 
                # This check doesn't work in hash, since overflow
235
 
                # pages count extra pages in buckets as well as true
236
 
                # P_OVERFLOW pages.
237
 
                if { [is_hash $method] == 0 } {
238
 
                        error_check_good overflow \
239
 
                            [is_substr $stat "{{Overflow pages} 0}"] 1
240
 
                }
241
 
        } else {
242
 
                error_check_bad overflow \
243
 
                    [is_substr $stat "{{Overflow pages} 0}"] 1
244
 
        }
245
 
 
246
 
        #
247
 
        # If doing overflow test, do that now.  Else we are done.
248
 
        # Add overflow pages by adding a large entry to a duplicate.
249
 
        #
250
 
        if { [llength $ovfl] == 0} {
251
 
                error_check_good db_close [$db close] 0
252
 
                return
253
 
        }
254
 
 
255
 
        puts "\tTest0$tnum.e: Add overflow duplicate entries"
256
 
        set ovfldup [expr $ndups + 1]
257
 
        foreach f $ovfl {
258
 
                #
259
 
                # This is just like put_file, but prepends the dup number
260
 
                #
261
 
                set fid [open $f r]
262
 
                fconfigure $fid -translation binary
263
 
                set fdata [read $fid]
264
 
                close $fid
265
 
                set data $ovfldup:$fdata:$fdata:$fdata:$fdata
266
 
 
267
 
                if { $txnenv == 1 } {
268
 
                        set t [$env txn]
269
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
270
 
                        set txn "-txn $t"
271
 
                }
272
 
                set ret [eval {$db put} $txn $pflags {$f $data}]
273
 
                error_check_good ovfl_put $ret 0
274
 
                if { $txnenv == 1 } {
275
 
                        error_check_good txn [$t commit] 0
276
 
                }
277
 
        }
278
 
 
279
 
        puts "\tTest0$tnum.f: Verify overflow duplicate entries"
280
 
        if { $txnenv == 1 } {
281
 
                set t [$env txn]
282
 
                error_check_good txn [is_valid_txn $t $env] TRUE
283
 
                set txn "-txn $t"
284
 
        }
285
 
        dup_check $db $txn $t1 $dlist $ovfldup
286
 
        if { $txnenv == 1 } {
287
 
                error_check_good txn [$t commit] 0
288
 
        }
289
 
        filesort $t1 $t3
290
 
        error_check_good Test0$tnum:diff($t3,$t2) [filecmp $t3 $t2] 0
291
 
 
292
 
        set stat [$db stat]
293
 
        if { [is_hash [$db get_type]] } {
294
 
                error_check_bad overflow1_hash [is_substr $stat \
295
 
                    "{{Number of big pages} 0}"] 1
296
 
        } else {
297
 
                error_check_bad \
298
 
                    overflow1 [is_substr $stat "{{Overflow pages} 0}"] 1
299
 
        }
300
 
        error_check_good db_close [$db close] 0
301
 
}
302
 
 
303
 
# Check function; verify data contains key
304
 
proc test017.check { key data } {
305
 
        error_check_good "data mismatch for key $key" $key [data_of $data]
306
 
}