← 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/join.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/join.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  jointest
9
 
# TEST  Test duplicate assisted joins.  Executes 1, 2, 3 and 4-way joins
10
 
# TEST  with differing index orders and selectivity.
11
 
# TEST
12
 
# TEST  We'll test 2-way, 3-way, and 4-way joins and figure that if those
13
 
# TEST  work, everything else does as well.  We'll create test databases
14
 
# TEST  called join1.db, join2.db, join3.db, and join4.db.  The number on
15
 
# TEST  the database describes the duplication -- duplicates are of the
16
 
# TEST  form 0, N, 2N, 3N, ...  where N is the number of the database.
17
 
# TEST  Primary.db is the primary database, and null.db is the database
18
 
# TEST  that has no matching duplicates.
19
 
# TEST
20
 
# TEST  We should test this on all btrees, all hash, and a combination thereof
21
 
proc jointest { {psize 8192} {with_dup_dups 0} {flags 0} } {
22
 
        global testdir
23
 
        global rand_init
24
 
        source ./include.tcl
25
 
 
26
 
        env_cleanup $testdir
27
 
        berkdb srand $rand_init
28
 
 
29
 
        # Use one environment for all database opens so we don't
30
 
        # need oodles of regions.
31
 
        set env [berkdb_env -create -home $testdir]
32
 
        error_check_good env_open [is_valid_env $env] TRUE
33
 
 
34
 
        # With the new offpage duplicate code, we don't support
35
 
        # duplicate duplicates in sorted dup sets.  Thus, if with_dup_dups
36
 
        # is greater than one, run only with "-dup".
37
 
        if { $with_dup_dups > 1 } {
38
 
                set doptarray {"-dup"}
39
 
        } else {
40
 
                set doptarray {"-dup -dupsort" "-dup" RANDOMMIX RANDOMMIX }
41
 
        }
42
 
 
43
 
        # NB: these flags are internal only, ok
44
 
        foreach m "DB_BTREE DB_HASH DB_BOTH" {
45
 
                # run with two different random mixes.
46
 
                foreach dopt $doptarray {
47
 
                        set opt [list "-env" $env $dopt]
48
 
 
49
 
                        puts "Join test: ($m $dopt) psize $psize,\
50
 
                            $with_dup_dups dup\
51
 
                            dups, flags $flags."
52
 
 
53
 
                        build_all $m $psize $opt oa $with_dup_dups
54
 
 
55
 
                        # null.db is db_built fifth but is referenced by
56
 
                        # zero;  set up the option array appropriately.
57
 
                        set oa(0) $oa(5)
58
 
 
59
 
                        # Build the primary
60
 
                        puts "\tBuilding the primary database $m"
61
 
                        set oflags "-create -truncate -mode 0644 -env $env\
62
 
                            [conv $m [berkdb random_int 1 2]]"
63
 
                        set db [eval {berkdb_open} $oflags primary.db]
64
 
                        error_check_good dbopen [is_valid_db $db] TRUE
65
 
                        for { set i 0 } { $i < 1000 } { incr i } {
66
 
                                set key [format "%04d" $i]
67
 
                                set ret [$db put $key stub]
68
 
                                error_check_good "primary put" $ret 0
69
 
                        }
70
 
                        error_check_good "primary close" [$db close] 0
71
 
                        set did [open $dict]
72
 
                        gets $did str
73
 
                        do_join primary.db "1 0" $str oa $flags\
74
 
                            $with_dup_dups
75
 
                        gets $did str
76
 
                        do_join primary.db "2 0" $str oa $flags\
77
 
                            $with_dup_dups
78
 
                        gets $did str
79
 
                        do_join primary.db "3 0" $str oa $flags\
80
 
                            $with_dup_dups
81
 
                        gets $did str
82
 
                        do_join primary.db "4 0" $str oa $flags\
83
 
                            $with_dup_dups
84
 
                        gets $did str
85
 
                        do_join primary.db "1" $str oa $flags $with_dup_dups
86
 
                        gets $did str
87
 
                        do_join primary.db "2" $str oa $flags $with_dup_dups
88
 
                        gets $did str
89
 
                        do_join primary.db "3" $str oa $flags $with_dup_dups
90
 
                        gets $did str
91
 
                        do_join primary.db "4" $str oa $flags $with_dup_dups
92
 
                        gets $did str
93
 
                        do_join primary.db "1 2" $str oa $flags\
94
 
                            $with_dup_dups
95
 
                        gets $did str
96
 
                        do_join primary.db "1 2 3" $str oa $flags\
97
 
                            $with_dup_dups
98
 
                        gets $did str
99
 
                        do_join primary.db "1 2 3 4" $str oa $flags\
100
 
                            $with_dup_dups
101
 
                        gets $did str
102
 
                        do_join primary.db "2 1" $str oa $flags\
103
 
                            $with_dup_dups
104
 
                        gets $did str
105
 
                        do_join primary.db "3 2 1" $str oa $flags\
106
 
                            $with_dup_dups
107
 
                        gets $did str
108
 
                        do_join primary.db "4 3 2 1" $str oa $flags\
109
 
                            $with_dup_dups
110
 
                        gets $did str
111
 
                        do_join primary.db "1 3" $str oa $flags $with_dup_dups
112
 
                        gets $did str
113
 
                        do_join primary.db "3 1" $str oa $flags $with_dup_dups
114
 
                        gets $did str
115
 
                        do_join primary.db "1 4" $str oa $flags $with_dup_dups
116
 
                        gets $did str
117
 
                        do_join primary.db "4 1" $str oa $flags $with_dup_dups
118
 
                        gets $did str
119
 
                        do_join primary.db "2 3" $str oa $flags $with_dup_dups
120
 
                        gets $did str
121
 
                        do_join primary.db "3 2" $str oa $flags $with_dup_dups
122
 
                        gets $did str
123
 
                        do_join primary.db "2 4" $str oa $flags $with_dup_dups
124
 
                        gets $did str
125
 
                        do_join primary.db "4 2" $str oa $flags $with_dup_dups
126
 
                        gets $did str
127
 
                        do_join primary.db "3 4" $str oa $flags $with_dup_dups
128
 
                        gets $did str
129
 
                        do_join primary.db "4 3" $str oa $flags $with_dup_dups
130
 
                        gets $did str
131
 
                        do_join primary.db "2 3 4" $str oa $flags\
132
 
                            $with_dup_dups
133
 
                        gets $did str
134
 
                        do_join primary.db "3 4 1" $str oa $flags\
135
 
                            $with_dup_dups
136
 
                        gets $did str
137
 
                        do_join primary.db "4 2 1" $str oa $flags\
138
 
                            $with_dup_dups
139
 
                        gets $did str
140
 
                        do_join primary.db "0 2 1" $str oa $flags\
141
 
                            $with_dup_dups
142
 
                        gets $did str
143
 
                        do_join primary.db "3 2 0" $str oa $flags\
144
 
                            $with_dup_dups
145
 
                        gets $did str
146
 
                        do_join primary.db "4 3 2 1" $str oa $flags\
147
 
                            $with_dup_dups
148
 
                        gets $did str
149
 
                        do_join primary.db "4 3 0 1" $str oa $flags\
150
 
                            $with_dup_dups
151
 
                        gets $did str
152
 
                        do_join primary.db "3 3 3" $str oa $flags\
153
 
                            $with_dup_dups
154
 
                        gets $did str
155
 
                        do_join primary.db "2 2 3 3" $str oa $flags\
156
 
                            $with_dup_dups
157
 
                        gets $did str2
158
 
                        gets $did str
159
 
                        do_join primary.db "1 2" $str oa $flags\
160
 
                            $with_dup_dups "3" $str2
161
 
 
162
 
                        # You really don't want to run this section
163
 
                        # with $with_dup_dups > 2.
164
 
                        if { $with_dup_dups <= 2 } {
165
 
                                gets $did str2
166
 
                                gets $did str
167
 
                                do_join primary.db "1 2 3" $str\
168
 
                                    oa $flags $with_dup_dups "3 3 1" $str2
169
 
                                gets $did str2
170
 
                                gets $did str
171
 
                                do_join primary.db "4 0 2" $str\
172
 
                                    oa $flags $with_dup_dups "4 3 3" $str2
173
 
                                gets $did str2
174
 
                                gets $did str
175
 
                                do_join primary.db "3 2 1" $str\
176
 
                                    oa $flags $with_dup_dups "0 2" $str2
177
 
                                gets $did str2
178
 
                                gets $did str
179
 
                                do_join primary.db "2 2 3 3" $str\
180
 
                                    oa $flags $with_dup_dups "1 4 4" $str2
181
 
                                gets $did str2
182
 
                                gets $did str
183
 
                                do_join primary.db "2 2 3 3" $str\
184
 
                                    oa $flags $with_dup_dups "0 0 4 4" $str2
185
 
                                gets $did str2
186
 
                                gets $did str
187
 
                                do_join primary.db "2 2 3 3" $str2\
188
 
                                    oa $flags $with_dup_dups "2 4 4" $str
189
 
                                gets $did str2
190
 
                                gets $did str
191
 
                                do_join primary.db "2 2 3 3" $str2\
192
 
                                    oa $flags $with_dup_dups "0 0 4 4" $str
193
 
                        }
194
 
                        close $did
195
 
                }
196
 
        }
197
 
 
198
 
        error_check_good env_close [$env close] 0
199
 
}
200
 
 
201
 
