libdb/test/tcl/test126.tcl

349 lines
10 KiB
Tcl
Raw Normal View History

2011-09-13 17:44:24 +00:00
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2010, 2011 Oracle and/or its affiliates. All rights reserved.
#
# $Id$
#
# TEST test126
# TEST Test database bulk update for non-duplicate databases.
# TEST
# TEST Put with -multiple, then with -multiple_key,
# TEST and make sure the items in database are what we put.
# TEST Later, delete some items with -multiple, then with -multiple_key,
# TEST and make sure if the correct items are deleted.
proc test126 {method { nentries 10000 } { tnum "126" } {callback 1}
{subdb 0} {secondary 0} args } {
source ./include.tcl
# For rrecno, when keys are deleted, the ones after will move forward,
# and the keys change, which is not good to verify after delete.
# So, we skip rrecno temporarily.
# Heap databases do not current support bulk operations
if {[is_rrecno $method] || [is_heap $method] } {
puts "Skipping test$tnum for $method test."
return
}
set subname ""
set sub_msg ""
# Check if we use sub database.
if { $subdb } {
if {[is_queue $method]} {
puts "Skipping test$tnum with sub database for $method."
return
}
if {[is_partitioned $args]} {
puts "Skipping test$tnum with sub database\
for partitioned $method test."
return
}
set subname "subdb"
set sub_msg "using sub databases"
}
set sec_msg ""
# Check if we use secondary database.
if { $secondary } {
set sec_msg "with secondary databases"
}
# If we are using an env, then testfile 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 testfile $testdir/test$tnum.db
set env NULL
if {$subdb && $secondary } {
puts "Skipping test$tnum $sub_msg $sec_msg for non-env test."
return
}
} else {
set testfile test$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]
}
cleanup $testdir $env
set sec_args $args
set args [convert_args $method $args]
set omethod [convert_method $method]
puts "Test$tnum: $method ($args)\
Database bulk update $sub_msg $sec_msg."
set db [eval {berkdb_open_noerr -create -mode 0644} \
$args $omethod $testfile $subname]
error_check_good dbopen [is_valid_db $db] TRUE
# Open the secondary database and do association.
# This is the test for [#18878].
if { $secondary } {
if { $subdb } {
set sec_subname "subdb-secondary"
set sec_testfile $testfile
} else {
set sec_subname ""
if { $eindex == -1 } {
set sec_testfile $testdir/test$tnum-secondary.db
} else {
set sec_testfile test$tnum-secondary.db
}
}
# Open a simple dupsort btree database.
# In order to be consistent, we need to use all the passed-in
# am-unrelated flags.
set sec_db [eval {berkdb_open_noerr -create -mode 0644} $sec_args \
-dup -dupsort -btree $sec_testfile $sec_subname]
error_check_good secdb_open [is_valid_db $sec_db] TRUE
set ret [$db associate -create [callback_n $callback] $sec_db]
error_check_good db_associate $ret 0
}
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set did [open $dict]
set count 0
# 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."
set key_list1 {}
set data_list1 {}
while { [gets $did str] != -1 && $count < $nentries / 2 } {
if { [is_record_based $method] == 1 } {
set key [expr $count + 1]
} else {
set key $str
set str [reverse $str]
}
lappend key_list1 $key
lappend data_list1 [make_fixed_length $method $str]
incr count
}
set ret [eval {$db put} $txn -multiple {$key_list1 $data_list1}]
error_check_good {put(-multiple)} $ret 0
# Put again, should succeed
set ret [eval {$db put} $txn -multiple {$key_list1 $data_list1}]
error_check_good {put_again(-multiple)} $ret 0
puts "\tTest$tnum.b: Bulk put data using -multiple_key."
set pair_list1 {}
while { [gets $did str] != -1 && $count < $nentries } {
if { [is_record_based $method] == 1 } {
set key [expr $count + 1]
} else {
set key $str
set str [reverse $str]
}
lappend pair_list1 $key [make_fixed_length $method $str]
incr count
}
set ret [eval {$db put} $txn -multiple_key {$pair_list1}]
error_check_good {put(-multiple_key)} $ret 0
# Put again, should succeed
set ret [eval {$db put} $txn -multiple_key {$pair_list1}]
error_check_good {put_again(-multiple_key)} $ret 0
close $did
puts "\tTest$tnum.c: Verify the data after bulk put."
set len [llength $pair_list1]
for {set indx1 0; set indx2 1} {$indx2 < $len} \
{incr indx1 2; incr indx2 2} {
lappend key_list1 [lindex $pair_list1 $indx1]
lappend data_list1 [lindex $pair_list1 $indx2]
}
test126_check_prirecords $db $key_list1 $data_list1 $txn
if { $secondary } {
puts "\tTest$tnum.c.2: Verify the data in secondary database."
set sec_key_list {}
foreach key $key_list1 data $data_list1 {
lappend sec_key_list \
[[callback_n $callback] $key $data]
}
test126_check_secrecords $sec_db $sec_key_list \
$key_list1 $data_list1 $txn
}
puts "\tTest$tnum.d: Bulk delete data using -multiple."
set key_list2 {}
for { set i 0 } { $i < $nentries} { incr i 3 } {
lappend key_list2 [lindex $key_list1 $i]
}
set ret [eval {$db del} $txn -multiple {$key_list2}]
error_check_good {del(-multiple)} $ret 0
# Delete again, should return DB_NOTFOUND/DB_KEYEMPTY.
set ret [catch {eval {$db del} $txn -multiple {$key_list2}} res]
error_check_good {Check DB_NOTFOUND/DB_KEYEMPTY} \
[expr [is_substr $res DB_NOTFOUND] || \
[is_substr $res DB_KEYEMPTY]] 1
puts "\tTest$tnum.e: Bulk delete data using -multiple_key."
set pair_list2 {}
for { set i 1 } { $i < $nentries} { incr i 3} {
lappend pair_list2 [lindex $key_list1 $i] \
[lindex $data_list1 $i]
}
set ret [eval {$db del} $txn -multiple_key {$pair_list2}]
error_check_good {del(-multiple_key)} $ret 0
# Delete again, should return DB_NOTFOUND/DB_KEYEMPTY.
set ret [catch {eval {$db del} $txn -multiple_key {$pair_list2}} res]
error_check_good {Check DB_NOTFOUND/DB_KEYEMPTY} \
[expr [is_substr $res DB_NOTFOUND] || \
[is_substr $res DB_KEYEMPTY]] 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
}
error_check_good $dbc.close [$dbc close] 0
# Remove the deleted items from the original key-data lists.
# Since the primary database is non-duplicate, it is enough
# for us to just compare using keys.
set orig_key_list $key_list1
set orig_data_list $data_list1
set key_list1 {}
set data_list1 {}
set i 0
set j 0
set k 0
while {$i < $nentries} {
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
} elseif {$key1 == $key3} {
incr i
incr k 2
} else {
lappend key_list1 $key1
lappend data_list1 [lindex $orig_data_list $i]
incr i
}
}
test126_check_prirecords $db $key_list1 $data_list1 $txn
if { $secondary } {
puts "\tTest$tnum.f.2: Verify the data in secondary database."
set sec_key_list {}
foreach key $key_list1 data $data_list1 {
lappend sec_key_list \
[[callback_n $callback] $key $data]
}
test126_check_secrecords $sec_db $sec_key_list \
$key_list1 $data_list1 $txn
}
if { $txnenv == 1 } {
error_check_good txn_commit [$t commit] 0
}
error_check_good db_close [$db close] 0
if { $secondary } {
error_check_good secdb_close [$sec_db close] 0
}
}
proc test126_check_prirecords {db key_list data_list txnarg} {
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 data_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_good data $data [lindex $data_list $index]
}
# 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 pair [$dbc get -get_both [lindex $key_list $i] \
[lindex $data_list $i]]
error_check_bad pair [llength $pair] 0
}
error_check_good $dbc.close [$dbc close] 0
}
proc test126_check_secrecords {db sec_key_list pri_key_list data_list txnarg} {
set dbc [eval $db cursor $txnarg]
error_check_good $dbc [is_valid_cursor $dbc $db] TRUE
# Check if all the records are in the lists
for {set pair [$dbc pget -first]} {[llength $pair] > 0} \
{set pair [$dbc pget -next]} {
set sec_key [lindex [lindex $pair 0] 0]
set pri_key [lindex [lindex $pair 0] 1]
set data [lindex [lindex $pair 0] 2]
set index [lsearch -exact $pri_key_list $pri_key]
error_check_bad key_index $index -1
error_check_good seckey $sec_key [lindex $sec_key_list $index]
error_check_good data1 $data [lindex $data_list $index]
}
# Check if all the items in the lists are in the secondary database.
set len [llength $sec_key_list]
for {set i 0} {$i < $len} {incr i} {
set pair [$dbc pget -get_both [lindex $sec_key_list $i] \
[lindex $pri_key_list $i]]
error_check_bad pair [llength $pair] 0
error_check_good data2 [lindex $data_list $i] \
[lindex [lindex $pair 0] 2]
}
error_check_good $dbc.close [$dbc close] 0
}