1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test023.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test023 8# TEST Duplicate test 9# TEST Exercise deletes and cursor operations within a duplicate set. 10# TEST Add a key with duplicates (first time on-page, second time off-page) 11# TEST Number the dups. 12# TEST Delete dups and make sure that CURRENT/NEXT/PREV work correctly. 13proc test023 { method args } { 14 global alphabet 15 global dupnum 16 global dupstr 17 global errorInfo 18 source ./include.tcl 19 20 set args [convert_args $method $args] 21 set omethod [convert_method $method] 22 puts "Test023: $method delete duplicates/check cursor operations" 23 if { [is_record_based $method] == 1 || \ 24 [is_rbtree $method] == 1 } { 25 puts "Test023: skipping for method $omethod" 26 return 27 } 28 29 # Create the database and open the dictionary 30 set txnenv 0 31 set eindex [lsearch -exact $args "-env"] 32 # 33 # If we are using an env, then testfile should just be the db name. 34 # Otherwise it is the test directory and the name. 35 if { $eindex == -1 } { 36 set testfile $testdir/test023.db 37 set env NULL 38 } else { 39 set testfile test023.db 40 incr eindex 41 set env [lindex $args $eindex] 42 set txnenv [is_txnenv $env] 43 if { $txnenv == 1 } { 44 append args " -auto_commit " 45 } 46 set testdir [get_home $env] 47 } 48 set t1 $testdir/t1 49 cleanup $testdir $env 50 set db [eval {berkdb_open \ 51 -create -mode 0644 -dup} $args {$omethod $testfile}] 52 error_check_good dbopen [is_valid_db $db] TRUE 53 54 set pflags "" 55 set gflags "" 56 set txn "" 57 58 if { $txnenv == 1 } { 59 set t [$env txn] 60 error_check_good txn [is_valid_txn $t $env] TRUE 61 set txn "-txn $t" 62 } 63 set dbc [eval {$db cursor} $txn] 64 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 65 66 foreach i { onpage offpage } { 67 if { $i == "onpage" } { 68 set dupstr DUP 69 } else { 70 set dupstr [repeat $alphabet 50] 71 } 72 puts "\tTest023.a: Insert key w/$i dups" 73 set key "duplicate_val_test" 74 for { set count 0 } { $count < 20 } { incr count } { 75 set ret \ 76 [eval {$db put} $txn $pflags {$key $count$dupstr}] 77 error_check_good db_put $ret 0 78 } 79 80 # Now let's get all the items and make sure they look OK. 81 puts "\tTest023.b: Check initial duplicates" 82 set dupnum 0 83 dump_file $db $txn $t1 test023.check 84 85 # Delete a couple of random items (FIRST, LAST one in middle) 86 # Make sure that current returns an error and that NEXT and 87 # PREV do the right things. 88 89 set ret [$dbc get -set $key] 90 error_check_bad dbc_get:SET [llength $ret] 0 91 92 puts "\tTest023.c: Delete first and try gets" 93 # This should be the first duplicate 94 error_check_good \ 95 dbc_get:SET $ret [list [list duplicate_val_test 0$dupstr]] 96 97 # Now delete it. 98 set ret [$dbc del] 99 error_check_good dbc_del:FIRST $ret 0 100 101 # Now current should fail 102 set ret [$dbc get -current] 103 error_check_good dbc_get:CURRENT $ret "" 104 105 # Now Prev should fail 106 set ret [$dbc get -prev] 107 error_check_good dbc_get:prev0 [llength $ret] 0 108 109 # Now 10 nexts should work to get us in the middle 110 for { set j 1 } { $j <= 10 } { incr j } { 111 set ret [$dbc get -next] 112 error_check_good \ 113 dbc_get:next [llength [lindex $ret 0]] 2 114 error_check_good \ 115 dbc_get:next [lindex [lindex $ret 0] 1] $j$dupstr 116 } 117 118 puts "\tTest023.d: Delete middle and try gets" 119 # Now do the delete on the current key. 120 set ret [$dbc del] 121 error_check_good dbc_del:10 $ret 0 122 123 # Now current should fail 124 set ret [$dbc get -current] 125 error_check_good dbc_get:deleted $ret "" 126 127 # Prev and Next should work 128 set ret [$dbc get -next] 129 error_check_good dbc_get:next [llength [lindex $ret 0]] 2 130 error_check_good \ 131 dbc_get:next [lindex [lindex $ret 0] 1] 11$dupstr 132 133 set ret [$dbc get -prev] 134 error_check_good dbc_get:next [llength [lindex $ret 0]] 2 135 error_check_good \ 136 dbc_get:next [lindex [lindex $ret 0] 1] 9$dupstr 137 138 # Now go to the last one 139 for { set j 11 } { $j <= 19 } { incr j } { 140 set ret [$dbc get -next] 141 error_check_good \ 142 dbc_get:next [llength [lindex $ret 0]] 2 143 error_check_good \ 144 dbc_get:next [lindex [lindex $ret 0] 1] $j$dupstr 145 } 146 147 puts "\tTest023.e: Delete last and try gets" 148 # Now do the delete on the current key. 149 set ret [$dbc del] 150 error_check_good dbc_del:LAST $ret 0 151 152 # Now current should fail 153 set ret [$dbc get -current] 154 error_check_good dbc_get:deleted $ret "" 155 156 # Next should fail 157 set ret [$dbc get -next] 158 error_check_good dbc_get:next19 [llength $ret] 0 159 160 # Prev should work 161 set ret [$dbc get -prev] 162 error_check_good dbc_get:next [llength [lindex $ret 0]] 2 163 error_check_good \ 164 dbc_get:next [lindex [lindex $ret 0] 1] 18$dupstr 165 166 # Now overwrite the current one, then count the number 167 # of data items to make sure that we have the right number. 168 169 puts "\tTest023.f: Count keys, overwrite current, count again" 170 # At this point we should have 17 keys the (initial 20 minus 171 # 3 deletes) 172 set dbc2 [eval {$db cursor} $txn] 173 error_check_good db_cursor:2 [is_substr $dbc2 $db] 1 174 175 set count_check 0 176 for { set rec [$dbc2 get -first] } { 177 [llength $rec] != 0 } { set rec [$dbc2 get -next] } { 178 incr count_check 179 } 180 error_check_good numdups $count_check 17 181 182 set ret [$dbc put -current OVERWRITE] 183 error_check_good dbc_put:current $ret 0 184 185 set count_check 0 186 for { set rec [$dbc2 get -first] } { 187 [llength $rec] != 0 } { set rec [$dbc2 get -next] } { 188 incr count_check 189 } 190 error_check_good numdups $count_check 17 191 error_check_good dbc2_close [$dbc2 close] 0 192 193 # Done, delete all the keys for next iteration 194 set ret [eval {$db del} $txn {$key}] 195 error_check_good db_delete $ret 0 196 197 # database should be empty 198 199 set ret [$dbc get -first] 200 error_check_good first_after_empty [llength $ret] 0 201 } 202 203 error_check_good dbc_close [$dbc close] 0 204 if { $txnenv == 1 } { 205 error_check_good txn [$t commit] 0 206 } 207 error_check_good db_close [$db close] 0 208 209} 210 211# Check function for test023; keys and data are identical 212proc test023.check { key data } { 213 global dupnum 214 global dupstr 215 error_check_good "bad key" $key duplicate_val_test 216 error_check_good "data mismatch for $key" $data $dupnum$dupstr 217 incr dupnum 218} 219