1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test031.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test031 8# TEST Duplicate sorting functionality 9# TEST Make sure DB_NODUPDATA works. 10# TEST 11# TEST Use the first 10,000 entries from the dictionary. 12# TEST Insert each with self as key and "ndups" duplicates 13# TEST For the data field, prepend random five-char strings (see test032) 14# TEST that we force the duplicate sorting code to do something. 15# TEST Along the way, test that we cannot insert duplicate duplicates 16# TEST using DB_NODUPDATA. 17# TEST 18# TEST By setting ndups large, we can make this an off-page test 19# TEST After all are entered, retrieve all; verify output. 20# TEST Close file, reopen, do retrieve and re-verify. 21# TEST This does not work for recno 22proc test031 { method {nentries 10000} {ndups 5} {tnum "031"} args } { 23 global alphabet 24 global rand_init 25 source ./include.tcl 26 27 berkdb srand $rand_init 28 29 set args [convert_args $method $args] 30 set omethod [convert_method $method] 31 32 # Create the database and open the dictionary 33 set txnenv 0 34 set eindex [lsearch -exact $args "-env"] 35 # 36 # If we are using an env, then testfile should just be the db name. 37 # Otherwise it is the test directory and the name. 38 if { $eindex == -1 } { 39 set testfile $testdir/test$tnum.db 40 set checkdb $testdir/checkdb.db 41 set env NULL 42 } else { 43 set testfile test$tnum.db 44 set checkdb checkdb.db 45 incr eindex 46 set env [lindex $args $eindex] 47 set txnenv [is_txnenv $env] 48 if { $txnenv == 1 } { 49 append args " -auto_commit " 50 # 51 # If we are using txns and running with the 52 # default, set the default down a bit. 53 # 54 if { $nentries == 10000 } { 55 set nentries 100 56 } 57 reduce_dups nentries ndups 58 } 59 set testdir [get_home $env] 60 } 61 set t1 $testdir/t1 62 set t2 $testdir/t2 63 set t3 $testdir/t3 64 cleanup $testdir $env 65 66 puts "Test$tnum: \ 67 $method ($args) $nentries small $ndups sorted dup key/data pairs" 68 if { [is_record_based $method] == 1 || \ 69 [is_rbtree $method] == 1 } { 70 puts "Test$tnum skipping for method $omethod" 71 return 72 } 73 set db [eval {berkdb_open -create \ 74 -mode 0644} $args {$omethod -dup -dupsort $testfile}] 75 error_check_good dbopen [is_valid_db $db] TRUE 76 set did [open $dict] 77 78 set check_db [eval {berkdb_open \ 79 -create -mode 0644} $args {-hash $checkdb}] 80 error_check_good dbopen:check_db [is_valid_db $check_db] TRUE 81 82 set pflags "" 83 set gflags "" 84 set txn "" 85 set count 0 86 87 # Here is the loop where we put and get each key/data pair 88 puts "\tTest$tnum.a: Put/get loop, check nodupdata" 89 if { $txnenv == 1 } { 90 set t [$env txn] 91 error_check_good txn [is_valid_txn $t $env] TRUE 92 set txn "-txn $t" 93 } 94 set dbc [eval {$db cursor} $txn] 95 error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE 96 while { [gets $did str] != -1 && $count < $nentries } { 97 # Re-initialize random string generator 98 randstring_init $ndups 99 100 set dups "" 101 for { set i 1 } { $i <= $ndups } { incr i } { 102 set pref [randstring] 103 set dups $dups$pref 104 set datastr $pref:$str 105 if { $i == 2 } { 106 set nodupstr $datastr 107 } 108 set ret [eval {$db put} \ 109 $txn $pflags {$str [chop_data $method $datastr]}] 110 error_check_good put $ret 0 111 } 112 113 # Test DB_NODUPDATA using the DB handle 114 set ret [eval {$db put -nodupdata} \ 115 $txn $pflags {$str [chop_data $method $nodupstr]}] 116 error_check_good db_nodupdata [is_substr $ret "DB_KEYEXIST"] 1 117 118 set ret [eval {$check_db put} \ 119 $txn $pflags {$str [chop_data $method $dups]}] 120 error_check_good checkdb_put $ret 0 121 122 # Now retrieve all the keys matching this key 123 set x 0 124 set lastdup "" 125 # Test DB_NODUPDATA using cursor handle 126 set ret [$dbc get -set $str] 127 error_check_bad dbc_get [llength $ret] 0 128 set datastr [lindex [lindex $ret 0] 1] 129 error_check_bad dbc_data [string length $datastr] 0 130 set ret [eval {$dbc put -nodupdata} \ 131 {$str [chop_data $method $datastr]}] 132 error_check_good dbc_nodupdata [is_substr $ret "DB_KEYEXIST"] 1 133 134 for {set ret [$dbc get -set $str]} \ 135 {[llength $ret] != 0} \ 136 {set ret [$dbc get -nextdup] } { 137 set k [lindex [lindex $ret 0] 0] 138 if { [string compare $k $str] != 0 } { 139 break 140 } 141 set datastr [lindex [lindex $ret 0] 1] 142 if {[string length $datastr] == 0} { 143 break 144 } 145 if {[string compare \ 146 $lastdup [pad_data $method $datastr]] > 0} { 147 error_check_good \ 148 sorted_dups($lastdup,$datastr) 0 1 149 } 150 incr x 151 set lastdup $datastr 152 } 153 error_check_good "Test$tnum:ndups:$str" $x $ndups 154 incr count 155 } 156 error_check_good cursor_close [$dbc close] 0 157 if { $txnenv == 1 } { 158 error_check_good txn [$t commit] 0 159 } 160 close $did 161 162 # Now we will get each key from the DB and compare the results 163 # to the original. 164 puts "\tTest$tnum.b: Checking file for correct duplicates" 165 if { $txnenv == 1 } { 166 set t [$env txn] 167 error_check_good txn [is_valid_txn $t $env] TRUE 168 set txn "-txn $t" 169 } 170 set dbc [eval {$db cursor} $txn] 171 error_check_good cursor_open(2) [is_valid_cursor $dbc $db] TRUE 172 173 set lastkey "THIS WILL NEVER BE A KEY VALUE" 174 # no need to delete $lastkey 175 set firsttimethru 1 176 for {set ret [$dbc get -first]} \ 177 {[llength $ret] != 0} \ 178 {set ret [$dbc 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 if { [string compare $k $lastkey] != 0 } { 184 # Remove last key from the checkdb 185 if { $firsttimethru != 1 } { 186 error_check_good check_db:del:$lastkey \ 187 [eval {$check_db del} $txn {$lastkey}] 0 188 } 189 set firsttimethru 0 190 set lastdup "" 191 set lastkey $k 192 set dups [lindex [lindex [eval {$check_db get} \ 193 $txn {$k}] 0] 1] 194 error_check_good check_db:get:$k \ 195 [string length $dups] [expr $ndups * 4] 196 } 197 198 if { [string compare $lastdup $d] > 0 } { 199 error_check_good dup_check:$k:$d 0 1 200 } 201 set lastdup $d 202 203 set pref [string range $d 0 3] 204 set ndx [string first $pref $dups] 205 error_check_good valid_duplicate [expr $ndx >= 0] 1 206 set a [string range $dups 0 [expr $ndx - 1]] 207 set b [string range $dups [expr $ndx + 4] end] 208 set dups $a$b 209 } 210 # Remove last key from the checkdb 211 if { [string length $lastkey] != 0 } { 212 error_check_good check_db:del:$lastkey \ 213 [eval {$check_db del} $txn {$lastkey}] 0 214 } 215 216 # Make sure there is nothing left in check_db 217 218 set check_c [eval {$check_db cursor} $txn] 219 set ret [$check_c get -first] 220 error_check_good check_c:get:$ret [llength $ret] 0 221 error_check_good check_c:close [$check_c close] 0 222 223 error_check_good dbc_close [$dbc close] 0 224 if { $txnenv == 1 } { 225 error_check_good txn [$t commit] 0 226 } 227 error_check_good check_db:close [$check_db close] 0 228 error_check_good db_close [$db close] 0 229} 230