blob: ff623d74d6759251fc9b0d1bb178260b875187d9 (
plain)
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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2000-2009 Oracle. All rights reserved.
#
# $Id$
#
# TEST test102
# TEST Bulk get test for record-based methods. [#2934]
proc test102 { method {nsets 1000} {tnum "102"} args } {
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
if { [is_rbtree $method] == 1 || [is_record_based $method] == 0} {
puts "Test$tnum 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 basename $testdir/test$tnum
set env NULL
# If we've our own env, no reason to swap--this isn't
# an mpool test.
set carg { -cachesize {0 25000000 0} }
} else {
set basename test$tnum
incr eindex
set env [lindex $args $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
puts "Skipping for environment with txns"
return
}
set testdir [get_home $env]
set carg {}
}
cleanup $testdir $env
puts "Test$tnum: $method ($args) Bulk get test"
# Open and populate the database.
puts "\tTest$tnum.a: Creating $method database\
with $nsets entries."
set dargs "$carg $args"
set testfile $basename.db
set db [eval {berkdb_open_noerr -create} $omethod $dargs $testfile]
error_check_good db_open [is_valid_db $db] TRUE
t102_populate $db $method $nsets $txnenv 0
# Determine the pagesize so we can use it to size the buffer.
set stat [$db stat]
set pagesize [get_pagesize $stat]
# Run get tests. The gettest should succeed as long as
# the buffer is at least as large as the page size. Test for
# failure of a small buffer unless the page size is so small
# we can't define a smaller buffer (buffers must be multiples
# of 1024). A "big buffer" should succeed in all cases because
# we define it to be larger than 65536, the largest page
# currently allowed.
set maxpage [expr 1024 * 64]
set bigbuf [expr $maxpage + 1024]
set smallbuf 1024
# Run regular db->get tests.
if { $pagesize > 1024 } {
t102_gettest $db $tnum b $smallbuf 1
} else {
puts "Skipping Test$tnum.b for small pagesize."
}
t102_gettest $db $tnum c $bigbuf 0
# Run cursor get tests.
if { $pagesize > 1024 } {
t102_gettest $db $tnum d $smallbuf 1
} else {
puts "Skipping Test$tnum.b for small pagesize."
}
t102_cgettest $db $tnum e $bigbuf 0
if { [is_fixed_length $method] == 1 } {
puts "Skipping overflow tests for fixed-length method $omethod."
} else {
# Set up for overflow tests
puts "\tTest$tnum.f: Growing database with overflow sets"
t102_populate $db $method [expr $nsets / 100] $txnenv 10000
# Run overflow get tests. Test should fail for overflow pages
# with our standard big buffer but succeed at twice that size.
t102_gettest $db $tnum g $bigbuf 1
t102_gettest $db $tnum h [expr $bigbuf * 2] 0
# Run overflow cursor get tests. Test will fail for overflow
# pages with 8K buffer but succeed with a large buffer.
t102_cgettest $db $tnum i 8192 1
t102_cgettest $db $tnum j $bigbuf 0
}
error_check_good db_close [$db close] 0
}
proc t102_gettest { db tnum letter bufsize expectfail } {
t102_gettest_body $db $tnum $letter $bufsize $expectfail 0
}
proc t102_cgettest { db tnum letter bufsize expectfail } {
t102_gettest_body $db $tnum $letter $bufsize $expectfail 1
}
# Basic get test
proc t102_gettest_body { db tnum letter bufsize expectfail usecursor } {
global errorCode
foreach flag { multi multi_key } {
if { $usecursor == 0 } {
if { $flag == "multi_key" } {
# db->get does not allow multi_key
continue
} else {
set action "db get -$flag"
}
} else {
set action "dbc get -$flag -set/-next"
}
puts "\tTest$tnum.$letter: $action with bufsize $bufsize"
set allpassed TRUE
set saved_err ""
# Cursor for $usecursor.
if { $usecursor != 0 } {
set getcurs [$db cursor]
error_check_good \
getcurs [is_valid_cursor $getcurs $db] TRUE
}
# Traverse DB with cursor; do get/c_get($flag) on each item.
set dbc [$db cursor]
error_check_good is_valid_dbc [is_valid_cursor $dbc $db] TRUE
for { set dbt [$dbc get -first] } { [llength $dbt] != 0 } \
{ set dbt [$dbc get -next] } {
set key [lindex [lindex $dbt 0] 0]
set datum [lindex [lindex $dbt 0] 1]
if { $usecursor == 0 } {
set ret [catch \
{eval $db get -$flag $bufsize $key} res]
} else {
set res {}
for { set ret [catch {eval $getcurs get\
-$flag $bufsize -set $key} tres] } \
{ $ret == 0 && [llength $tres] != 0 } \
{ set ret [catch {eval $getcurs get\
-$flag $bufsize -next} tres]} {
eval lappend res $tres
}
}
# If we expect a failure, be more tolerant if the above
# fails; just make sure it's a DB_BUFFER_SMALL or an
# EINVAL (if the buffer is smaller than the pagesize,
# it's EINVAL), mark it, and move along.
if { $expectfail != 0 && $ret != 0 } {
if { [is_substr $errorCode DB_BUFFER_SMALL] != 1 && \
[is_substr $errorCode EINVAL] != 1 } {
error_check_good \
"$flag failure errcode" \
$errorCode "DB_BUFFER_SMALL or EINVAL"
}
set allpassed FALSE
continue
}
error_check_good "get_$flag ($key)" $ret 0
}
if { $expectfail == 1 } {
error_check_good allpassed $allpassed FALSE
puts "\t\tTest$tnum.$letter:\
returned at least one DB_BUFFER_SMALL (as expected)"
} else {
error_check_good allpassed $allpassed TRUE
puts "\t\tTest$tnum.$letter: succeeded (as expected)"
}
error_check_good dbc_close [$dbc close] 0
if { $usecursor != 0 } {
error_check_good getcurs_close [$getcurs close] 0
}
}
}
proc t102_populate { db method nentries txnenv pad_bytes } {
source ./include.tcl
set did [open $dict]
set count 0
set txn ""
set pflags ""
set gflags " -recno "
while { [gets $did str] != -1 && $count < $nentries } {
set key [expr $count + 1]
set datastr $str
# Create overflow pages only if method is not fixed-length.
if { [is_fixed_length $method] == 0 } {
append datastr [repeat "a" $pad_bytes]
}
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set ret [eval {$db put} \
$txn $pflags {$key [chop_data $method $datastr]}]
error_check_good put $ret 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
set ret [eval {$db get} $gflags {$key}]
error_check_good $key:dbget [llength $ret] 1
incr count
}
close $did
# This will make debugging easier, and since the database is
# read-only from here out, it's cheap.
error_check_good db_sync [$db sync] 0
}
|