proc build_all { method psize opt oaname with_dup_dups {nentries 100} } {
202
 
        global testdir
203
 
        db_build join1.db $nentries 50 1 [conv $method 1]\
204
 
            $psize $opt $oaname $with_dup_dups
205
 
        db_build join2.db $nentries 25 2 [conv $method 2]\
206
 
            $psize $opt $oaname $with_dup_dups
207
 
        db_build join3.db $nentries 16 3 [conv $method 3]\
208
 
            $psize $opt $oaname $with_dup_dups
209
 
        db_build join4.db $nentries 12 4 [conv $method 4]\
210
 
            $psize $opt $oaname $with_dup_dups
211
 
        db_build null.db $nentries 0 5 [conv $method 5]\
212
 
            $psize $opt $oaname $with_dup_dups
213
 
}
214
 
 
215
 
proc conv { m i } {
216
 
        switch -- $m {
217
 
                DB_HASH { return "-hash"}
218
 
                "-hash" { return "-hash"}
219
 
                DB_BTREE { return "-btree"}
220
 
                "-btree" { return "-btree"}
221
 
                DB_BOTH {
222
 
                        if { [expr $i % 2] == 0 } {
223
 
                                return "-hash";
224
 
                        } else {
225
 
                                return "-btree";
226
 
                        }
227
 
                }
228
 
        }
229
 
}
230
 
 
231
 
