1
# See the file LICENSE for redistribution information.
4
# Sleepycat Software. All rights reserved.
6
# $Id: sindex.tcl,v 1.3 2001/05/19 01:04:00 krinsky Exp $
8
# Secondary index test driver and maintenance routines.
10
# Breaking from the usual convention, we put the driver function
11
# for the secondary index tests here, in its own file. The reason
12
# for this is that it's something which compartmentalizes nicely,
13
# has little in common with other driver functions, and
14
# is likely to be run on its own from time to time.
16
# The secondary index tests themselves live in si0*.tcl.
18
# Standard number of secondary indices to create if a single-element
19
# list of methods is passed into the secondary index tests.
23
# Run the secondary index tests.
24
proc sindex { {verbose 1} args } {
25
global verbose_check_secondaries
26
set verbose_check_secondaries $verbose
28
# Run basic tests with a single secondary index and a small number
29
# of keys, then again with a larger number of keys. (Note that
30
# we can't go above 5000, since we use two items from our
31
# 10K-word list for each key/data pair.)
32
foreach n { 200 5000 } {
33
foreach pm { btree hash recno frecno queue queueext } {
34
foreach sm { dbtree dhash ddbtree ddhash btree hash } {
35
sindex001 [list $pm $sm $sm] $n
36
sindex002 [list $pm $sm $sm] $n
37
# Skip tests 3 & 4 for large lists;
38
# they're not that interesting.
40
sindex003 [list $pm $sm $sm] $n
41
sindex004 [list $pm $sm $sm] $n
47
# Run secondary index join test. (There's no point in running
48
# this with both lengths, the primary is unhappy for now with fixed-
49
# length records (XXX), and we need unsorted dups in the secondaries.)
50
foreach pm { btree hash recno } {
51
foreach sm { btree hash } {
52
sindex005 [list $pm $sm $sm] 1000
54
sindex005 [list $pm btree hash] 1000
55
sindex005 [list $pm hash btree] 1000
59
# Run test with 50 secondaries.
60
foreach pm { btree hash } {
61
set methlist [list $pm]
62
for { set i 0 } { $i < 50 } { incr i } {
63
# XXX this should incorporate hash after #3726
65
lappend methlist "dbtree"
67
lappend methlist "ddbtree"
70
sindex001 $methlist 500
71
sindex002 $methlist 500
72
sindex003 $methlist 500
73
sindex004 $methlist 500
77
# The callback function we use for each given secondary in most tests
78
# is a simple function of its place in the list of secondaries (0-based)
79
# and the access method (since recnos may need different callbacks).
82
# Note that callbacks 0-3 return unique secondary keys if the input data
83
# are unique; callbacks 4 and higher may not, so don't use them with
84
# the normal wordlist and secondaries that don't support dups.
85
# The callbacks that incorporate a key don't work properly with recno
86
# access methods, at least not in the current test framework (the
87
# error_check_good lines test for e.g. 1foo, when the database has
88
# e.g. 0x010x000x000x00foo).
89
proc callback_n { n } {
91
0 { return _s_reversedata }
93
2 { return _s_concatkeydata }
94
3 { return _s_concatdatakey }
95
4 { return _s_reverseconcat }
96
5 { return _s_truncdata }
97
6 { return _s_alwayscocacola }
102
proc _s_reversedata { a b } { return [reverse $b] }
103
proc _s_truncdata { a b } { return [string range $b 1 end] }
104
proc _s_concatkeydata { a b } { return $a$b }
105
proc _s_concatdatakey { a b } { return $b$a }
106
proc _s_reverseconcat { a b } { return [reverse $a$b] }
107
proc _s_alwayscocacola { a b } { return "Coca-Cola" }
108
proc _s_noop { a b } { return $b }
110
# Should the check_secondary routines print lots of output?
111
set verbose_check_secondaries 0
113
# Given a primary database handle, a list of secondary handles, a
114
# number of entries, and arrays of keys and data, verify that all
115
# databases have what they ought to.
116
proc check_secondaries { pdb sdbs nentries keyarr dataarr {pref "Check"} } {
119
global verbose_check_secondaries
121
# Make sure each key/data pair is in the primary.
122
if { $verbose_check_secondaries } {
123
puts "\t\t$pref.1: Each key/data pair is in the primary"
125
for { set i 0 } { $i < $nentries } { incr i } {
126
error_check_good pdb_get($i) [$pdb get $keys($i)] \
127
[list [list $keys($i) $data($i)]]
130
for { set j 0 } { $j < [llength $sdbs] } { incr j } {
131
# Make sure each key/data pair is in this secondary.
132
if { $verbose_check_secondaries } {
134
Each skey/key/data tuple is in secondary #$j"
136
for { set i 0 } { $i < $nentries } { incr i } {
137
set sdb [lindex $sdbs $j]
138
set skey [[callback_n $j] $keys($i) $data($i)]
139
error_check_good sdb($j)_pget($i) \
140
[$sdb pget -get_both $skey $keys($i)] \
141
[list [list $skey $keys($i) $data($i)]]
144
# Make sure this secondary contains only $nentries
146
if { $verbose_check_secondaries } {
147
puts "\t\t$pref.3: Secondary #$j has $nentries items"
149
set dbc [$sdb cursor]
150
error_check_good dbc($i) \
151
[is_valid_cursor $dbc $sdb] TRUE
152
for { set k 0 } { [llength [$dbc get -next]] > 0 } \
154
error_check_good numitems($i) $k $nentries
155
error_check_good dbc($i)_close [$dbc close] 0
158
if { $verbose_check_secondaries } {
159
puts "\t\t$pref.4: Primary has $nentries items"
161
set dbc [$pdb cursor]
162
error_check_good pdbc [is_valid_cursor $dbc $pdb] TRUE
163
for { set k 0 } { [llength [$dbc get -next]] > 0 } { incr k } { }
164
error_check_good numitems $k $nentries
165
error_check_good pdbc_close [$dbc close] 0
168
# Given a primary database handle and a list of secondary handles, walk
169
# through the primary and make sure all the secondaries are correct,
170
# then walk through the secondaries and make sure the primary is correct.
172
# This is slightly less rigorous than the normal check_secondaries--we
173
# use it whenever we don't have up-to-date "keys" and "data" arrays.
174
proc cursor_check_secondaries { pdb sdbs nentries { pref "Check" } } {
175
global verbose_check_secondaries
177
# Make sure each key/data pair in the primary is in each secondary.
178
set pdbc [$pdb cursor]
179
error_check_good ccs_pdbc [is_valid_cursor $pdbc $pdb] TRUE
181
if { $verbose_check_secondaries } {
183
Key/data in primary => key/data in secondaries"
186
for { set dbt [$pdbc get -first] } { [llength $dbt] > 0 } \
187
{ set dbt [$pdbc get -next] } {
189
set pkey [lindex [lindex $dbt 0] 0]
190
set pdata [lindex [lindex $dbt 0] 1]
191
for { set j 0 } { $j < [llength $sdbs] } { incr j } {
192
set sdb [lindex $sdbs $j]
193
set sdbt [$sdb pget -get_both \
194
[[callback_n $j] $pkey $pdata] $pkey]
195
error_check_good pkey($pkey,$j) \
196
[lindex [lindex $sdbt 0] 1] $pkey
197
error_check_good pdata($pdata,$j) \
198
[lindex [lindex $sdbt 0] 2] $pdata
201
error_check_good ccs_pdbc_close [$pdbc close] 0
202
error_check_good primary_has_nentries $i $nentries
204
for { set j 0 } { $j < [llength $sdbs] } { incr j } {
205
if { $verbose_check_secondaries } {
207
Key/data in secondary #$j => key/data in primary"
209
set sdb [lindex $sdbs $j]
210
set sdbc [$sdb cursor]
211
error_check_good ccs_sdbc($j) [is_valid_cursor $sdbc $sdb] TRUE
213
for { set dbt [$sdbc pget -first] } { [llength $dbt] > 0 } \
214
{ set dbt [$sdbc pget -next] } {
216
set pkey [lindex [lindex $dbt 0] 1]
217
set pdata [lindex [lindex $dbt 0] 2]
218
error_check_good pdb_get($pkey/$pdata,$j) \
219
[$pdb get -get_both $pkey $pdata] \
220
[list [list $pkey $pdata]]
222
error_check_good secondary($j)_has_nentries $i $nentries
224
# To exercise pget -last/pget -prev, we do it backwards too.
226
for { set dbt [$sdbc pget -last] } { [llength $dbt] > 0 } \
227
{ set dbt [$sdbc pget -prev] } {
229
set pkey [lindex [lindex $dbt 0] 1]
230
set pdata [lindex [lindex $dbt 0] 2]
231
error_check_good pdb_get_bkwds($pkey/$pdata,$j) \
232
[$pdb get -get_both $pkey $pdata] \
233
[list [list $pkey $pdata]]
235
error_check_good secondary($j)_has_nentries_bkwds $i $nentries
237
error_check_good ccs_sdbc_close($j) [$sdbc close] 0
241
# The secondary index tests take a list of the access methods that
242
# each array ought to use. Convert at one blow into a list of converted
243
# argses and omethods for each method in the list.
244
proc convert_argses { methods largs } {
247
lappend ret [convert_args $m $largs]
251
proc convert_methods { methods } {
254
lappend ret [convert_method $m]
added
removed
db/test/sindex.tcl
