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