1
# See the file LICENSE for redistribution information.
3
# Copyright (c) 2000-2001
4
# Sleepycat Software. All rights reserved.
6
# $Id: test095.tcl,v 1.1.2.1 2001/07/23 20:40:23 jbj Exp $
8
# DB Test 95 {access method}
11
proc test095 { method {nsets 1000} {noverflows 25} {tnum 95} args } {
13
set args [convert_args $method $args]
14
set omethod [convert_method $method]
16
set eindex [lsearch -exact $args "-env"]
18
# If we are using an env, then testfile should just be the db name.
19
# Otherwise it is the test directory and the name.
20
if { $eindex == -1 } {
21
set basename $testdir/test0$tnum
23
# If we've our own env, no reason to swap--this isn't
25
set carg { -cachesize {0 25000000 0} }
27
set basename test0$tnum
29
set env [lindex $args $eindex]
34
puts "Test0$tnum: $method ($args) Bulk get test"
36
if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } {
37
puts "Test0$tnum skipping for method $method"
41
# We run the meat of the test twice: once with unsorted dups,
42
# once with sorted dups.
43
for { set dflag "-dup"; set sort "unsorted"; set diter 0 } \
45
{ set dflag "-dup -dupsort"; set sort "sorted"; incr diter } {
46
set testfile $basename-$sort.db
49
# Open and populate the database with $nsets sets of dups.
50
# Each set contains as many dups as its number
51
puts "\tTest0$tnum.a:\
52
Creating database with $nsets sets of $sort dups."
53
set dargs "$dflag $carg $args"
54
set db [eval {berkdb_open -create} $omethod $dargs $testfile]
55
error_check_good db_open [is_valid_db $db] TRUE
56
t95_populate $db $did $nsets 0
58
# Run basic get tests.
59
t95_gettest $db $tnum b [expr 8192] 1
60
t95_gettest $db $tnum c [expr 10 * 8192] 0
62
# Run cursor get tests.
63
t95_cgettest $db $tnum d [expr 100] 1
64
t95_cgettest $db $tnum e [expr 10 * 8192] 0
66
set m [expr 4000 * $noverflows]
67
puts "\tTest0$tnum.f: Growing\
68
database with $noverflows overflow sets (max item size $m)"
69
t95_populate $db $did $noverflows 4000
71
# Run overflow get tests.
72
t95_gettest $db $tnum g [expr 10 * 8192] 1
73
t95_gettest $db $tnum h [expr $m * 2] 1
74
t95_gettest $db $tnum i [expr $m * $noverflows * 2] 0
76
# Run cursor get tests.
77
t95_cgettest $db $tnum j [expr 10 * 8192] 1
78
t95_cgettest $db $tnum k [expr $m * 2] 0
80
error_check_good db_close [$db close] 0
86
proc t95_gettest { db tnum letter bufsize expectfail } {
87
t95_gettest_body $db $tnum $letter $bufsize $expectfail 0
89
proc t95_cgettest { db tnum letter bufsize expectfail } {
90
t95_gettest_body $db $tnum $letter $bufsize $expectfail 1
93
proc t95_gettest_body { db tnum letter bufsize expectfail usecursor } {
96
if { $usecursor == 0 } {
97
set action "db get -multi"
99
set action "dbc get -multi -set/-next"
101
puts "\tTest0$tnum.$letter: $action with bufsize $bufsize"
106
# Cursor for $usecursor.
107
if { $usecursor != 0 } {
108
set getcurs [$db cursor]
109
error_check_good getcurs [is_valid_cursor $getcurs $db] TRUE
112
# Traverse DB with cursor; do get/c_get(DB_MULTIPLE) on each item.
114
error_check_good is_valid_dbc [is_valid_cursor $dbc $db] TRUE
115
for { set dbt [$dbc get -first] } { [llength $dbt] != 0 } \
116
{ set dbt [$dbc get -nextnodup] } {
117
set key [lindex [lindex $dbt 0] 0]
118
set datum [lindex [lindex $dbt 0] 1]
120
if { $usecursor == 0 } {
121
set ret [catch {eval $db get -multi $bufsize $key} res]
124
for { set ret [catch {eval $getcurs get -multi $bufsize\
126
{ $ret == 0 && [llength $tres] != 0 } \
127
{ set ret [catch {eval $getcurs get -multi $bufsize\
129
eval lappend res $tres
133
# If we expect a failure, be more tolerant if the above fails;
134
# just make sure it's an ENOMEM, mark it, and move along.
135
if { $expectfail != 0 && $ret != 0 } {
136
error_check_good multi_failure_errcode \
137
[is_substr $errorCode ENOMEM] 1
141
error_check_good get_multi($key) $ret 0
142
t95_verify $res FALSE
145
set ret [catch {eval $db get -multi $bufsize} res]
147
if { $expectfail == 1 } {
148
error_check_good allpassed $allpassed FALSE
149
puts "\t\tTest0$tnum.$letter:\
150
returned at least one ENOMEM (as expected)"
152
error_check_good allpassed $allpassed TRUE
153
puts "\t\tTest0$tnum.$letter: succeeded (as expected)"
156
error_check_good dbc_close [$dbc close] 0
157
if { $usecursor != 0 } {
158
error_check_good getcurs_close [$getcurs close] 0
162
# Verify that a passed-in list of key/data pairs all match the predicted
163
# structure (e.g. {{thing1 thing1.0}}, {{key2 key2.0} {key2 key2.1}}).
164
proc t95_verify { res multiple_keys } {
169
set orig_key [lindex [lindex $res 0] 0]
170
set nkeys [string trim $orig_key $alphabet']
171
set base_key [string trim $orig_key 0123456789]
175
set key [lindex [lindex $res $i] 0]
176
set datum [lindex [lindex $res $i] 1]
178
if { $datum_count >= $nkeys } {
179
if { [llength $key] != 0 } {
180
# If there are keys beyond $nkeys, we'd
181
# better have multiple_keys set.
182
error_check_bad "keys beyond number $i allowed"\
185
# If multiple_keys is set, accept the new key.
187
set nkeys [eval string trim \
188
$orig_key {$alphabet'}]
189
set base_key [eval string trim \
190
$orig_key 0123456789]
193
# datum_count has hit nkeys. We're done.
198
error_check_good returned_key($i) $key $orig_key
199
error_check_good returned_datum($i) \
200
$datum $base_key.[format %4u $datum_count]
206
# Add nsets dup sets, each consisting of {word$ndups word$n} pairs,
207
# with "word" having (i * pad_bytes) bytes extra padding.
208
proc t95_populate { db did nsets pad_bytes } {
209
for { set i 1 } { $i <= $nsets } { incr i } {
210
# basekey is a padded dictionary word
213
append basekey [repeat "a" [expr $pad_bytes * $i]]
215
# key is basekey with the number of dups stuck on.
218
for { set j 0 } { $j < $i } { incr j } {
219
set data $basekey.[format %4u $j]
220
error_check_good db_put($key,$data) \
221
[$db put $key $data] 0
225
# This will make debugging easier, and since the database is
226
# read-only from here out, it's cheap.
227
error_check_good db_sync [$db sync] 0
added
removed
db/test/test095.tcl
