1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996-2009 Oracle. All rights reserved. 4# 5# $Id$ 6# 7# TEST test056 8# TEST Cursor maintenance during deletes. 9# TEST Check if deleting a key when a cursor is on a duplicate of that 10# TEST key works. 11proc test056 { method args } { 12 global errorInfo 13 source ./include.tcl 14 15 set args [convert_args $method $args] 16 set omethod [convert_method $method] 17 18 append args " -create -mode 0644 -dup " 19 if { [is_record_based $method] == 1 || [is_rbtree $method] } { 20 puts "Test056: skipping for method $method" 21 return 22 } 23 # Btree with compression does not support unsorted duplicates. 24 if { [is_compressed $args] == 1 } { 25 puts "Test056 skipping for btree with compression." 26 return 27 } 28 29 puts "Test056: $method delete of key in presence of cursor" 30 31 # Create the database and open the dictionary 32 set txnenv 0 33 set eindex [lsearch -exact $args "-env"] 34 # 35 # If we are using an env, then testfile should just be the db name. 36 # Otherwise it is the test directory and the name. 37 if { $eindex == -1 } { 38 set testfile $testdir/test056.db 39 set env NULL 40 } else { 41 set testfile test056.db 42 incr eindex 43 set env [lindex $args $eindex] 44 set txnenv [is_txnenv $env] 45 if { $txnenv == 1 } { 46 append args " -auto_commit " 47 } 48 set testdir [get_home $env] 49 } 50 cleanup $testdir $env 51 52 set flags "" 53 set txn "" 54 55 set db [eval {berkdb_open} $args {$omethod $testfile}] 56 error_check_good db_open:dup [is_valid_db $db] TRUE 57 58 puts "\tTest056.a: Key delete with cursor on duplicate." 59 # Put three keys in the database 60 for { set key 1 } { $key <= 3 } {incr key} { 61 if { $txnenv == 1 } { 62 set t [$env txn] 63 error_check_good txn [is_valid_txn $t $env] TRUE 64 set txn "-txn $t" 65 } 66 set r [eval {$db put} $txn $flags {$key datum$key}] 67 error_check_good put $r 0 68 if { $txnenv == 1 } { 69 error_check_good txn [$t commit] 0 70 } 71 } 72 73 # Retrieve keys sequentially so we can figure out their order 74 set i 1 75 if { $txnenv == 1 } { 76 set t [$env txn] 77 error_check_good txn [is_valid_txn $t $env] TRUE 78 set txn "-txn $t" 79 } 80 set curs [eval {$db cursor} $txn] 81 error_check_good curs_open:dup [is_valid_cursor $curs $db] TRUE 82 83 for {set d [$curs get -first] } { [llength $d] != 0 } { 84 set d [$curs get -next] } { 85 set key_set($i) [lindex [lindex $d 0] 0] 86 incr i 87 } 88 89 # Now put in a bunch of duplicates for key 2 90 for { set d 1 } { $d <= 5 } {incr d} { 91 set r [eval {$db put} $txn $flags {$key_set(2) dup_$d}] 92 error_check_good dup:put $r 0 93 } 94 95 # Now put the cursor on a duplicate of key 2 96 97 # Now set the cursor on the first of the duplicate set. 98 set r [$curs get -set $key_set(2)] 99 error_check_bad cursor_get:DB_SET [llength $r] 0 100 set k [lindex [lindex $r 0] 0] 101 set d [lindex [lindex $r 0] 1] 102 error_check_good curs_get:DB_SET:key $k $key_set(2) 103 error_check_good curs_get:DB_SET:data $d datum$key_set(2) 104 105 # Now do two nexts 106 set r [$curs get -next] 107 error_check_bad cursor_get:DB_NEXT [llength $r] 0 108 set k [lindex [lindex $r 0] 0] 109 set d [lindex [lindex $r 0] 1] 110 error_check_good curs_get:DB_NEXT:key $k $key_set(2) 111 error_check_good curs_get:DB_NEXT:data $d dup_1 112 113 set r [$curs get -next] 114 error_check_bad cursor_get:DB_NEXT [llength $r] 0 115 set k [lindex [lindex $r 0] 0] 116 set d [lindex [lindex $r 0] 1] 117 error_check_good curs_get:DB_NEXT:key $k $key_set(2) 118 error_check_good curs_get:DB_NEXT:data $d dup_2 119 120 # Now do the delete 121 set r [eval {$db del} $txn $flags {$key_set(2)}] 122 error_check_good delete $r 0 123 124 # Now check the get current on the cursor. 125 set ret [$curs get -current] 126 error_check_good curs_after_del $ret "" 127 128 # Now check that the rest of the database looks intact. There 129 # should be only two keys, 1 and 3. 130 131 set r [$curs get -first] 132 error_check_bad cursor_get:DB_FIRST [llength $r] 0 133 set k [lindex [lindex $r 0] 0] 134 set d [lindex [lindex $r 0] 1] 135 error_check_good curs_get:DB_FIRST:key $k $key_set(1) 136 error_check_good curs_get:DB_FIRST:data $d datum$key_set(1) 137 138 set r [$curs get -next] 139 error_check_bad cursor_get:DB_NEXT [llength $r] 0 140 set k [lindex [lindex $r 0] 0] 141 set d [lindex [lindex $r 0] 1] 142 error_check_good curs_get:DB_NEXT:key $k $key_set(3) 143 error_check_good curs_get:DB_NEXT:data $d datum$key_set(3) 144 145 set r [$curs get -next] 146 error_check_good cursor_get:DB_NEXT [llength $r] 0 147 148 puts "\tTest056.b:\ 149 Cursor delete of first item, followed by cursor FIRST" 150 # Set to beginning 151 set r [$curs get -first] 152 error_check_bad cursor_get:DB_FIRST [llength $r] 0 153 set k [lindex [lindex $r 0] 0] 154 set d [lindex [lindex $r 0] 1] 155 error_check_good curs_get:DB_FIRST:key $k $key_set(1) 156 error_check_good curs_get:DB_FIRST:data $d datum$key_set(1) 157 158 # Now do delete 159 error_check_good curs_del [$curs del] 0 160 161 # Now do DB_FIRST 162 set r [$curs get -first] 163 error_check_bad cursor_get:DB_FIRST [llength $r] 0 164 set k [lindex [lindex $r 0] 0] 165 set d [lindex [lindex $r 0] 1] 166 error_check_good curs_get:DB_FIRST:key $k $key_set(3) 167 error_check_good curs_get:DB_FIRST:data $d datum$key_set(3) 168 169 error_check_good curs_close [$curs close] 0 170 if { $txnenv == 1 } { 171 error_check_good txn [$t commit] 0 172 } 173 error_check_good db_close [$db close] 0 174} 175