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