proc random_opts { } {
232
 
        set j [berkdb random_int 0 1]
233
 
        if { $j == 0 } {
234
 
                return " -dup"
235
 
        } else {
236
 
                return " -dup -dupsort"
237
 
        }
238
 
}
239
 
 
240
 
proc db_build { name nkeys ndups dup_interval method psize lopt oaname \
241
 
    with_dup_dups } {
242
 
        source ./include.tcl
243
 
 
244
 
        # Get array of arg names (from two levels up the call stack)
245
 
        upvar 2 $oaname oa
246
 
 
247
 
        # Search for "RANDOMMIX" in $opt, and if present, replace
248
 
        # with " -dup" or " -dup -dupsort" at random.
249
 
        set i [lsearch $lopt RANDOMMIX]
250
 
        if { $i != -1 } {
251
 
                set lopt [lreplace $lopt $i $i [random_opts]]
252
 
        }
253
 
 
254
 
        # Save off db_open arguments for this database.
255
 
        set opt [eval concat $lopt]
256
 
        set oa($dup_interval) $opt
257
 
 
258
 
        # Create the database and open the dictionary
259
 
        set oflags "-create -truncate -mode 0644 $method\
260
 
            -pagesize $psize"
261
 
        set db [eval {berkdb_open} $oflags $opt $name]
262
 
        error_check_good dbopen [is_valid_db $db] TRUE
263
 
        set did [open $dict]
264
 
        set count 0
265
 
        puts -nonewline "\tBuilding $name: $nkeys keys "
266
 
        puts -nonewline "with $ndups duplicates at interval of $dup_interval"
267
 
        if { $with_dup_dups > 0 } {
268
 
                puts ""
269
 
                puts "\t\tand $with_dup_dups duplicate duplicates."
270
 
        } else {
271
 
                puts "."
272
 
        }
273
 
        for { set count 0 } { [gets $did str] != -1 && $count < $nkeys } {
274
 
            incr count} {
275
 
                set str $str$name
276
 
                # We need to make sure that the dups are inserted in a
277
 
                # random, or near random, order.  Do this by generating
278
 
                # them and putting each in a list, then sorting the list
279
 
                # at random.
280
 
                set duplist {}
281
 
                for { set i 0 } { $i < $ndups } { incr i } {
282
 
                        set data [format "%04d" [expr $i * $dup_interval]]
283
 
                        lappend duplist $data
284
 
                }
285
 
                # randomize the list
286
 
                for { set i 0 } { $i < $ndups } {incr i } {
287
 
                #       set j [berkdb random_int $i [expr $ndups - 1]]
288
 
                        set j [expr ($i % 2) + $i]
289
 
                        if { $j >= $ndups } { set j $i }
290
 
                        set dupi [lindex $duplist $i]
291
 
                        set dupj [lindex $duplist $j]
292
 
                        set duplist [lreplace $duplist $i $i $dupj]
293
 
                        set duplist [lreplace $duplist $j $j $dupi]
294
 
                }
295
 
                foreach data $duplist {
296
 
                        if { $with_dup_dups != 0 } {
297
 
                                for { set j 0 }\
298
 
                                    { $j < $with_dup_dups }\
299
 
                                    {incr j} {
300
 
                                        set ret [$db put $str $data]
301
 
                                        error_check_good put$j $ret 0
302
 
                                }
303
 
                        } else {
304
 
                                set ret [$db put $str $data]
305
 
                                error_check_good put $ret 0
306
 
                        }
307
 
                }
308
 
 
309
 
                if { $ndups == 0 } {
310
 
                        set ret [$db put $str NODUP]
311
 
                        error_check_good put $ret 0
312
 
                }
313
 
        }
314
 
        close $did
315
 
        error_check_good close:$name [$db close] 0
316
 
}
317
 
 
318
 
