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 333 334 335 336 337 338 339 340 341 342 343 344 345
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2010, 2013 Oracle and/or its affiliates. All rights reserved.
#
# $Id$
#
# TEST test127
# TEST Test database bulk update.
# TEST
# TEST This is essentially test126 with duplicates.
# TEST To make it simple we use numerical keys all the time.
# TEST
# TEST Put with -multiple, then with -multiple_key,
# TEST and make sure the items in database are what we want.
# TEST Later, delete some items with -multiple, then with -multiple_key,
# TEST and make sure if the correct items are deleted.
proc test127 {method { nentries 10000 } { ndups 5} { tnum "127" }
{subdb 0} {sort_multiple 0} args } {
source ./include.tcl
global alphabet
if {[is_btree $method] != 1 && [is_hash $method] != 1} {
puts "Skipping test$tnum for $method."
return
}
# It is only makes sense for btree database to sort bulk buffer.
if {$sort_multiple && ![is_btree $method]} {
puts "Skipping test$tnum for $method with -sort_multiple."
return
}
# For compressed databases, we need to sort the items in
# the bulk buffer before doing the bulk put/delete operations.
if {[is_compressed $args] && !$sort_multiple} {
puts "Skipping test$tnum for compressed databases\
without -sort_multiple."
return
}
set args [convert_args $method $args]
set subname ""
set save_msg "with duplicates"
if { $subdb } {
if {[is_partitioned $args]} {
puts "Skipping test$tnum with sub database\
for partitioned $method test."
return
}
set subname "subdb"
set save_msg "$save_msg using sub databases"
}
# If we are using an env, then basename should just be the db name.
# Otherwise it is the test directory and the name.
set eindex [lsearch -exact $args "-env"]
set txnenv 0
set txn ""
if { $eindex == -1 } {
set basename $testdir/test$tnum
set env NULL
set orig_testdir $testdir
} else {
set basename test$tnum
incr eindex
set env [lindex $args $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append args " -auto_commit "
}
set orig_testdir [get_home $env]
}
set extra_op ""
if {$sort_multiple} {
set extra_op "-sort_multiple"
}
if {[is_compressed $args]} {
set options [list "-dup -dupsort"]
} else {
set options [list "-dup -dupsort" "-dup"]
}
set i 0
foreach ex_args $options {
set dboargs [concat $args $ex_args]
set fname $basename.db
set dbname $subname
puts "Test$tnum: $method ($dboargs)\
Database bulk update $save_msg."
if {$subdb} {
set dbname $subname.$i
} else {
set fname $basename.$i.db
}
test127_sub $fname $dbname $dboargs
incr i
}
}
proc test127_sub {fname dbname dboargs} {
source ./include.tcl
global alphabet
upvar method method
upvar nentries nentries
upvar ndups ndups
upvar tnum tnum
upvar subdb subdb
upvar txnenv txnenv
upvar env env
upvar extra_op extra_op
upvar orig_testdir orig_testdir
set testdir $orig_testdir
cleanup $testdir $env
set sorted [is_substr $dboargs "-dupsort"]
set omethod [convert_method $method]
set db [eval {berkdb_open_noerr -create -mode 0644} \
$dboargs $omethod $fname $dbname]
error_check_good dbopen [is_valid_db $db] TRUE
set txn ""
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
# Do bulk put.
# First, we put half the entries using put -multiple.
# Then, we put the rest half using put -multiple_key.
puts "\tTest$tnum.a: Bulk put data using -multiple $extra_op."
set key_list1 {}
set data_list1 {}
set key_list {}
set datas_list {}
for { set i 1 } { $i < $nentries / 2} { incr i } {
lappend key_list $i
set datas {}
for { set j 1 } { $j <= $ndups } { incr j } {
set str $i.$j.$alphabet
lappend key_list1 $i
lappend data_list1 [chop_data $method $str]
lappend datas [chop_data $method $str]
}
lappend datas_list $datas
}
set ret [eval {$db put} $txn -multiple $extra_op \
{$key_list1 $data_list1}]
error_check_good "put(-multiple $extra_op)" $ret 0
# Put again without -overwritedup, should return DB_KEYEXIST.
set ret [catch {eval {$db put} \
$txn -multiple $extra_op {$key_list1 $data_list1}} res]
if {$sorted} {
error_check_good \
{Check DB_KEYEXIST} [is_substr $res DB_KEYEXIST] 1
} else {
error_check_good "put_again(-multiple $extra_op)" $ret 0
}
# Put again with -overwritedup, should succeed
set ret [eval {$db put} \
$txn -multiple $extra_op -overwritedup {$key_list1 $data_list1}]
error_check_good "put_again(-multiple $extra_op -overwritedup)" $ret 0
puts "\tTest$tnum.b: Bulk put data using -multiple_key $extra_op."
set pair_list1 {}
for { set i [expr $nentries / 2 ]} { $i <= $nentries} { incr i } {
lappend key_list $i
set datas {}
for { set j 1 } { $j <= $ndups } { incr j } {
set str $i.$j.$alphabet
lappend pair_list1 $i [chop_data $method $str]
lappend datas [chop_data $method $str]
}
lappend datas_list $datas
}
set ret [eval {$db put} $txn -multiple_key $extra_op {$pair_list1}]
error_check_good "put(-multiple_key $extra_op)" $ret 0
# Put again without -overwritedup, should return DB_KEYEXIST.
set ret [catch {
eval {$db put} $txn -multiple_key $extra_op {$pair_list1}} res]
if {$sorted} {
error_check_good \
{Check DB_KEYEXIST} [is_substr $res DB_KEYEXIST] 1
} else {
error_check_good "put_again(-multiple_key $extra_op)" $ret 0
}
# Put again with -overwritedup, should succeed
set ret [eval \
{$db put} $txn -multiple_key $extra_op -overwritedup {$pair_list1}]
error_check_good \
"put_again(-multiple_key $extra_op -overwritedup)" $ret 0
puts "\tTest$tnum.c: Verify the data after bulk put."
test127_check_prirecords $db $key_list $datas_list $txn $sorted
puts "\tTest$tnum.d: Bulk delete data using -multiple $extra_op."
set key_list2 {}
for { set i 1 } { $i <= $nentries} { incr i 2 } {
lappend key_list2 $i
}
set ret [eval {$db del} $txn -multiple $extra_op {$key_list2}]
error_check_good "del(-multiple $extra_op)" $ret 0
# Delete again, should return DB_NOTFOUND.
set ret [catch {eval {$db del} $txn -multiple $extra_op \
{$key_list2}} res]
error_check_good {Check DB_NOTFOUND} [is_substr $res DB_NOTFOUND] 1
puts "\tTest$tnum.e: Bulk delete using -multiple_key $extra_op."
set pair_list2 {}
for { set i 2 } { $i <= $nentries} { incr i 2} {
for { set j 1 } { $j <= $ndups / 2 } { incr j } {
set str $i.$j.$alphabet
lappend pair_list2 $i [chop_data $method $str]
}
}
set ret [eval {$db del} $txn -multiple_key $extra_op {$pair_list2}]
error_check_good "del(-multiple_key $extra_op)" $ret 0
# Delete again, should return DB_NOTFOUND.
set ret [catch {eval {$db del} $txn -multiple_key $extra_op \
{$pair_list2}} res]
if {$sorted} {
error_check_good {Check DB_NOTFOUND} [is_substr $res DB_NOTFOUND] 1
} else {
error_check_good "del(-multiple_key $extra_op) 2 round" $ret 0
set ret [catch {eval {$db del} $txn -multiple_key $extra_op \
{$pair_list2}} res]
error_check_good "del(-multiple_key $extra_op) 3 round" $ret 0
set ret [catch {eval {$db del} $txn -multiple_key $extra_op \
{$pair_list2}} res]
error_check_good {Check DB_NOTFOUND} [is_substr $res DB_NOTFOUND] 1
}
puts "\tTest$tnum.f: Verify the data after bulk delete."
# Check if the specified items are deleted
set dbc [eval $db cursor $txn]
error_check_good $dbc [is_valid_cursor $dbc $db] TRUE
set len [llength $key_list2]
for {set i 0} {$i < $len} {incr i} {
set key [lindex $key_list2 $i]
set pair [$dbc get -set $key]
error_check_good pair [llength $pair] 0
}
set len [llength $pair_list2]
for {set indx1 0; set indx2 1} {$indx2 < $len} \
{incr indx1 2; incr indx2 2} {
set key [lindex $pair_list2 $indx1]
set data [lindex $pair_list2 $indx2]
set pair [$dbc get -get_both $key $data]
error_check_good pair [llength $pair] 0
}
# Check all items to mare sure we do not delete other items.
set orig_key_list $key_list
set orig_datas_list $datas_list
set key_list {}
set datas_list {}
set i 0
set j 0
set k 0
while {$i < $nentries} {
set datas [lindex $orig_datas_list $i]
set key1 [lindex $orig_key_list $i]
set key2 [lindex $key_list2 $j]
set key3 [lindex $pair_list2 $k]
if {$key1 == $key2} {
incr i
incr j
continue
} elseif {$key1 == $key3} {
while {$key1 == $key3} {
set data_index [expr $k + 1]
set data [lindex $pair_list2 $data_index]
set index [lsearch -exact $datas $data]
error_check_bad data_index -1 $index
set datas [lreplace $datas $index $index]
incr k 2
set key3 [lindex $pair_list2 $k]
}
}
if {[llength $datas] > 0} {
lappend key_list $key1
lappend datas_list $datas
}
incr i
}
test127_check_prirecords $db $key_list $datas_list $txn $sorted
if { $txnenv == 1 } {
error_check_good txn_commit [$t commit] 0
}
error_check_good db_close [$db close] 0
}
proc test127_check_prirecords {db key_list datas_list txnarg sorted} {
set dbc [eval $db cursor $txnarg]
error_check_good $dbc [is_valid_cursor $dbc $db] TRUE
# Check if all the records are in key_list(key) and datas_list(data).
for {set pair [$dbc get -first]} {[llength $pair] > 0} \
{set pair [$dbc get -next]} {
set key [lindex [lindex $pair 0] 0]
set data [lindex [lindex $pair 0] 1]
set index [lsearch -exact $key_list $key]
error_check_bad key_index $index -1
error_check_bad data_index -1 \
[lsearch -exact [lindex $datas_list $index] $data]
}
error_check_good $dbc.close [$dbc close] 0
# Check if all the items in the lists are in the database.
set len [llength $key_list]
for {set i 0} {$i < $len} {incr i} {
set key [lindex $key_list $i]
set datas [lindex $datas_list $i]
set pairs [eval $db get $txnarg $key]
error_check_bad pairs [llength $pairs] 0
if {$sorted} {
error_check_good pairs [llength $pairs] [llength $datas]
} else {
error_check_good pairs [expr \
[llength $pairs] >= [llength $datas]] 1
}
foreach data $datas {
set pair [list $key $data]
error_check_bad pair_index -1 \
[lsearch -exact $pairs $pair]
}
}
}
|