1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2002
# Sleepycat Software. All rights reserved.
#
# $Id: sdb006.tcl,v 11.20 2002/06/20 19:01:02 sue Exp $
#
# TEST subdb006
# TEST Tests intra-subdb join
# TEST
# TEST We'll test 2-way, 3-way, and 4-way joins and figure that if those work,
# TEST everything else does as well. We'll create test databases called
# TEST sub1.db, sub2.db, sub3.db, and sub4.db. The number on the database
# TEST describes the duplication -- duplicates are of the form 0, N, 2N, 3N,
# TEST ... where N is the number of the database. Primary.db is the primary
# TEST database, and sub0.db is the database that has no matching duplicates.
# TEST All of these are within a single database.
#
# We should test this on all btrees, all hash, and a combination thereof
proc subdb006 {method {nentries 100} args } {
source ./include.tcl
global rand_init
# NB: these flags are internal only, ok
set args [convert_args $method $args]
set omethod [convert_method $method]
if { [is_record_based $method] == 1 || [is_rbtree $method] } {
puts "\tSubdb006 skipping for method $method."
return
}
set txnenv 0
set eindex [lsearch -exact $args "-env"]
#
# If we are using an env, then testfile should just be the db name.
# Otherwise it is the test directory and the name.
if { $eindex == -1 } {
set testfile $testdir/subdb006.db
set env NULL
} else {
set testfile subdb006.db
incr eindex
set env [lindex $args $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append args " -auto_commit "
if { $nentries == 100 } {
# !!!
# nentries must be greater than the number
# of do_join_subdb calls below.
#
set nentries 35
}
}
set testdir [get_home $env]
}
berkdb srand $rand_init
set oargs $args
foreach opt {" -dup" " -dupsort"} {
append args $opt
puts "Subdb006: $method ( $args ) Intra-subdb join"
set txn ""
#
# Get a cursor in each subdb and move past the end of each
# subdb. Make sure we don't end up in another subdb.
#
puts "\tSubdb006.a: Intra-subdb join"
if { $env != "NULL" } {
set testdir [get_home $env]
}
cleanup $testdir $env
set psize 8192
set duplist {0 50 25 16 12}
set numdb [llength $duplist]
build_all_subdb $testfile [list $method] $psize \
$duplist $nentries $args
# Build the primary
puts "Subdb006: Building the primary database $method"
set oflags "-create -mode 0644 [conv $omethod \
[berkdb random_int 1 2]]"
set db [eval {berkdb_open} $oflags $oargs $testfile primary.db]
error_check_good dbopen [is_valid_db $db] TRUE
for { set i 0 } { $i < 1000 } { incr i } {
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set key [format "%04d" $i]
set ret [eval {$db put} $txn {$key stub}]
error_check_good "primary put" $ret 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
}
error_check_good "primary close" [$db close] 0
set did [open $dict]
gets $did str
do_join_subdb $testfile primary.db "1 0" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "2 0" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "3 0" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4 0" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "2" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "3" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "1 2" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "1 2 3" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "1 2 3 4" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "2 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "3 2 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4 3 2 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "1 3" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "3 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "1 4" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "2 3" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "3 2" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "2 4" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4 2" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "3 4" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4 3" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "2 3 4" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "3 4 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4 2 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "0 2 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "3 2 0" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4 3 2 1" $str $oargs
gets $did str
do_join_subdb $testfile primary.db "4 3 0 1" $str $oargs
close $did
}
}
|
