1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999-2009 Oracle. All rights reserved. 4# 5# $Id$ 6# 7# TEST test046 8# TEST Overwrite test of small/big key/data with cursor checks. 9proc test046 { method args } { 10 global alphabet 11 global errorInfo 12 global errorCode 13 source ./include.tcl 14 15 set args [convert_args $method $args] 16 set omethod [convert_method $method] 17 18 puts "\tTest046: Overwrite test with cursor and small/big key/data." 19 puts "\tTest046:\t$method $args" 20 21 if { [is_rrecno $method] == 1} { 22 puts "\tTest046: skipping for method $method." 23 return 24 } 25 26 set key "key" 27 set data "data" 28 set txn "" 29 set flags "" 30 31 if { [is_record_based $method] == 1} { 32 set key "" 33 } 34 35 puts "\tTest046: Create $method database." 36 set txnenv 0 37 set eindex [lsearch -exact $args "-env"] 38 # 39 # If we are using an env, then testfile should just be the db name. 40 # Otherwise it is the test directory and the name. 41 if { $eindex == -1 } { 42 set testfile $testdir/test046 43 set env NULL 44 } else { 45 set testfile test046 46 incr eindex 47 set env [lindex $args $eindex] 48 set txnenv [is_txnenv $env] 49 if { $txnenv == 1 } { 50 append args " -auto_commit " 51 } 52 set testdir [get_home $env] 53 } 54 set t1 $testdir/t1 55 cleanup $testdir $env 56 57 set oflags "-create -mode 0644 $args $omethod" 58 set db [eval {berkdb_open} $oflags $testfile.a.db] 59 error_check_good dbopen [is_valid_db $db] TRUE 60 61 # keep nkeys even 62 set nkeys 20 63 64 # Fill page w/ small key/data pairs 65 puts "\tTest046: Fill page with $nkeys small key/data pairs." 66 for { set i 1 } { $i <= $nkeys } { incr i } { 67 if { $txnenv == 1 } { 68 set t [$env txn] 69 error_check_good txn [is_valid_txn $t $env] TRUE 70 set txn "-txn $t" 71 } 72 if { [is_record_based $method] == 1} { 73 set ret [eval {$db put} $txn {$i $data$i}] 74 } elseif { $i < 10 } { 75 set ret [eval {$db put} $txn [set key]00$i \ 76 [set data]00$i] 77 } elseif { $i < 100 } { 78 set ret [eval {$db put} $txn [set key]0$i \ 79 [set data]0$i] 80 } else { 81 set ret [eval {$db put} $txn {$key$i $data$i}] 82 } 83 error_check_good dbput $ret 0 84 if { $txnenv == 1 } { 85 error_check_good txn [$t commit] 0 86 } 87 } 88 89 # open curs to db 90 if { $txnenv == 1 } { 91 set t [$env txn] 92 error_check_good txn [is_valid_txn $t $env] TRUE 93 set txn "-txn $t" 94 } 95 set dbc [eval {$db cursor} $txn] 96 error_check_good db_cursor [is_substr $dbc $db] 1 97 98 # get db order of keys 99 for {set i 1; set ret [$dbc get -first]} { [llength $ret] != 0} { \ 100 set ret [$dbc get -next]} { 101 set key_set($i) [lindex [lindex $ret 0] 0] 102 set data_set($i) [lindex [lindex $ret 0] 1] 103 incr i 104 } 105 106 puts "\tTest046.a: Deletes by key." 107 puts "\t\tTest046.a.1: Get data with SET, then delete before cursor." 108 # get key in middle of page, call this the nth set curr to it 109 set i [expr $nkeys/2] 110 set ret [$dbc get -set $key_set($i)] 111 error_check_bad dbc_get:set [llength $ret] 0 112 set curr $ret 113 114 # delete before cursor(n-1), make sure it is gone 115 set i [expr $i - 1] 116 error_check_good db_del [eval {$db del} $txn {$key_set($i)}] 0 117 118 # use set_range to get first key starting at n-1, should 119 # give us nth--but only works for btree 120 if { [is_btree $method] == 1 } { 121 set ret [$dbc get -set_range $key_set($i)] 122 } else { 123 if { [is_record_based $method] == 1 } { 124 set ret [$dbc get -set $key_set($i)] 125 error_check_good \ 126 dbc_get:deleted(recno) [llength [lindex $ret 1]] 0 127 #error_check_good \ 128 # catch:get [catch {$dbc get -set $key_set($i)} ret] 1 129 #error_check_good \ 130 # dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1 131 } else { 132 set ret [$dbc get -set $key_set($i)] 133 error_check_good dbc_get:deleted [llength $ret] 0 134 } 135 set ret [$dbc get -set $key_set([incr i])] 136 incr i -1 137 } 138 error_check_bad dbc_get:set(R)(post-delete) [llength $ret] 0 139 error_check_good dbc_get(match):set $ret $curr 140 141 puts "\t\tTest046.a.2: Delete cursor item by key." 142 # nth key, which cursor should be on now 143 set i [incr i] 144 set ret [eval {$db del} $txn {$key_set($i)}] 145 error_check_good db_del $ret 0 146 147 # this should return n+1 key/data, curr has nth key/data 148 if { [string compare $omethod "-btree"] == 0 } { 149 set ret [$dbc get -set_range $key_set($i)] 150 } else { 151 if { [is_record_based $method] == 1 } { 152 set ret [$dbc get -set $key_set($i)] 153 error_check_good \ 154 dbc_get:deleted(recno) [llength [lindex $ret 1]] 0 155 #error_check_good \ 156 # catch:get [catch {$dbc get -set $key_set($i)} ret] 1 157 #error_check_good \ 158 # dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1 159 } else { 160 set ret [$dbc get -set $key_set($i)] 161 error_check_good dbc_get:deleted [llength $ret] 0 162 } 163 set ret [$dbc get -set $key_set([expr $i+1])] 164 } 165 error_check_bad dbc_get(post-delete):set_range [llength $ret] 0 166 error_check_bad dbc_get(no-match):set_range $ret $curr 167 168 puts "\t\tTest046.a.3: Delete item after cursor." 169 # we'll delete n+2, since we have deleted n-1 and n 170 # i still equal to nth, cursor on n+1 171 set i [incr i] 172 set ret [$dbc get -set $key_set($i)] 173 error_check_bad dbc_get:set [llength $ret] 0 174 set curr [$dbc get -next] 175 error_check_bad dbc_get:next [llength $curr] 0 176 set ret [$dbc get -prev] 177 error_check_bad dbc_get:prev [llength $curr] 0 178 # delete *after* cursor pos. 179 error_check_good db:del [eval {$db del} $txn {$key_set([incr i])}] 0 180 181 # make sure item is gone, try to get it 182 if { [string compare $omethod "-btree"] == 0} { 183 set ret [$dbc get -set_range $key_set($i)] 184 } else { 185 if { [is_record_based $method] == 1 } { 186 set ret [$dbc get -set $key_set($i)] 187 error_check_good \ 188 dbc_get:deleted(recno) [llength [lindex $ret 1]] 0 189 #error_check_good \ 190 # catch:get [catch {$dbc get -set $key_set($i)} ret] 1 191 #error_check_good \ 192 # dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1 193 } else { 194 set ret [$dbc get -set $key_set($i)] 195 error_check_good dbc_get:deleted [llength $ret] 0 196 } 197 set ret [$dbc get -set $key_set([expr $i +1])] 198 } 199 error_check_bad dbc_get:set(_range) [llength $ret] 0 200 error_check_bad dbc_get:set(_range) $ret $curr 201 error_check_good dbc_get:set [lindex [lindex $ret 0] 0] \ 202 $key_set([expr $i+1]) 203 204 puts "\tTest046.b: Deletes by cursor." 205 puts "\t\tTest046.b.1: Delete, do DB_NEXT." 206 error_check_good dbc:del [$dbc del] 0 207 set ret [$dbc get -next] 208 error_check_bad dbc_get:next [llength $ret] 0 209 set i [expr $i+2] 210 # i = n+4 211 error_check_good dbc_get:next(match) \ 212 [lindex [lindex $ret 0] 0] $key_set($i) 213 214 puts "\t\tTest046.b.2: Delete, do DB_PREV." 215 error_check_good dbc:del [$dbc del] 0 216 set ret [$dbc get -prev] 217 error_check_bad dbc_get:prev [llength $ret] 0 218 set i [expr $i-3] 219 # i = n+1 (deleted all in between) 220 error_check_good dbc_get:prev(match) \ 221 [lindex [lindex $ret 0] 0] $key_set($i) 222 223 puts "\t\tTest046.b.3: Delete, do DB_CURRENT." 224 error_check_good dbc:del [$dbc del] 0 225 # we just deleted, so current item should be KEYEMPTY, throws err 226 set ret [$dbc get -current] 227 error_check_good dbc_get:curr:deleted [llength [lindex $ret 1]] 0 228 #error_check_good catch:get:current [catch {$dbc get -current} ret] 1 229 #error_check_good dbc_get:curr:deleted [is_substr $ret "DB_KEYEMPTY"] 1 230 231 puts "\tTest046.c: Inserts (before/after), by key then cursor." 232 puts "\t\tTest046.c.1: Insert by key before the cursor." 233 # i is at curs pos, i=n+1, we want to go BEFORE 234 set i [incr i -1] 235 set ret [eval {$db put} $txn {$key_set($i) $data_set($i)}] 236 error_check_good db_put:before $ret 0 237 238 puts "\t\tTest046.c.2: Insert by key after the cursor." 239 set i [incr i +2] 240 set ret [eval {$db put} $txn {$key_set($i) $data_set($i)}] 241 error_check_good db_put:after $ret 0 242 243 puts "\t\tTest046.c.3: Insert by curs with deleted curs (should fail)." 244 # cursor is on n+1, we'll change i to match 245 set i [incr i -1] 246 247 error_check_good dbc:close [$dbc close] 0 248 if { $txnenv == 1 } { 249 error_check_good txn [$t commit] 0 250 } 251 error_check_good db:close [$db close] 0 252 if { [is_record_based $method] == 1} { 253 puts "\t\tSkipping the rest of test for method $method." 254 puts "\tTest046 ($method) complete." 255 return 256 } else { 257 # Reopen without printing __db_errs. 258 set db [eval {berkdb_open_noerr} $oflags $testfile.a.db] 259 error_check_good dbopen [is_valid_db $db] TRUE 260 if { $txnenv == 1 } { 261 set t [$env txn] 262 error_check_good txn [is_valid_txn $t $env] TRUE 263 set txn "-txn $t" 264 } 265 set dbc [eval {$db cursor} $txn] 266 error_check_good cursor [is_valid_cursor $dbc $db] TRUE 267 268 # should fail with EINVAL (deleted cursor) 269 set errorCode NONE 270 error_check_good catch:put:before 1 \ 271 [catch {$dbc put -before $data_set($i)} ret] 272 error_check_good dbc_put:deleted:before \ 273 [is_substr $errorCode "EINVAL"] 1 274 275 # should fail with EINVAL 276 set errorCode NONE 277 error_check_good catch:put:after 1 \ 278 [catch {$dbc put -after $data_set($i)} ret] 279 error_check_good dbc_put:deleted:after \ 280 [is_substr $errorCode "EINVAL"] 1 281 282 puts "\t\tTest046.c.4:\ 283 Insert by cursor before/after existent cursor." 284 # can't use before after w/o dup except renumber in recno 285 # first, restore an item so they don't fail 286 #set ret [eval {$db put} $txn {$key_set($i) $data_set($i)}] 287 #error_check_good db_put $ret 0 288 289 #set ret [$dbc get -set $key_set($i)] 290 #error_check_bad dbc_get:set [llength $ret] 0 291 #set i [incr i -2] 292 # i = n - 1 293 #set ret [$dbc get -prev] 294 #set ret [$dbc put -before $key_set($i) $data_set($i)] 295 #error_check_good dbc_put:before $ret 0 296 # cursor pos is adjusted to match prev, recently inserted 297 #incr i 298 # i = n 299 #set ret [$dbc put -after $key_set($i) $data_set($i)] 300 #error_check_good dbc_put:after $ret 0 301 } 302 303 # For the next part of the test, we need a db with no dups to test 304 # overwrites 305 puts "\tTest046.d.0: Cleanup, close db, open new db with no dups." 306 error_check_good dbc:close [$dbc close] 0 307 if { $txnenv == 1 } { 308 error_check_good txn [$t commit] 0 309 } 310 error_check_good db:close [$db close] 0 311 312 set db [eval {berkdb_open} $oflags $testfile.d.db] 313 error_check_good dbopen [is_valid_db $db] TRUE 314 # Fill page w/ small key/data pairs 315 puts "\tTest046.d.0: Fill page with $nkeys small key/data pairs." 316 for { set i 1 } { $i < $nkeys } { incr i } { 317 if { $txnenv == 1 } { 318 set t [$env txn] 319 error_check_good txn [is_valid_txn $t $env] TRUE 320 set txn "-txn $t" 321 } 322 set ret [eval {$db put} $txn {$key$i $data$i}] 323 error_check_good dbput $ret 0 324 if { $txnenv == 1 } { 325 error_check_good txn [$t commit] 0 326 } 327 } 328 329 if { $txnenv == 1 } { 330 set t [$env txn] 331 error_check_good txn [is_valid_txn $t $env] TRUE 332 set txn "-txn $t" 333 } 334 set dbc [eval {$db cursor} $txn] 335 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 336 set nkeys 20 337 338 # Prepare cursor on item 339 set ret [$dbc get -first] 340 error_check_bad dbc_get:first [llength $ret] 0 341 342 # Prepare unique big/small values for an initial 343 # and an overwrite set of key/data 344 foreach ptype {init over} { 345 foreach size {big small} { 346 if { [string compare $size big] == 0 } { 347 set key_$ptype$size \ 348 KEY_$size[repeat alphabet 250] 349 set data_$ptype$size \ 350 DATA_$size[repeat alphabet 250] 351 } else { 352 set key_$ptype$size \ 353 KEY_$size[repeat alphabet 10] 354 set data_$ptype$size \ 355 DATA_$size[repeat alphabet 10] 356 } 357 } 358 } 359 360 set i 0 361 # Do all overwrites for key and cursor 362 foreach type {key_over curs_over} { 363 # Overwrite (i=initial) four different kinds of pairs 364 incr i 365 puts "\tTest046.d: Overwrites $type." 366 foreach i_pair {\ 367 {small small} {big small} {small big} {big big} } { 368 # Overwrite (w=write) with four different kinds of data 369 foreach w_pair {\ 370 {small small} {big small} {small big} {big big} } { 371 372 # we can only overwrite if key size matches 373 if { [string compare [lindex \ 374 $i_pair 0] [lindex $w_pair 0]] != 0} { 375 continue 376 } 377 378 # first write the initial key/data 379 set ret [$dbc put -keyfirst \ 380 key_init[lindex $i_pair 0] \ 381 data_init[lindex $i_pair 1]] 382 error_check_good \ 383 dbc_put:curr:init:$i_pair $ret 0 384 set ret [$dbc get -current] 385 error_check_bad dbc_get:curr [llength $ret] 0 386 error_check_good dbc_get:curr:data \ 387 [lindex [lindex $ret 0] 1] \ 388 data_init[lindex $i_pair 1] 389 390 # Now, try to overwrite: dups not supported in 391 # this db 392 if { [string compare $type key_over] == 0 } { 393 puts "\t\tTest046.d.$i: Key\ 394 Overwrite:($i_pair) by ($w_pair)." 395 set ret [eval {$db put} $txn \ 396 $"key_init[lindex $i_pair 0]" \ 397 $"data_over[lindex $w_pair 1]"] 398 error_check_good \ 399 dbput:over:i($i_pair):o($w_pair) $ret 0 400 # check value 401 set ret [eval {$db get} $txn \ 402 $"key_init[lindex $i_pair 0]"] 403 error_check_bad \ 404 db:get:check [llength $ret] 0 405 error_check_good db:get:compare_data \ 406 [lindex [lindex $ret 0] 1] \ 407 $"data_over[lindex $w_pair 1]" 408 } else { 409 # This is a cursor overwrite 410 puts \ 411 "\t\tTest046.d.$i:Curs Overwrite:($i_pair) by ($w_pair)." 412 set ret [$dbc put -current \ 413 $"data_over[lindex $w_pair 1]"] 414 error_check_good \ 415 dbcput:over:i($i_pair):o($w_pair) $ret 0 416 # check value 417 set ret [$dbc get -current] 418 error_check_bad \ 419 dbc_get:curr [llength $ret] 0 420 error_check_good dbc_get:curr:data \ 421 [lindex [lindex $ret 0] 1] \ 422 $"data_over[lindex $w_pair 1]" 423 } 424 } ;# foreach write pair 425 } ;# foreach initial pair 426 } ;# foreach type big/small 427 428 puts "\tTest046.d.3: Cleanup for next part of test." 429 error_check_good dbc_close [$dbc close] 0 430 if { $txnenv == 1 } { 431 error_check_good txn [$t commit] 0 432 } 433 error_check_good db_close [$db close] 0 434 435 if { [is_rbtree $method] == 1} { 436 puts "\tSkipping the rest of Test046 for method $method." 437 puts "\tTest046 complete." 438 return 439 } 440 441 puts "\tTest046.e.1: Open db with sorted dups." 442 set db [eval {berkdb_open_noerr} $oflags -dup -dupsort $testfile.e.db] 443 error_check_good dbopen [is_valid_db $db] TRUE 444 445 # keep nkeys even 446 set nkeys 20 447 set ndups 20 448 449 # Fill page w/ small key/data pairs 450 puts "\tTest046.e.2:\ 451 Put $nkeys small key/data pairs and $ndups sorted dups." 452 for { set i 0 } { $i < $nkeys } { incr i } { 453 if { $txnenv == 1 } { 454 set t [$env txn] 455 error_check_good txn [is_valid_txn $t $env] TRUE 456 set txn "-txn $t" 457 } 458 if { $i < 10 } { 459 set ret [eval {$db put} $txn [set key]0$i [set data]0$i] 460 } else { 461 set ret [eval {$db put} $txn {$key$i $data$i}] 462 } 463 error_check_good dbput $ret 0 464 if { $txnenv == 1 } { 465 error_check_good txn [$t commit] 0 466 } 467 } 468 469 if { $txnenv == 1 } { 470 set t [$env txn] 471 error_check_good txn [is_valid_txn $t $env] TRUE 472 set txn "-txn $t" 473 } 474 # open curs to db 475 set dbc [eval {$db cursor} $txn] 476 error_check_good db_cursor [is_substr $dbc $db] 1 477 478 # get db order of keys 479 for {set i 0; set ret [$dbc get -first]} { [llength $ret] != 0} { \ 480 set ret [$dbc get -next]} { 481 set key_set($i) [lindex [lindex $ret 0] 0] 482 set data_set($i) [lindex [lindex $ret 0] 1] 483 incr i 484 } 485 486 # put 20 sorted duplicates on key in middle of page 487 set i [expr $nkeys/2] 488 set ret [$dbc get -set $key_set($i)] 489 error_check_bad dbc_get:set [llength $ret] 0 490 491 set keym $key_set($i) 492 493 for { set i 0 } { $i < $ndups } { incr i } { 494 if { $i < 10 } { 495 set ret [eval {$db put} $txn {$keym DUPLICATE_0$i}] 496 } else { 497 set ret [eval {$db put} $txn {$keym DUPLICATE_$i}] 498 } 499 error_check_good db_put:DUP($i) $ret 0 500 } 501 502 puts "\tTest046.e.3: Check duplicate duplicates" 503 set ret [eval {$db put} $txn {$keym DUPLICATE_00}] 504 error_check_good dbput:dupdup [is_substr $ret "DB_KEYEXIST"] 1 505 506 # get dup ordering 507 for {set i 0; set ret [$dbc get -set $keym]} { [llength $ret] != 0} {\ 508 set ret [$dbc get -nextdup] } { 509 set dup_set($i) [lindex [lindex $ret 0] 1] 510 incr i 511 } 512 513 # put cursor on item in middle of dups 514 set i [expr $ndups/2] 515 set ret [$dbc get -get_both $keym $dup_set($i)] 516 error_check_bad dbc_get:get_both [llength $ret] 0 517 518 puts "\tTest046.f: Deletes by cursor." 519 puts "\t\tTest046.f.1: Delete by cursor, do a DB_NEXT, check cursor." 520 set ret [$dbc get -current] 521 error_check_bad dbc_get:current [llength $ret] 0 522 error_check_good dbc:del [$dbc del] 0 523 set ret [$dbc get -next] 524 error_check_bad dbc_get:next [llength $ret] 0 525 error_check_good \ 526 dbc_get:nextdup [lindex [lindex $ret 0] 1] $dup_set([incr i]) 527 528 puts "\t\tTest046.f.2: Delete by cursor, do DB_PREV, check cursor." 529 error_check_good dbc:del [$dbc del] 0 530 set ret [$dbc get -prev] 531 error_check_bad dbc_get:prev [llength $ret] 0 532 set i [incr i -2] 533 error_check_good dbc_get:prev [lindex [lindex $ret 0] 1] $dup_set($i) 534 535 puts "\t\tTest046.f.3: Delete by cursor, do DB_CURRENT, check cursor." 536 error_check_good dbc:del [$dbc del] 0 537 set ret [$dbc get -current] 538 error_check_good dbc_get:current:deleted [llength [lindex $ret 1]] 0 539 #error_check_good catch:dbc_get:curr [catch {$dbc get -current} ret] 1 540 #error_check_good \ 541 # dbc_get:current:deleted [is_substr $ret "DB_KEYEMPTY"] 1 542 error_check_good dbc_close [$dbc close] 0 543 if { $txnenv == 1 } { 544 error_check_good txn [$t commit] 0 545 } 546 547 if { $txnenv == 1 } { 548 set t [$env txn] 549 error_check_good txn [is_valid_txn $t $env] TRUE 550 set txn "-txn $t" 551 } 552 # restore deleted keys 553 error_check_good db_put:1 [eval {$db put} $txn {$keym $dup_set($i)}] 0 554 error_check_good db_put:2 [eval {$db put} $txn \ 555 {$keym $dup_set([incr i])}] 0 556 error_check_good db_put:3 [eval {$db put} $txn \ 557 {$keym $dup_set([incr i])}] 0 558 if { $txnenv == 1 } { 559 error_check_good txn [$t commit] 0 560 } 561 562 # tested above 563 564 # Reopen database without __db_err, reset cursor 565 error_check_good dbclose [$db close] 0 566 set db [eval {berkdb_open_noerr} $oflags -dup -dupsort $testfile.e.db] 567 error_check_good dbopen [is_valid_db $db] TRUE 568 if { $txnenv == 1 } { 569 set t [$env txn] 570 error_check_good txn [is_valid_txn $t $env] TRUE 571 set txn "-txn $t" 572 } 573 set dbc [eval {$db cursor} $txn] 574 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 575 576 set ret [$dbc get -set $keym] 577 error_check_bad dbc_get:set [llength $ret] 0 578 set ret2 [$dbc get -current] 579 error_check_bad dbc_get:current [llength $ret2] 0 580 # match 581 error_check_good dbc_get:current/set(match) $ret $ret2 582 # right one? 583 error_check_good \ 584 dbc_get:curr/set(matchdup) [lindex [lindex $ret 0] 1] $dup_set(0) 585 586 # cursor is on first dup 587 set ret [$dbc get -next] 588 error_check_bad dbc_get:next [llength $ret] 0 589 # now on second dup 590 error_check_good dbc_get:next [lindex [lindex $ret 0] 1] $dup_set(1) 591 # check cursor 592 set ret [$dbc get -current] 593 error_check_bad dbc_get:curr [llength $ret] 0 594 error_check_good \ 595 dbcget:curr(compare) [lindex [lindex $ret 0] 1] $dup_set(1) 596 597 puts "\tTest046.g: Inserts." 598 puts "\t\tTest046.g.1: Insert by key before cursor." 599 set i 0 600 601 # use "spam" to prevent a duplicate duplicate. 602 set ret [eval {$db put} $txn {$keym $dup_set($i)spam}] 603 error_check_good db_put:before $ret 0 604 # make sure cursor was maintained 605 set ret [$dbc get -current] 606 error_check_bad dbc_get:curr [llength $ret] 0 607 error_check_good \ 608 dbc_get:current(post-put) [lindex [lindex $ret 0] 1] $dup_set(1) 609 610 puts "\t\tTest046.g.2: Insert by key after cursor." 611 set i [expr $i + 2] 612 # use "eggs" to prevent a duplicate duplicate 613 set ret [eval {$db put} $txn {$keym $dup_set($i)eggs}] 614 error_check_good db_put:after $ret 0 615 # make sure cursor was maintained 616 set ret [$dbc get -current] 617 error_check_bad dbc_get:curr [llength $ret] 0 618 error_check_good \ 619 dbc_get:curr(post-put,after) [lindex [lindex $ret 0] 1] $dup_set(1) 620 621 puts "\t\tTest046.g.3: Insert by curs before/after curs (should fail)." 622 # should return EINVAL (dupsort specified) 623 error_check_good dbc_put:before:catch \ 624 [catch {$dbc put -before $dup_set([expr $i -1])} ret] 1 625 error_check_good \ 626 dbc_put:before:deleted [is_substr $errorCode "EINVAL"] 1 627 error_check_good dbc_put:after:catch \ 628 [catch {$dbc put -after $dup_set([expr $i +2])} ret] 1 629 error_check_good \ 630 dbc_put:after:deleted [is_substr $errorCode "EINVAL"] 1 631 632 puts "\tTest046.h: Cursor overwrites." 633 puts "\t\tTest046.h.1: Test that dupsort disallows current overwrite." 634 set ret [$dbc get -set $keym] 635 error_check_bad dbc_get:set [llength $ret] 0 636 error_check_good \ 637 catch:dbc_put:curr [catch {$dbc put -current DATA_OVERWRITE} ret] 1 638 error_check_good dbc_put:curr:dupsort [is_substr $errorCode EINVAL] 1 639 640 puts "\t\tTest046.h.2: New db (no dupsort)." 641 error_check_good dbc_close [$dbc close] 0 642 if { $txnenv == 1 } { 643 error_check_good txn [$t commit] 0 644 } 645 error_check_good db_close [$db close] 0 646 647 # Skip the rest of the test for compressed btree, now that 648 # we're no longer running with -dupsort. 649 if { [is_compressed $args] == 1 } { 650 puts "Skipping remainder of test046\ 651 for btree with compression." 652 return 653 } 654 655 set db [eval {berkdb_open} \ 656 $oflags -dup $testfile.h.db] 657 error_check_good db_open [is_valid_db $db] TRUE 658 if { $txnenv == 1 } { 659 set t [$env txn] 660 error_check_good txn [is_valid_txn $t $env] TRUE 661 set txn "-txn $t" 662 } 663 set dbc [eval {$db cursor} $txn] 664 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 665 666 for {set i 0} {$i < $nkeys} {incr i} { 667 if { $i < 10 } { 668 set ret [eval {$db put} $txn {key0$i datum0$i}] 669 error_check_good db_put $ret 0 670 } else { 671 set ret [eval {$db put} $txn {key$i datum$i}] 672 error_check_good db_put $ret 0 673 } 674 if { $i == 0 } { 675 for {set j 0} {$j < $ndups} {incr j} { 676 if { $i < 10 } { 677 set keyput key0$i 678 } else { 679 set keyput key$i 680 } 681 if { $j < 10 } { 682 set ret [eval {$db put} $txn \ 683 {$keyput DUP_datum0$j}] 684 } else { 685 set ret [eval {$db put} $txn \ 686 {$keyput DUP_datum$j}] 687 } 688 error_check_good dbput:dup $ret 0 689 } 690 } 691 } 692 693 for {set i 0; set ret [$dbc get -first]} { [llength $ret] != 0} { \ 694 set ret [$dbc get -next]} { 695 set key_set($i) [lindex [lindex $ret 0] 0] 696 set data_set($i) [lindex [lindex $ret 0] 1] 697 incr i 698 } 699 700 for {set i 0; set ret [$dbc get -set key00]} {\ 701 [llength $ret] != 0} {set ret [$dbc get -nextdup]} { 702 set dup_set($i) [lindex [lindex $ret 0] 1] 703 incr i 704 } 705 set i 0 706 set keym key0$i 707 set ret [$dbc get -set $keym] 708 error_check_bad dbc_get:set [llength $ret] 0 709 error_check_good \ 710 dbc_get:set(match) [lindex [lindex $ret 0] 1] $dup_set($i) 711 712 set ret [$dbc get -nextdup] 713 error_check_bad dbc_get:nextdup [llength $ret] 0 714 error_check_good dbc_get:nextdup(match) \ 715 [lindex [lindex $ret 0] 1] $dup_set([expr $i + 1]) 716 717 puts "\t\tTest046.h.3: Insert by cursor before cursor (DB_BEFORE)." 718 set ret [$dbc put -before BEFOREPUT] 719 error_check_good dbc_put:before $ret 0 720 set ret [$dbc get -current] 721 error_check_bad dbc_get:curr [llength $ret] 0 722 error_check_good \ 723 dbc_get:curr:match [lindex [lindex $ret 0] 1] BEFOREPUT 724 # make sure that this is actually a dup w/ dup before 725 set ret [$dbc get -prev] 726 error_check_bad dbc_get:prev [llength $ret] 0 727 error_check_good dbc_get:prev:match \ 728 [lindex [lindex $ret 0] 1] $dup_set($i) 729 set ret [$dbc get -prev] 730 # should not be a dup 731 error_check_bad dbc_get:prev(no_dup) \ 732 [lindex [lindex $ret 0] 0] $keym 733 734 puts "\t\tTest046.h.4: Insert by cursor after cursor (DB_AFTER)." 735 set ret [$dbc get -set $keym] 736 737 # delete next 3 when fix 738 #puts "[$dbc get -current]\ 739 # [$dbc get -next] [$dbc get -next] [$dbc get -next] [$dbc get -next]" 740 #set ret [$dbc get -set $keym] 741 742 error_check_bad dbc_get:set [llength $ret] 0 743 set ret [$dbc put -after AFTERPUT] 744 error_check_good dbc_put:after $ret 0 745 #puts [$dbc get -current] 746 747 # delete next 3 when fix 748 #set ret [$dbc get -set $keym] 749 #puts "[$dbc get -current] next: [$dbc get -next] [$dbc get -next]" 750 #set ret [$dbc get -set AFTERPUT] 751 #set ret [$dbc get -set $keym] 752 #set ret [$dbc get -next] 753 #puts $ret 754 755 set ret [$dbc get -current] 756 error_check_bad dbc_get:curr [llength $ret] 0 757 error_check_good dbc_get:curr:match [lindex [lindex $ret 0] 1] AFTERPUT 758 set ret [$dbc get -prev] 759 # now should be on first item (non-dup) of keym 760 error_check_bad dbc_get:prev1 [llength $ret] 0 761 error_check_good \ 762 dbc_get:match [lindex [lindex $ret 0] 1] $dup_set($i) 763 set ret [$dbc get -next] 764 error_check_bad dbc_get:next [llength $ret] 0 765 error_check_good \ 766 dbc_get:match2 [lindex [lindex $ret 0] 1] AFTERPUT 767 set ret [$dbc get -next] 768 error_check_bad dbc_get:next [llength $ret] 0 769 # this is the dup we added previously 770 error_check_good \ 771 dbc_get:match3 [lindex [lindex $ret 0] 1] BEFOREPUT 772 773 # now get rid of the dups we added 774 error_check_good dbc_del [$dbc del] 0 775 set ret [$dbc get -prev] 776 error_check_bad dbc_get:prev2 [llength $ret] 0 777 error_check_good dbc_del2 [$dbc del] 0 778 # put cursor on first dup item for the rest of test 779 set ret [$dbc get -set $keym] 780 error_check_bad dbc_get:first [llength $ret] 0 781 error_check_good \ 782 dbc_get:first:check [lindex [lindex $ret 0] 1] $dup_set($i) 783 784 puts "\t\tTest046.h.5: Overwrite small by small." 785 set ret [$dbc put -current DATA_OVERWRITE] 786 error_check_good dbc_put:current:overwrite $ret 0 787 set ret [$dbc get -current] 788 error_check_good dbc_get:current(put,small/small) \ 789 [lindex [lindex $ret 0] 1] DATA_OVERWRITE 790 791 puts "\t\tTest046.h.6: Overwrite small with big." 792 set ret [$dbc put -current DATA_BIG_OVERWRITE[repeat $alphabet 200]] 793 error_check_good dbc_put:current:overwrite:big $ret 0 794 set ret [$dbc get -current] 795 error_check_good dbc_get:current(put,small/big) \ 796 [is_substr [lindex [lindex $ret 0] 1] DATA_BIG_OVERWRITE] 1 797 798 puts "\t\tTest046.h.7: Overwrite big with big." 799 set ret [$dbc put -current DATA_BIG_OVERWRITE2[repeat $alphabet 200]] 800 error_check_good dbc_put:current:overwrite(2):big $ret 0 801 set ret [$dbc get -current] 802 error_check_good dbc_get:current(put,big/big) \ 803 [is_substr [lindex [lindex $ret 0] 1] DATA_BIG_OVERWRITE2] 1 804 805 puts "\t\tTest046.h.8: Overwrite big with small." 806 set ret [$dbc put -current DATA_OVERWRITE2] 807 error_check_good dbc_put:current:overwrite:small $ret 0 808 set ret [$dbc get -current] 809 error_check_good dbc_get:current(put,big/small) \ 810 [is_substr [lindex [lindex $ret 0] 1] DATA_OVERWRITE2] 1 811 812 puts "\tTest046.i: Cleaning up from test." 813 error_check_good dbc_close [$dbc close] 0 814 if { $txnenv == 1 } { 815 error_check_good txn [$t commit] 0 816 } 817 error_check_good db_close [$db close] 0 818 819 puts "\tTest046 complete." 820} 821