# See the file LICENSE for redistribution information. # # Copyright (c) 2010, 2011 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} args } { source ./include.tcl global alphabet if {[is_btree $method] != 1 && [is_hash $method] != 1} { puts "Skipping test$tnum for $method." 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 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 } 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 i 0 foreach ex_args [list "-dup -dupsort" "-dup"] { set dboargs [concat $args $ex_args] set fname $testfile set dbname $subname puts "Test$tnum: $method ($dboargs)\ Database bulk update $save_msg." if {$subdb} { set dbname $subname.$i } else { set fname $testfile.$i } 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 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." 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 {$key_list1 $data_list1}] error_check_good {put(-multiple)} $ret 0 # Put again without -overwritedup, should return DB_KEYEXIST. set ret [catch {eval {$db put} \ $txn -multiple {$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)} $ret 0 } # Put again with -overwritedup, should succeed set ret [eval {$db put} \ $txn -multiple -overwritedup {$key_list1 $data_list1}] error_check_good {put_again(-multiple -overwritedup)} $ret 0 puts "\tTest$tnum.b: Bulk put data using -multiple_key." 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 {$pair_list1}] error_check_good {put(-multiple_key)} $ret 0 # Put again without -overwritedup, should return DB_KEYEXIST. set ret [catch { eval {$db put} $txn -multiple_key {$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)} $ret 0 } # Put again with -overwritedup, should succeed set ret [eval \ {$db put} $txn -multiple_key -overwritedup {$pair_list1}] error_check_good \ {put_again(-multiple_key -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." set key_list2 {} for { set i 1 } { $i <= $nentries} { incr i 2 } { lappend key_list2 $i } set ret [eval {$db del} $txn -multiple {$key_list2}] error_check_good {del(-multiple)} $ret 0 # Delete again, should return DB_NOTFOUND. set ret [catch {eval {$db del} $txn -multiple {$key_list2}} res] error_check_good {Check DB_NOTFOUND} [is_substr $res DB_NOTFOUND] 1 puts "\tTest$tnum.e: Bulk delete using -multiple_key." 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 {$pair_list2}] error_check_good {del(-multiple_key)} $ret 0 # Delete again, should return DB_NOTFOUND. set ret [catch {eval {$db del} $txn -multiple_key {$pair_list2}} res] if {$sorted} { error_check_good {Check DB_NOTFOUND} [is_substr $res DB_NOTFOUND] 1 } else { error_check_good "del(-multiple_key) 2 round" $ret 0 set ret [catch {eval {$db del} $txn -multiple_key {$pair_list2}} res] error_check_good "del(-multiple_key) 3 round" $ret 0 set ret [catch {eval {$db del} $txn -multiple_key {$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] } } }