1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test030.tcl,v 12.7 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test030 8# TEST Test DB_NEXT_DUP Functionality. 9proc test030 { method {nentries 10000} args } { 10 global rand_init 11 source ./include.tcl 12 13 set args [convert_args $method $args] 14 set omethod [convert_method $method] 15 16 if { [is_record_based $method] == 1 || 17 [is_rbtree $method] == 1 } { 18 puts "Test030 skipping for method $method" 19 return 20 } 21 berkdb srand $rand_init 22 23 # Create the database and open the dictionary 24 set txnenv 0 25 set eindex [lsearch -exact $args "-env"] 26 # 27 # If we are using an env, then testfile should just be the db name. 28 # Otherwise it is the test directory and the name. 29 if { $eindex == -1 } { 30 set testfile $testdir/test030.db 31 set cntfile $testdir/cntfile.db 32 set env NULL 33 } else { 34 set testfile test030.db 35 set cntfile cntfile.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 # If we are using txns and running with the 43 # default, set the default down a bit. 44 # 45 if { $nentries == 10000 } { 46 set nentries 100 47 } 48 } 49 set testdir [get_home $env] 50 } 51 52 puts "Test030: $method ($args) $nentries DB_NEXT_DUP testing" 53 set t1 $testdir/t1 54 set t2 $testdir/t2 55 set t3 $testdir/t3 56 cleanup $testdir $env 57 58 set db [eval {berkdb_open -create \ 59 -mode 0644 -dup} $args {$omethod $testfile}] 60 error_check_good dbopen [is_valid_db $db] TRUE 61 62 # Use a second DB to keep track of how many duplicates 63 # we enter per key 64 65 set cntdb [eval {berkdb_open -create \ 66 -mode 0644} $args {-btree $cntfile}] 67 error_check_good dbopen:cntfile [is_valid_db $db] TRUE 68 69 set pflags "" 70 set gflags "" 71 set txn "" 72 set count 0 73 74 # Here is the loop where we put and get each key/data pair 75 # We will add between 1 and 10 dups with values 1 ... dups 76 # We'll verify each addition. 77 78 set did [open $dict] 79 puts "\tTest030.a: put and get duplicate keys." 80 if { $txnenv == 1 } { 81 set t [$env txn] 82 error_check_good txn [is_valid_txn $t $env] TRUE 83 set txn "-txn $t" 84 } 85 set dbc [eval {$db cursor} $txn] 86 87 while { [gets $did str] != -1 && $count < $nentries } { 88 set ndup [berkdb random_int 1 10] 89 90 for { set i 1 } { $i <= $ndup } { incr i 1 } { 91 set ctxn "" 92 if { $txnenv == 1 } { 93 set ct [$env txn] 94 error_check_good txn \ 95 [is_valid_txn $ct $env] TRUE 96 set ctxn "-txn $ct" 97 } 98 set ret [eval {$cntdb put} \ 99 $ctxn $pflags {$str [chop_data $method $ndup]}] 100 error_check_good put_cnt $ret 0 101 if { $txnenv == 1 } { 102 error_check_good txn [$ct commit] 0 103 } 104 set datastr $i:$str 105 set ret [eval {$db put} \ 106 $txn $pflags {$str [chop_data $method $datastr]}] 107 error_check_good put $ret 0 108 } 109 110 # Now retrieve all the keys matching this key 111 set x 0 112 for {set ret [$dbc get -set $str]} \ 113 {[llength $ret] != 0} \ 114 {set ret [$dbc get -nextdup] } { 115 116 if { [llength $ret] == 0 } { 117 break 118 } 119 incr x 120 121 set k [lindex [lindex $ret 0] 0] 122 if { [string compare $k $str] != 0 } { 123 break 124 } 125 126 set datastr [lindex [lindex $ret 0] 1] 127 set d [data_of $datastr] 128 error_check_good Test030:put $d $str 129 130 set id [ id_of $datastr ] 131 error_check_good Test030:dup# $id $x 132 } 133 error_check_good Test030:numdups $x $ndup 134 135 # Now retrieve them backwards 136 for {set ret [$dbc get -prev]} \ 137 {[llength $ret] != 0} \ 138 {set ret [$dbc get -prevdup] } { 139 140 if { [llength $ret] == 0 } { 141 break 142 } 143 144 set k [lindex [lindex $ret 0] 0] 145 if { [string compare $k $str] != 0 } { 146 break 147 } 148 incr x -1 149 150 set datastr [lindex [lindex $ret 0] 1] 151 set d [data_of $datastr] 152 error_check_good Test030:put $d $str 153 154 set id [ id_of $datastr ] 155 error_check_good Test030:dup# $id $x 156 } 157 error_check_good Test030:numdups $x 1 158 incr count 159 } 160 close $did 161 162 # Verify on sequential pass of entire file 163 puts "\tTest030.b: sequential check" 164 165 # We can't just set lastkey to a null string, since that might 166 # be a key now! 167 set lastkey "THIS STRING WILL NEVER BE A KEY" 168 169 for {set ret [$dbc get -first]} \ 170 {[llength $ret] != 0} \ 171 {set ret [$dbc get -next] } { 172 173 # Outer loop should always get a new key 174 175 set k [lindex [lindex $ret 0] 0] 176 error_check_bad outer_get_loop:key $k $lastkey 177 178 set datastr [lindex [lindex $ret 0] 1] 179 set d [data_of $datastr] 180 set id [ id_of $datastr ] 181 182 error_check_good outer_get_loop:data $d $k 183 error_check_good outer_get_loop:id $id 1 184 185 set lastkey $k 186 # Figure out how may dups we should have 187 if { $txnenv == 1 } { 188 set ct [$env txn] 189 error_check_good txn [is_valid_txn $ct $env] TRUE 190 set ctxn "-txn $ct" 191 } 192 set ret [eval {$cntdb get} $ctxn $pflags {$k}] 193 set ndup [lindex [lindex $ret 0] 1] 194 if { $txnenv == 1 } { 195 error_check_good txn [$ct commit] 0 196 } 197 198 set howmany 1 199 for { set ret [$dbc get -nextdup] } \ 200 { [llength $ret] != 0 } \ 201 { set ret [$dbc get -nextdup] } { 202 incr howmany 203 204 set k [lindex [lindex $ret 0] 0] 205 error_check_good inner_get_loop:key $k $lastkey 206 207 set datastr [lindex [lindex $ret 0] 1] 208 set d [data_of $datastr] 209 set id [ id_of $datastr ] 210 211 error_check_good inner_get_loop:data $d $k 212 error_check_good inner_get_loop:id $id $howmany 213 214 } 215 error_check_good ndups_found $howmany $ndup 216 } 217 218 # Verify on key lookup 219 puts "\tTest030.c: keyed check" 220 set cnt_dbc [$cntdb cursor] 221 for {set ret [$cnt_dbc get -first]} \ 222 {[llength $ret] != 0} \ 223 {set ret [$cnt_dbc get -next] } { 224 set k [lindex [lindex $ret 0] 0] 225 226 set howmany [lindex [lindex $ret 0] 1] 227 error_check_bad cnt_seq:data [string length $howmany] 0 228 229 set i 0 230 for {set ret [$dbc get -set $k]} \ 231 {[llength $ret] != 0} \ 232 {set ret [$dbc get -nextdup] } { 233 incr i 234 235 set k [lindex [lindex $ret 0] 0] 236 237 set datastr [lindex [lindex $ret 0] 1] 238 set d [data_of $datastr] 239 set id [ id_of $datastr ] 240 241 error_check_good inner_get_loop:data $d $k 242 error_check_good inner_get_loop:id $id $i 243 } 244 error_check_good keyed_count $i $howmany 245 246 } 247 error_check_good cnt_curs_close [$cnt_dbc close] 0 248 error_check_good db_curs_close [$dbc close] 0 249 if { $txnenv == 1 } { 250 error_check_good txn [$t commit] 0 251 } 252 error_check_good cnt_file_close [$cntdb close] 0 253 error_check_good db_file_close [$db close] 0 254} 255