1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test032.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test032 8# TEST DB_GET_BOTH, DB_GET_BOTH_RANGE 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 functionality by retrieving each dup in the file 17# TEST explicitly. Test the DB_GET_BOTH_RANGE functionality by retrieving 18# TEST the unique key prefix (cursor only). Finally test the failure case. 19proc test032 { method {nentries 10000} {ndups 5} {tnum "032"} args } { 20 global alphabet rand_init 21 source ./include.tcl 22 23 set args [convert_args $method $args] 24 set omethod [convert_method $method] 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/test$tnum.db 36 set checkdb $testdir/checkdb.db 37 set env NULL 38 } else { 39 set testfile test$tnum.db 40 set checkdb checkdb.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 reduce_dups nentries ndups 54 } 55 set testdir [get_home $env] 56 } 57 set t1 $testdir/t1 58 set t2 $testdir/t2 59 set t3 $testdir/t3 60 cleanup $testdir $env 61 62 puts "Test$tnum:\ 63 $method ($args) $nentries small sorted $ndups dup key/data pairs" 64 if { [is_record_based $method] == 1 || \ 65 [is_rbtree $method] == 1 } { 66 puts "Test$tnum skipping for method $omethod" 67 return 68 } 69 set db [eval {berkdb_open -create -mode 0644 \ 70 $omethod -dup -dupsort} $args {$testfile} ] 71 error_check_good dbopen [is_valid_db $db] TRUE 72 set did [open $dict] 73 74 set check_db [eval {berkdb_open \ 75 -create -mode 0644} $args {-hash $checkdb}] 76 error_check_good dbopen:check_db [is_valid_db $check_db] TRUE 77 78 set pflags "" 79 set gflags "" 80 set txn "" 81 set count 0 82 83 # Here is the loop where we put and get each key/data pair 84 puts "\tTest$tnum.a: Put/get loop" 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 error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE 92 while { [gets $did str] != -1 && $count < $nentries } { 93 # Re-initialize random string generator 94 randstring_init $ndups 95 96 set dups "" 97 for { set i 1 } { $i <= $ndups } { incr i } { 98 set pref [randstring] 99 set dups $dups$pref 100 set datastr $pref:$str 101 set ret [eval {$db put} \ 102 $txn $pflags {$str [chop_data $method $datastr]}] 103 error_check_good put $ret 0 104 } 105 set ret [eval {$check_db put} \ 106 $txn $pflags {$str [chop_data $method $dups]}] 107 error_check_good checkdb_put $ret 0 108 109 # Now retrieve all the keys matching this key 110 set x 0 111 set lastdup "" 112 for {set ret [$dbc get -set $str]} \ 113 {[llength $ret] != 0} \ 114 {set ret [$dbc get -nextdup] } { 115 set k [lindex [lindex $ret 0] 0] 116 if { [string compare $k $str] != 0 } { 117 break 118 } 119 set datastr [lindex [lindex $ret 0] 1] 120 if {[string length $datastr] == 0} { 121 break 122 } 123 if {[string compare $lastdup $datastr] > 0} { 124 error_check_good \ 125 sorted_dups($lastdup,$datastr) 0 1 126 } 127 incr x 128 set lastdup $datastr 129 } 130 131 error_check_good "Test$tnum:ndups:$str" $x $ndups 132 incr count 133 } 134 error_check_good cursor_close [$dbc close] 0 135 if { $txnenv == 1 } { 136 error_check_good txn [$t commit] 0 137 } 138 close $did 139 140 # Now we will get each key from the DB and compare the results 141 # to the original. 142 puts "\tTest$tnum.b: Checking file for correct duplicates (no cursor)" 143 if { $txnenv == 1 } { 144 set t [$env txn] 145 error_check_good txn [is_valid_txn $t $env] TRUE 146 set txn "-txn $t" 147 } 148 set check_c [eval {$check_db cursor} $txn] 149 error_check_good check_c_open(2) \ 150 [is_valid_cursor $check_c $check_db] TRUE 151 152 for {set ndx 0} {$ndx < [expr 4 * $ndups]} {incr ndx 4} { 153 for {set ret [$check_c get -first]} \ 154 {[llength $ret] != 0} \ 155 {set ret [$check_c get -next] } { 156 set k [lindex [lindex $ret 0] 0] 157 set d [lindex [lindex $ret 0] 1] 158 error_check_bad data_check:$d [string length $d] 0 159 160 set pref [string range $d $ndx [expr $ndx + 3]] 161 set data $pref:$k 162 set ret [eval {$db get} $txn {-get_both $k $data}] 163 error_check_good \ 164 get_both_data:$k $ret [list [list $k $data]] 165 } 166 } 167 168 $db sync 169 170 # Now repeat the above test using cursor ops 171 puts "\tTest$tnum.c: Checking file for correct duplicates (cursor)" 172 set dbc [eval {$db cursor} $txn] 173 error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE 174 175 for {set ndx 0} {$ndx < [expr 4 * $ndups]} {incr ndx 4} { 176 for {set ret [$check_c get -first]} \ 177 {[llength $ret] != 0} \ 178 {set ret [$check_c get -next] } { 179 set k [lindex [lindex $ret 0] 0] 180 set d [lindex [lindex $ret 0] 1] 181 error_check_bad data_check:$d [string length $d] 0 182 183 set pref [string range $d $ndx [expr $ndx + 3]] 184 set data $pref:$k 185 set ret [eval {$dbc get} {-get_both $k $data}] 186 error_check_good \ 187 curs_get_both_data:$k $ret [list [list $k $data]] 188 189 set ret [eval {$dbc get} {-get_both_range $k $pref}] 190 error_check_good \ 191 curs_get_both_range:$k $ret [list [list $k $data]] 192 } 193 } 194 195 # Now check the error case 196 puts "\tTest$tnum.d: Check error case (no cursor)" 197 for {set ret [$check_c get -first]} \ 198 {[llength $ret] != 0} \ 199 {set ret [$check_c get -next] } { 200 set k [lindex [lindex $ret 0] 0] 201 set d [lindex [lindex $ret 0] 1] 202 error_check_bad data_check:$d [string length $d] 0 203 204 set data XXX$k 205 set ret [eval {$db get} $txn {-get_both $k $data}] 206 error_check_good error_case:$k [llength $ret] 0 207 } 208 209 # Now check the error case 210 puts "\tTest$tnum.e: Check error case (cursor)" 211 for {set ret [$check_c get -first]} \ 212 {[llength $ret] != 0} \ 213 {set ret [$check_c get -next] } { 214 set k [lindex [lindex $ret 0] 0] 215 set d [lindex [lindex $ret 0] 1] 216 error_check_bad data_check:$d [string length $d] 0 217 218 set data XXX$k 219 set ret [eval {$dbc get} {-get_both $k $data}] 220 error_check_good error_case:$k [llength $ret] 0 221 } 222 223 error_check_good check_c:close [$check_c close] 0 224 error_check_good dbc_close [$dbc close] 0 225 if { $txnenv == 1 } { 226 error_check_good txn [$t commit] 0 227 } 228 error_check_good check_db:close [$check_db close] 0 229 error_check_good db_close [$db close] 0 230} 231