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