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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2000-2002
# Sleepycat Software. All rights reserved.
#
# $Id: test085.tcl,v 1.1.1.1 2003/11/20 22:14:02 toshok Exp $
#
# TEST test085
# TEST Test of cursor behavior when a cursor is pointing to a deleted
# TEST btree key which then has duplicates added. [#2473]
proc test085 { method {pagesize 512} {onp 3} {offp 10} {tnum 85} args } {
source ./include.tcl
global alphabet
set omethod [convert_method $method]
set args [convert_args $method $args]
set encargs ""
set args [split_encargs $args encargs]
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/test0$tnum.db
set env NULL
} else {
set testfile test0$tnum.db
incr eindex
set env [lindex $args $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append args " -auto_commit "
}
set testdir [get_home $env]
}
set pgindex [lsearch -exact $args "-pagesize"]
if { $pgindex != -1 } {
puts "Test085: skipping for specific pagesizes"
return
}
cleanup $testdir $env
# Keys must sort $prekey < $key < $postkey.
set prekey "AA"
set key "BBB"
set postkey "CCCC"
# Make these distinguishable from each other and from the
# alphabets used for the $key's data.
set predatum "1234567890"
set datum $alphabet
set postdatum "0987654321"
set txn ""
append args " -pagesize $pagesize -dup"
puts -nonewline "Test0$tnum $omethod ($args): "
# Skip for all non-btrees. (Rbtrees don't count as btrees, for
# now, since they don't support dups.)
if { [is_btree $method] != 1 } {
puts "Skipping for method $method."
return
} else {
puts "Duplicates w/ deleted item cursor."
}
# Repeat the test with both on-page and off-page numbers of dups.
foreach ndups "$onp $offp" {
# Put operations we want to test on a cursor set to the
# deleted item, the key to use with them, and what should
# come before and after them given a placement of
# the deleted item at the beginning or end of the dupset.
set final [expr $ndups - 1]
set putops {
{{-before} "" $predatum {[test085_ddatum 0]} beginning}
{{-before} "" {[test085_ddatum $final]} $postdatum end}
{{-current} "" $predatum {[test085_ddatum 0]} beginning}
{{-current} "" {[test085_ddatum $final]} $postdatum end}
{{-keyfirst} $key $predatum {[test085_ddatum 0]} beginning}
{{-keyfirst} $key $predatum {[test085_ddatum 0]} end}
{{-keylast} $key {[test085_ddatum $final]} $postdatum beginning}
{{-keylast} $key {[test085_ddatum $final]} $postdatum end}
{{-after} "" $predatum {[test085_ddatum 0]} beginning}
{{-after} "" {[test085_ddatum $final]} $postdatum end}
}
# Get operations we want to test on a cursor set to the
# deleted item, any args to get, and the expected key/data pair.
set getops {
{{-current} "" "" "" beginning}
{{-current} "" "" "" end}
{{-next} "" $key {[test085_ddatum 0]} beginning}
{{-next} "" $postkey $postdatum end}
{{-prev} "" $prekey $predatum beginning}
{{-prev} "" $key {[test085_ddatum $final]} end}
{{-first} "" $prekey $predatum beginning}
{{-first} "" $prekey $predatum end}
{{-last} "" $postkey $postdatum beginning}
{{-last} "" $postkey $postdatum end}
{{-nextdup} "" $key {[test085_ddatum 0]} beginning}
{{-nextdup} "" EMPTYLIST "" end}
{{-nextnodup} "" $postkey $postdatum beginning}
{{-nextnodup} "" $postkey $postdatum end}
{{-prevnodup} "" $prekey $predatum beginning}
{{-prevnodup} "" $prekey $predatum end}
}
set txn ""
foreach pair $getops {
set op [lindex $pair 0]
puts "\tTest0$tnum: Get ($op) with $ndups duplicates,\
cursor at the [lindex $pair 4]."
set db [eval {berkdb_open -create \
-mode 0644} $omethod $encargs $args $testfile]
error_check_good "db open" [is_valid_db $db] TRUE
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn \
[is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set dbc [test085_setup $db $txn]
set beginning [expr [string compare \
[lindex $pair 4] "beginning"] == 0]
for { set i 0 } { $i < $ndups } { incr i } {
if { $beginning } {
error_check_good db_put($i) \
[eval {$db put} $txn \
{$key [test085_ddatum $i]}] 0
} else {
set c [eval {$db cursor} $txn]
set j [expr $ndups - $i - 1]
error_check_good db_cursor($j) \
[is_valid_cursor $c $db] TRUE
set d [test085_ddatum $j]
error_check_good dbc_put($j) \
[$c put -keyfirst $key $d] 0
error_check_good c_close [$c close] 0
}
}
set gargs [lindex $pair 1]
set ekey ""
set edata ""
eval set ekey [lindex $pair 2]
eval set edata [lindex $pair 3]
set dbt [eval $dbc get $op $gargs]
if { [string compare $ekey EMPTYLIST] == 0 } {
error_check_good dbt($op,$ndups) \
[llength $dbt] 0
} else {
error_check_good dbt($op,$ndups) $dbt \
[list [list $ekey $edata]]
}
error_check_good "dbc close" [$dbc close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good "db close" [$db close] 0
verify_dir $testdir "\t\t"
# Remove testfile so we can do without truncate flag.
# This is okay because we've already done verify and
# dump/load.
if { $env == "NULL" } {
set ret [eval {berkdb dbremove} \
$encargs $testfile]
} elseif { $txnenv == 1 } {
set ret [eval "$env dbremove" \
-auto_commit $encargs $testfile]
} else {
set ret [eval {berkdb dbremove} \
-env $env $encargs $testfile]
}
error_check_good dbremove $ret 0
}
foreach pair $putops {
# Open and set up database.
set op [lindex $pair 0]
puts "\tTest0$tnum: Put ($op) with $ndups duplicates,\
cursor at the [lindex $pair 4]."
set db [eval {berkdb_open -create \
-mode 0644} $omethod $args $encargs $testfile]
error_check_good "db open" [is_valid_db $db] TRUE
set beginning [expr [string compare \
[lindex $pair 4] "beginning"] == 0]
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set dbc [test085_setup $db $txn]
# Put duplicates.
for { set i 0 } { $i < $ndups } { incr i } {
if { $beginning } {
error_check_good db_put($i) \
[eval {$db put} $txn \
{$key [test085_ddatum $i]}] 0
} else {
set c [eval {$db cursor} $txn]
set j [expr $ndups - $i - 1]
error_check_good db_cursor($j) \
[is_valid_cursor $c $db] TRUE
set d [test085_ddatum $j]
error_check_good dbc_put($j) \
[$c put -keyfirst $key $d] 0
error_check_good c_close [$c close] 0
}
}
# Set up cursors for stability test.
set pre_dbc [eval {$db cursor} $txn]
error_check_good pre_set [$pre_dbc get -set $prekey] \
[list [list $prekey $predatum]]
set post_dbc [eval {$db cursor} $txn]
error_check_good post_set [$post_dbc get -set $postkey]\
[list [list $postkey $postdatum]]
set first_dbc [eval {$db cursor} $txn]
error_check_good first_set \
[$first_dbc get -get_both $key [test085_ddatum 0]] \
[list [list $key [test085_ddatum 0]]]
set last_dbc [eval {$db cursor} $txn]
error_check_good last_set \
[$last_dbc get -get_both $key [test085_ddatum \
[expr $ndups - 1]]] \
[list [list $key [test085_ddatum [expr $ndups -1]]]]
set k [lindex $pair 1]
set d_before ""
set d_after ""
eval set d_before [lindex $pair 2]
eval set d_after [lindex $pair 3]
set newdatum "NewDatum"
error_check_good dbc_put($op,$ndups) \
[eval $dbc put $op $k $newdatum] 0
error_check_good dbc_prev($op,$ndups) \
[lindex [lindex [$dbc get -prev] 0] 1] \
$d_before
error_check_good dbc_current($op,$ndups) \
[lindex [lindex [$dbc get -next] 0] 1] \
$newdatum
error_check_good dbc_next($op,$ndups) \
[lindex [lindex [$dbc get -next] 0] 1] \
$d_after
# Verify stability of pre- and post- cursors.
error_check_good pre_stable [$pre_dbc get -current] \
[list [list $prekey $predatum]]
error_check_good post_stable [$post_dbc get -current] \
[list [list $postkey $postdatum]]
error_check_good first_stable \
[$first_dbc get -current] \
[list [list $key [test085_ddatum 0]]]
error_check_good last_stable \
[$last_dbc get -current] \
[list [list $key [test085_ddatum [expr $ndups -1]]]]
foreach c "$pre_dbc $post_dbc $first_dbc $last_dbc" {
error_check_good ${c}_close [$c close] 0
}
error_check_good "dbc close" [$dbc close] 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
error_check_good "db close" [$db close] 0
verify_dir $testdir "\t\t"
# Remove testfile so we can do without truncate flag.
# This is okay because we've already done verify and
# dump/load.
if { $env == "NULL" } {
set ret [eval {berkdb dbremove} \
$encargs $testfile]
} elseif { $txnenv == 1 } {
set ret [eval "$env dbremove" \
-auto_commit $encargs $testfile]
} else {
set ret [eval {berkdb dbremove} \
-env $env $encargs $testfile]
}
error_check_good dbremove $ret 0
}
}
}
# Set up the test database; put $prekey, $key, and $postkey with their
# respective data, and then delete $key with a new cursor. Return that
# cursor, still pointing to the deleted item.
proc test085_setup { db txn } {
upvar key key
upvar prekey prekey
upvar postkey postkey
upvar predatum predatum
upvar postdatum postdatum
# no one else should ever see this one!
set datum "bbbbbbbb"
error_check_good pre_put [eval {$db put} $txn {$prekey $predatum}] 0
error_check_good main_put [eval {$db put} $txn {$key $datum}] 0
error_check_good post_put [eval {$db put} $txn {$postkey $postdatum}] 0
set dbc [eval {$db cursor} $txn]
error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
error_check_good dbc_getset [$dbc get -get_both $key $datum] \
[list [list $key $datum]]
error_check_good dbc_del [$dbc del] 0
return $dbc
}
proc test085_ddatum { a } {
global alphabet
return $a$alphabet
}
|
