test/tcl/test126.tcl

   1 # See the file LICENSE for redistribution information.
   2 #
   3 # Copyright (c) 2010, 2012 Oracle and/or its affiliates.  All rights reserved.
   4 #
   5 # $Id$
   6 #
   7 # TEST  test126
   8 # TEST  Test database bulk update for non-duplicate databases.
   9 # TEST
  10 # TEST  Put with -multiple, then with -multiple_key,
  11 # TEST  and make sure the items in database are what we put.
  12 # TEST  Later, delete some items with -multiple, then with -multiple_key,
  13 # TEST  and make sure if the correct items are deleted.
  14
  15 proc test126 {method { nentries 10000 } { tnum "126" } {callback 1}
  16     {subdb 0} {secondary 0} {sort_multiple 0} args } {
  17         source ./include.tcl
  18
  19         # For rrecno, when keys are deleted, the ones after will move forward,
  20         # and the keys change, which is not good to verify after delete.
  21         # So, we skip rrecno temporarily.
  22         if {[is_rrecno $method] } {
  23                 puts "Skipping test$tnum for $method test."
  24                 return
  25         }
  26
  27         # It is only makes sense for btree database to sort bulk buffer.
  28         if {$sort_multiple && ![is_btree $method]} {
  29                 puts "Skipping test$tnum for $method with -sort_multiple."
  30                 return
  31         }
  32
  33         # For compressed databases, we need to sort the items in
  34         # the bulk buffer before doing the bulk put/delete operations.
  35         if {[is_compressed $args] && !$sort_multiple} {
  36                 puts "Skipping test$tnum for compressed databases\
  37                     without -sort_multiple."
  38                 return
  39         }
  40
  41         set subname ""
  42         set sub_msg ""
  43
  44         # Check if we use sub database.
  45         if { $subdb } {
  46                 if {[is_queue $method] || [is_heap $method]} {
  47                         puts "Skipping test$tnum with sub database for $method."
  48                             return
  49                 }
  50                 if {[is_partitioned $args]} {
  51                         puts "Skipping test$tnum with sub database\
  52                             for partitioned $method test."
  53                             return
  54                 }
  55                 set subname "subdb"
  56                 set sub_msg "using sub databases"
  57         }
  58
  59         set sec_msg ""
  60         # Check if we use secondary database.
  61         if { $secondary } {
  62                 set sec_msg "with secondary databases"
  63         }
  64
  65         # If we are using an env, then testfile should just be the db name.
  66         # Otherwise it is the test directory and the name.
  67         set eindex [lsearch -exact $args "-env"]
  68         set txnenv 0
  69         set txn ""
  70         if { $eindex == -1 } {
  71                 set testfile $testdir/test$tnum.db
  72                 set env NULL
  73                 if {$subdb && $secondary } {
  74                         puts "Skipping test$tnum $sub_msg $sec_msg for non-env test."
  75                         return
  76                 }
  77         } else {
  78                 set testfile test$tnum.db
  79                 incr eindex
  80                 set env [lindex $args $eindex]
  81                 set txnenv [is_txnenv $env]
  82                 if { $txnenv == 1 } {
  83                         append args " -auto_commit "
  84                 }
  85                 set testdir [get_home $env]
  86         }
  87
  88         cleanup $testdir $env
  89         set sec_args $args
  90
  91         set args [convert_args $method $args]
  92         set omethod [convert_method $method]
  93
  94         set extra_op ""
  95         if {$sort_multiple} {
  96                 set extra_op "-sort_multiple"
  97         }
  98
  99         puts "Test$tnum: $method ($args)\
 100             Database bulk update $sub_msg $sec_msg."
 101
 102         set db [eval {berkdb_open_noerr -create -mode 0644} \
 103             $args $omethod $testfile $subname]
 104         error_check_good dbopen [is_valid_db $db] TRUE
 105
 106         # Open the secondary database and do association.
 107         # This is the test for [#18878].
 108         if { $secondary } {
 109                 if { $subdb } {
 110                         set sec_subname "subdb-secondary"
 111                         set sec_testfile $testfile
 112                 } else {
 113                         set sec_subname ""
 114                         if { $eindex == -1 } {
 115                                 set sec_testfile $testdir/test$tnum-secondary.db
 116                         } else {
 117                                 set sec_testfile test$tnum-secondary.db
 118                         }
 119                 }
 120                 # Open a simple dupsort btree database.
 121                 # In order to be consistent, we need to use all the passed-in
 122                 # am-unrelated flags.
 123                 set sec_args [convert_args "btree" $sec_args]
 124                 set sec_db [eval {berkdb_open_noerr -create -mode 0644} $sec_args \
 125                     -dup -dupsort -btree $sec_testfile $sec_subname]
 126                 error_check_good secdb_open [is_valid_db $sec_db] TRUE
 127                 set ret [$db associate -create [callback_n $callback] $sec_db]
 128                 error_check_good db_associate $ret 0
 129         }
 130
 131         if { $txnenv == 1 } {
 132                 set t [$env txn]
 133                 error_check_good txn [is_valid_txn $t $env] TRUE
 134                 set txn "-txn $t"
 135         }
 136
 137         set did [open $dict]
 138         set count 0
 139
 140
 141         # Do bulk put.
 142         # First, we put half the entries using put -multiple.
 143         # Then, we put the rest half using put -multiple_key.
 144
 145         puts "\tTest$tnum.a: Bulk put data using -multiple $extra_op."
 146         set key_list1 {}
 147         set data_list1 {}
 148         while { [gets $did str] != -1 && $count < $nentries / 2 } {
 149                 if { [is_record_based $method] == 1 } {
 150                         set key [expr $count + 1]
 151                 } else {
 152                         set key $str
 153                         set str [reverse $str]
 154                 }
 155                 set data [make_fixed_length $method $str]
 156                 lappend key_list1 $key
 157                 lappend data_list1 $data
 158                 incr count
 159                 if { [is_heap $method] } {
 160                     set ret [eval {$db put} $txn {$key $data}]
 161                 }
 162         }
 163
 164         if { [is_heap $method] == 0 } {
 165                 set ret [eval {$db put} $txn -multiple $extra_op \
 166                     {$key_list1 $data_list1}]
 167                 error_check_good "put(-multiple $extra_op)" $ret 0
 168         }
 169
 170         # Put again, should succeed
 171         set ret [eval {$db put} $txn -multiple $extra_op \
 172             {$key_list1 $data_list1}]
 173         error_check_good "put_again(-multiple $extra_op)" $ret 0
 174
 175         puts "\tTest$tnum.b: Bulk put data using -multiple_key $extra_op."
 176         set pair_list1 {}
 177         while { [gets $did str] != -1 && $count < $nentries } {
 178                 if { [is_record_based $method] == 1 } {
 179                         set key [expr $count + 1]
 180                 } else {
 181                         set key $str
 182                         set str [reverse $str]
 183                 }
 184                 set data [make_fixed_length $method $str]
 185                 lappend pair_list1 $key $data
 186                 incr count
 187                 if { [is_heap $method] } {
 188                         set ret [eval {$db put} $txn $key $data]
 189                 }
 190         }
 191
 192         if { [is_heap $method] == 0 } {
 193                 set ret [eval {$db put} $txn -multiple_key $extra_op \
 194                     {$pair_list1}]
 195                 error_check_good "put(-multiple_key $extra_op)" $ret 0
 196         }
 197
 198         # Put again, should succeed
 199         set ret [eval {$db put} $txn -multiple_key $extra_op \
 200             {$pair_list1}]
 201         error_check_good "put_again(-multiple_key $extra_op)" $ret 0
 202
 203         close $did
 204
 205         puts "\tTest$tnum.c: Verify the data after bulk put."
 206         set len [llength $pair_list1]
 207         for {set indx1 0; set indx2 1} {$indx2 < $len} \
 208             {incr indx1 2; incr indx2 2} {
 209                 lappend key_list1 [lindex $pair_list1 $indx1]
 210                 lappend data_list1 [lindex $pair_list1 $indx2]
 211         }
 212
 213         test126_check_prirecords $db $key_list1 $data_list1 $txn
 214
 215         if { $secondary } {
 216                 puts "\tTest$tnum.c.2: Verify the data in secondary database."
 217                 set sec_key_list {}
 218                 foreach key $key_list1 data $data_list1 {
 219                         lappend sec_key_list \
 220                             [[callback_n $callback] $key $data]
 221                 }
 222                 test126_check_secrecords $sec_db $sec_key_list \
 223                     $key_list1 $data_list1 $txn
 224         }
 225
 226         puts "\tTest$tnum.d: Bulk delete data using -multiple $extra_op."
 227         set key_list2 {}
 228         for { set i 0 } { $i < $nentries} { incr i 3 } {
 229                 lappend key_list2 [lindex $key_list1 $i]
 230         }
 231         set ret [eval {$db del} $txn -multiple $extra_op {$key_list2}]
 232         error_check_good "del(-multiple $extra_op)" $ret 0
 233
 234         # Delete again, should return DB_NOTFOUND/DB_KEYEMPTY.
 235         set ret [catch {eval {$db del} $txn -multiple $extra_op \
 236             {$key_list2}} res]
 237         error_check_good {Check DB_NOTFOUND/DB_KEYEMPTY} \
 238             [expr [is_substr $res DB_NOTFOUND] || \
 239             [is_substr $res DB_KEYEMPTY]] 1
 240
 241         puts "\tTest$tnum.e: Bulk delete data using -multiple_key $extra_op."
 242         set pair_list2 {}
 243         for { set i 1 } { $i < $nentries} { incr i 3} {
 244                 lappend pair_list2 [lindex $key_list1 $i] \
 245                     [lindex $data_list1 $i]
 246         }
 247
 248         set ret [eval {$db del} $txn -multiple_key $extra_op {$pair_list2}]
 249         error_check_good "del(-multiple_key $extra_op)" $ret 0
 250
 251         # Delete again, should return DB_NOTFOUND/DB_KEYEMPTY.
 252         set ret [catch {eval {$db del} $txn -multiple_key $extra_op \
 253             {$pair_list2}} res]
 254         error_check_good {Check DB_NOTFOUND/DB_KEYEMPTY} \
 255             [expr [is_substr $res DB_NOTFOUND] || \
 256             [is_substr $res DB_KEYEMPTY]] 1
 257
 258
 259         puts "\tTest$tnum.f: Verify the data after bulk delete."
 260
 261         # Check if the specified items are deleted
 262         set dbc [eval $db cursor $txn]
 263         error_check_good $dbc [is_valid_cursor $dbc $db] TRUE
 264         set len [llength $key_list2]
 265         for {set i 0} {$i < $len} {incr i} {
 266                 set key [lindex $key_list2 $i]
 267                 set pair [$dbc get -set $key]
 268                 error_check_good pair [llength $pair] 0
 269         }
 270
 271         set len [llength $pair_list2]
 272         for {set indx1 0; set indx2 1} {$indx2 < $len} \
 273             {incr indx1 2; incr indx2 2} {
 274                 set key [lindex $pair_list2 $indx1]
 275                 set data [lindex $pair_list2 $indx2]
 276                 set pair [$dbc get -get_both $key $data]
 277                 error_check_good pair [llength $pair] 0
 278         }
 279
 280         error_check_good $dbc.close [$dbc close] 0
 281
 282         # Remove the deleted items from the original key-data lists.
 283         # Since the primary database is non-duplicate, it is enough
 284         # for us to just compare using keys.
 285         set orig_key_list $key_list1
 286         set orig_data_list $data_list1
 287         set key_list1 {}
 288         set data_list1 {}
 289         set i 0
 290         set j 0
 291         set k 0
 292         while {$i < $nentries} {
 293                 set key1 [lindex $orig_key_list $i]
 294                 set key2 [lindex $key_list2 $j]
 295                 set key3 [lindex $pair_list2 $k]
 296                 if {$key1 == $key2} {
 297                         incr i
 298                         incr j
 299                 } elseif {$key1  == $key3} {
 300                         incr i
 301                         incr k 2
 302                 } else {
 303                         lappend key_list1 $key1
 304                         lappend data_list1 [lindex $orig_data_list $i]
 305                         incr i
 306                 }
 307         }
 308
 309         test126_check_prirecords $db $key_list1 $data_list1 $txn
 310
 311         if { $secondary } {
 312                 puts "\tTest$tnum.f.2: Verify the data in secondary database."
 313                 set sec_key_list {}
 314                 foreach key $key_list1 data $data_list1 {
 315                         lappend sec_key_list \
 316                             [[callback_n $callback] $key $data]
 317                 }
 318                 test126_check_secrecords $sec_db $sec_key_list \
 319                     $key_list1 $data_list1 $txn
 320         }
 321
 322         if { $txnenv == 1 } {
 323                 error_check_good txn_commit [$t commit] 0
 324         }
 325         error_check_good db_close [$db close] 0
 326         if { $secondary } {
 327                 error_check_good secdb_close [$sec_db close] 0
 328         }
 329 }
 330
 331 proc test126_check_prirecords {db key_list data_list txnarg} {
 332
 333         set dbc [eval $db cursor $txnarg]
 334         error_check_good $dbc [is_valid_cursor $dbc $db] TRUE
 335
 336         # Check if all the records are in key_list(key) and data_list(data).
 337         for {set pair [$dbc get -first]} {[llength $pair] > 0} \
 338             {set pair [$dbc get -next]} {
 339                 set key [lindex [lindex $pair 0] 0]
 340                 set data [lindex [lindex $pair 0] 1]
 341                 set index [lsearch -exact $key_list $key]
 342                 error_check_bad key_index $index -1
 343                 error_check_good data $data [lindex $data_list $index]
 344         }
 345
 346         # Check if all the items in the lists are in the database.
 347         set len [llength $key_list]
 348         for {set i 0} {$i < $len} {incr i} {
 349                 set pair [$dbc get -get_both [lindex $key_list $i] \
 350                     [lindex $data_list $i]]
 351                 error_check_bad pair [llength $pair] 0
 352         }
 353
 354         error_check_good $dbc.close [$dbc close] 0
 355 }
 356
 357 proc test126_check_secrecords {db sec_key_list pri_key_list data_list txnarg} {
 358
 359         set dbc [eval $db cursor $txnarg]
 360         error_check_good $dbc [is_valid_cursor $dbc $db] TRUE
 361
 362         # Check if all the records are in the lists
 363         for {set pair [$dbc pget -first]} {[llength $pair] > 0} \
 364             {set pair [$dbc pget -next]} {
 365                 set sec_key [lindex [lindex $pair 0] 0]
 366                 set pri_key [lindex [lindex $pair 0] 1]
 367                 set data [lindex [lindex $pair 0] 2]
 368                 set index [lsearch -exact $pri_key_list $pri_key]
 369                 error_check_bad key_index $index -1
 370                 error_check_good seckey $sec_key [lindex $sec_key_list $index]
 371                 error_check_good data1 $data [lindex $data_list $index]
 372         }
 373
 374         # Check if all the items in the lists are in the secondary database.
 375         set len [llength $sec_key_list]
 376         for {set i 0} {$i < $len} {incr i} {
 377                 set pair [$dbc pget -get_both [lindex $sec_key_list $i] \
 378                     [lindex $pri_key_list $i]]
 379                 error_check_bad pair [llength $pair] 0
 380                 error_check_good data2 [lindex $data_list $i] \
 381                     [lindex [lindex $pair 0] 2]
 382         }
 383
 384         error_check_good $dbc.close [$dbc close] 0
 385 }