proc do_join { primary dbs key oanm flags with_dup_dups {dbs2 ""} {key2 ""} } {
319
 
        global testdir
320
 
        source ./include.tcl
321
 
 
322
 
        upvar $oanm oa
323
 
 
324
 
        puts -nonewline "\tJoining: $dbs on $key"
325
 
        if { $dbs2 == "" } {
326
 
            puts ""
327
 
        } else {
328
 
            puts " with $dbs2 on $key2"
329
 
        }
330
 
 
331
 
        # Open all the databases
332
 
        set p [berkdb_open -unknown $testdir/$primary]
333
 
        error_check_good "primary open" [is_valid_db $p] TRUE
334
 
 
335
 
        set dblist ""
336
 
        set curslist ""
337
 
 
338
 
        set ndx [llength $dbs]
339
 
 
340
 
        foreach i [concat $dbs $dbs2] {
341
 
                set opt $oa($i)
342
 
                set db [eval {berkdb_open -unknown} $opt [n_to_name $i]]
343
 
                error_check_good "[n_to_name $i] open" [is_valid_db $db] TRUE
344
 
                set curs [$db cursor]
345
 
                error_check_good "$db cursor" \
346
 
                    [is_substr $curs "$db.c"] 1
347
 
                lappend dblist $db
348
 
                lappend curslist $curs
349
 
 
350
 
                if { $ndx > 0 } {
351
 
                    set realkey [concat $key[n_to_name $i]]
352
 
                } else {
353
 
                    set realkey [concat $key2[n_to_name $i]]
354
 
                }
355
 
 
356
 
                set pair [$curs get -set $realkey]
357
 
                error_check_good cursor_set:$realkey:$pair \
358
 
                        [llength [lindex $pair 0]] 2
359
 
 
360
 
                incr ndx -1
361
 
        }
362
 
 
363
 
        set join_curs [eval {$p join} $curslist]
364
 
        error_check_good join_cursor \
365
 
            [is_substr $join_curs "$p.c"] 1
366
 
 
367
 
        # Calculate how many dups we expect.
368
 
        # We go through the list of indices.  If we find a 0, then we
369
 
        # expect 0 dups.  For everything else, we look at pairs of numbers,
370
 
        # if the are relatively prime, multiply them and figure out how
371
 
        # many times that goes into 50.  If they aren't relatively prime,
372
 
        # take the number of times the larger goes into 50.
373
 
        set expected 50
374
 
        set last 1
375
 
        foreach n [concat $dbs $dbs2] {
376
 
                if { $n == 0 } {
377
 
                        set expected 0
378
 
                        break
379
 
                }
380
 
                if { $last == $n } {
381
 
                        continue
382
 
                }
383
 
 
384
 
                if { [expr $last % $n] == 0 || [expr $n % $last] == 0 } {
385
 
                        if { $n > $last } {
386
 
                                set last $n
387
 
                                set expected [expr 50 / $last]
388
 
                        }
389
 
                } else {
390
 
                        set last [expr $n * $last / [gcd $n $last]]
391
 
                        set expected [expr 50 / $last]
392
 
                }
393
 
        }
394
 
 
395
 
        # If $with_dup_dups is greater than zero, each datum has
396
 
        # been inserted $with_dup_dups times.  So we expect the number
397
 
        # of dups to go up by a factor of ($with_dup_dups)^(number of databases)
398
 
 
399
 
        if { $with_dup_dups > 0 } {
400
 
                foreach n [concat $dbs $dbs2] {
401
 
                        set expected [expr $expected * $with_dup_dups]
402
 
                }
403
 
        }
404
 
 
405
 
        set ndups 0
406
 
        if { $flags == " -join_item"} {
407
 
                set l 1
408
 
        } else {
409
 
                set flags ""
410
 
                set l 2
411
 
        }
412
 
        for { set pair [eval {$join_curs get} $flags] } { \
413
 
                [llength [lindex $pair 0]] == $l } {
414
 
            set pair [eval {$join_curs get} $flags] } {
415
 
                set k [lindex [lindex $pair 0] 0]
416
 
                foreach i $dbs {
417
 
                        error_check_bad valid_dup:$i:$dbs $i 0
418
 
                        set kval [string trimleft $k 0]
419
 
                        if { [string length $kval] == 0 } {
420
 
                                set kval 0
421
 
                        }
422
 
                        error_check_good valid_dup:$i:$dbs [expr $kval % $i] 0
423
 
                }
424
 
                incr ndups
425
 
        }
426
 
        error_check_good number_of_dups:$dbs $ndups $expected
427
 
 
428
 
        error_check_good close_primary [$p close] 0
429
 
        foreach i $curslist {
430
 
                error_check_good close_cursor:$i [$i close] 0
431
 
        }
432
 
        foreach i $dblist {
433
 
                error_check_good close_index:$i [$i close] 0
434
 
        }
435
 
}
436
 
 
437
 
proc n_to_name { n } {
438
 
global testdir
439
 
        if { $n == 0 } {
440
 
                return null.db;
441
 
        } else {
442
 
                return join$n.db;
443
 
        }
444
 
}
445
 
 
446
 
proc gcd { a b } {
447
 
        set g 1
448
 
 
449
 
        for { set i 2 } { $i <= $a } { incr i } {
450
 
                if { [expr $a % $i] == 0 && [expr $b % $i] == 0 } {
451
 
                        set g $i
452
 
                }
453
 
        }
454
 
        return $g
455
 
}