1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test039.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test039 8# TEST DB_GET_BOTH/DB_GET_BOTH_RANGE on deleted items without comparison 9# TEST function. 10# TEST 11# TEST Use the first 10,000 entries from the dictionary. Insert each with 12# TEST self as key and "ndups" duplicates. For the data field, prepend the 13# TEST letters of the alphabet in a random order so we force the duplicate 14# TEST sorting code to do something. By setting ndups large, we can make 15# TEST this an off-page test. 16# TEST 17# TEST Test the DB_GET_BOTH and DB_GET_BOTH_RANGE functionality by retrieving 18# TEST each dup in the file explicitly. Then remove each duplicate and try 19# TEST the retrieval again. 20proc test039 { method {nentries 10000} {ndups 5} {tnum "039"} args } { 21 global alphabet 22 global rand_init 23 source ./include.tcl 24 25 berkdb srand $rand_init 26 27 set args [convert_args $method $args] 28 set omethod [convert_method $method] 29 30 if { [is_record_based $method] == 1 || \ 31 [is_rbtree $method] == 1 } { 32 puts "Test$tnum skipping for method $method" 33 return 34 } 35 # Create the database and open the dictionary 36 set txnenv 0 37 set eindex [lsearch -exact $args "-env"] 38 # 39 # If we are using an env, then testfile should just be the db name. 40 # Otherwise it is the test directory and the name. 41 if { $eindex == -1 } { 42 set testfile $testdir/test$tnum.db 43 set checkdb $testdir/checkdb.db 44 set env NULL 45 } else { 46 set testfile test$tnum.db 47 set checkdb checkdb.db 48 incr eindex 49 set env [lindex $args $eindex] 50 set txnenv [is_txnenv $env] 51 if { $txnenv == 1 } { 52 append args " -auto_commit " 53 # 54 # If we are using txns and running with the 55 # default, set the default down a bit. 56 # 57 if { $nentries == 10000 } { 58 set nentries 100 59 } 60 reduce_dups nentries ndups 61 } 62 set testdir [get_home $env] 63 } 64 set t1 $testdir/t1 65 set t2 $testdir/t2 66 set t3 $testdir/t3 67 cleanup $testdir $env 68 69 puts "Test$tnum: $method $nentries \ 70 small $ndups unsorted dup key/data pairs" 71 72 set db [eval {berkdb_open -create -mode 0644 \ 73 $omethod -dup} $args {$testfile}] 74 error_check_good dbopen [is_valid_db $db] TRUE 75 set did [open $dict] 76 77 set check_db [eval \ 78 {berkdb_open -create -mode 0644 -hash} $args {$checkdb}] 79 error_check_good dbopen:check_db [is_valid_db $check_db] TRUE 80 81 set pflags "" 82 set gflags "" 83 set txn "" 84 set count 0 85 86 # Here is the loop where we put and get each key/data pair 87 puts "\tTest$tnum.a: Put/get loop" 88 if { $txnenv == 1 } { 89 set t [$env txn] 90 error_check_good txn [is_valid_txn $t $env] TRUE 91 set txn "-txn $t" 92 } 93 set dbc [eval {$db cursor} $txn] 94 error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE 95 while { [gets $did str] != -1 && $count < $nentries } { 96 set dups "" 97 for { set i 1 } { $i <= $ndups } { incr i } { 98 set pref \ 99 [string index $alphabet [berkdb random_int 0 25]] 100 set pref $pref[string \ 101 index $alphabet [berkdb random_int 0 25]] 102 while { [string first $pref $dups] != -1 } { 103 set pref [string toupper $pref] 104 if { [string first $pref $dups] != -1 } { 105 set pref [string index $alphabet \ 106 [berkdb random_int 0 25]] 107 set pref $pref[string index $alphabet \ 108 [berkdb random_int 0 25]] 109 } 110 } 111 if { [string length $dups] == 0 } { 112 set dups $pref 113 } else { 114 set dups "$dups $pref" 115 } 116 set datastr $pref:$str 117 set ret [eval {$db put} \ 118 $txn $pflags {$str [chop_data $method $datastr]}] 119 error_check_good put $ret 0 120 } 121 set ret [eval {$check_db put} \ 122 $txn $pflags {$str [chop_data $method $dups]}] 123 error_check_good checkdb_put $ret 0 124 125 # Now retrieve all the keys matching this key 126 set x 0 127 set lastdup "" 128 for {set ret [$dbc get -set $str]} \ 129 {[llength $ret] != 0} \ 130 {set ret [$dbc get -nextdup] } { 131 set k [lindex [lindex $ret 0] 0] 132 if { [string compare $k $str] != 0 } { 133 break 134 } 135 set datastr [lindex [lindex $ret 0] 1] 136 if {[string length $datastr] == 0} { 137 break 138 } 139 set xx [expr $x * 3] 140 set check_data \ 141 [string range $dups $xx [expr $xx + 1]]:$k 142 error_check_good retrieve $datastr $check_data 143 incr x 144 } 145 error_check_good "Test$tnum:ndups:$str" $x $ndups 146 incr count 147 } 148 error_check_good cursor_close [$dbc close] 0 149 if { $txnenv == 1 } { 150 error_check_good txn [$t commit] 0 151 } 152 close $did 153 154 # Now check the duplicates, then delete then recheck 155 puts "\tTest$tnum.b: Checking and Deleting duplicates" 156 if { $txnenv == 1 } { 157 set t [$env txn] 158 error_check_good txn [is_valid_txn $t $env] TRUE 159 set txn "-txn $t" 160 } 161 set dbc [eval {$db cursor} $txn] 162 error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE 163 set check_c [eval {$check_db cursor} $txn] 164 error_check_good cursor_open [is_valid_cursor $check_c $check_db] TRUE 165 166 for {set ndx 0} {$ndx < $ndups} {incr ndx} { 167 for {set ret [$check_c get -first]} \ 168 {[llength $ret] != 0} \ 169 {set ret [$check_c get -next] } { 170 set k [lindex [lindex $ret 0] 0] 171 set d [lindex [lindex $ret 0] 1] 172 error_check_bad data_check:$d [string length $d] 0 173 174 set nn [expr $ndx * 3] 175 set pref [string range $d $nn [expr $nn + 1]] 176 set data $pref:$k 177 set ret [$dbc get -get_both $k $data] 178 error_check_good \ 179 get_both_key:$k [lindex [lindex $ret 0] 0] $k 180 error_check_good \ 181 get_both_data:$k [lindex [lindex $ret 0] 1] $data 182 183 set ret [$dbc del] 184 error_check_good del $ret 0 185 186 set ret [$dbc get -get_both $k $data] 187 error_check_good get_both:$k [llength $ret] 0 188 189 set ret [$dbc get -get_both_range $k $data] 190 error_check_good get_both_range:$k [llength $ret] 0 191 192 if {$ndx != 0} { 193 set n [expr ($ndx - 1) * 3] 194 set pref [string range $d $n [expr $n + 1]] 195 set data $pref:$k 196 set ret [$dbc get -get_both $k $data] 197 error_check_good error_case:$k [llength $ret] 0 198 } 199 } 200 } 201 202 error_check_good check_c:close [$check_c close] 0 203 error_check_good dbc_close [$dbc close] 0 204 if { $txnenv == 1 } { 205 error_check_good txn [$t commit] 0 206 } 207 208 error_check_good check_db:close [$check_db close] 0 209 error_check_good db_close [$db close] 0 210} 211