1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test094.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test094 8# TEST Test using set_dup_compare. 9# TEST 10# TEST Use the first 10,000 entries from the dictionary. 11# TEST Insert each with self as key and data; retrieve each. 12# TEST After all are entered, retrieve all; compare output to original. 13# TEST Close file, reopen, do retrieve and re-verify. 14proc test094 { method {nentries 10000} {ndups 10} {tnum "094"} args} { 15 source ./include.tcl 16 global errorInfo 17 18 set dbargs [convert_args $method $args] 19 set omethod [convert_method $method] 20 21 if { [is_btree $method] != 1 && [is_hash $method] != 1 } { 22 puts "Test$tnum: skipping for method $method." 23 return 24 } 25 26 set txnenv 0 27 set eindex [lsearch -exact $dbargs "-env"] 28 # Create the database and open the dictionary 29 # 30 # If we are using an env, then testfile should just be the db name. 31 # Otherwise it is the test directory and the name. 32 if { $eindex == -1 } { 33 set testfile $testdir/test$tnum-a.db 34 set env NULL 35 } else { 36 set testfile test$tnum-a.db 37 incr eindex 38 set env [lindex $dbargs $eindex] 39 set rpcenv [is_rpcenv $env] 40 if { $rpcenv == 1 } { 41 puts "Test$tnum: skipping for RPC" 42 return 43 } 44 set txnenv [is_txnenv $env] 45 if { $txnenv == 1 } { 46 append dbargs " -auto_commit " 47 if { $nentries == 10000 } { 48 set nentries 100 49 } 50 reduce_dups nentries ndups 51 } 52 set testdir [get_home $env] 53 } 54 puts "Test$tnum: $method ($args) $nentries \ 55 with $ndups dups using dupcompare" 56 57 cleanup $testdir $env 58 59 set db [eval {berkdb_open -dupcompare test094_cmp \ 60 -dup -dupsort -create -mode 0644} $omethod $dbargs {$testfile}] 61 error_check_good dbopen [is_valid_db $db] TRUE 62 63 set did [open $dict] 64 set t1 $testdir/t1 65 set pflags "" 66 set gflags "" 67 set txn "" 68 puts "\tTest$tnum.a: $nentries put/get duplicates loop" 69 # Here is the loop where we put and get each key/data pair 70 set count 0 71 set dlist {} 72 for {set i 0} {$i < $ndups} {incr i} { 73 set dlist [linsert $dlist 0 $i] 74 } 75 while { [gets $did str] != -1 && $count < $nentries } { 76 set key $str 77 for {set i 0} {$i < $ndups} {incr i} { 78 set data $i:$str 79 if { $txnenv == 1 } { 80 set t [$env txn] 81 error_check_good txn [is_valid_txn $t $env] TRUE 82 set txn "-txn $t" 83 } 84 set ret [eval {$db put} \ 85 $txn $pflags {$key [chop_data $omethod $data]}] 86 error_check_good put $ret 0 87 if { $txnenv == 1 } { 88 error_check_good txn [$t commit] 0 89 } 90 } 91 92 set ret [eval {$db get} $gflags {$key}] 93 error_check_good get [llength $ret] $ndups 94 incr count 95 } 96 close $did 97 # Now we will get each key from the DB and compare the results 98 # to the original. 99 puts "\tTest$tnum.b: traverse checking duplicates before close" 100 if { $txnenv == 1 } { 101 set t [$env txn] 102 error_check_good txn [is_valid_txn $t $env] TRUE 103 set txn "-txn $t" 104 } 105 dup_check $db $txn $t1 $dlist 106 if { $txnenv == 1 } { 107 error_check_good txn [$t commit] 0 108 } 109 error_check_good db_close [$db close] 0 110 111 # Set up second testfile so truncate flag is not needed. 112 # If we are using an env, then testfile should just be the db name. 113 # Otherwise it is the test directory and the name. 114 if { $eindex == -1 } { 115 set testfile $testdir/test$tnum-b.db 116 set env NULL 117 } else { 118 set testfile test$tnum-b.db 119 set env [lindex $dbargs $eindex] 120 set testdir [get_home $env] 121 } 122 cleanup $testdir $env 123 124 # 125 # Test dupcompare with data items big enough to force offpage dups. 126 # 127 puts "\tTest$tnum.c: big key put/get dup loop key=filename data=filecontents" 128 set db [eval {berkdb_open -dupcompare test094_cmp -dup -dupsort \ 129 -create -mode 0644} $omethod $dbargs $testfile] 130 error_check_good dbopen [is_valid_db $db] TRUE 131 132 # Here is the loop where we put and get each key/data pair 133 set file_list [get_file_list 1] 134 if { [llength $file_list] > $nentries } { 135 set file_list [lrange $file_list 1 $nentries] 136 } 137 138 set count 0 139 foreach f $file_list { 140 set fid [open $f r] 141 fconfigure $fid -translation binary 142 set cont [read $fid] 143 close $fid 144 145 set key $f 146 for {set i 0} {$i < $ndups} {incr i} { 147 set data $i:$cont 148 if { $txnenv == 1 } { 149 set t [$env txn] 150 error_check_good txn [is_valid_txn $t $env] TRUE 151 set txn "-txn $t" 152 } 153 set ret [eval {$db put} \ 154 $txn $pflags {$key [chop_data $omethod $data]}] 155 error_check_good put $ret 0 156 if { $txnenv == 1 } { 157 error_check_good txn [$t commit] 0 158 } 159 } 160 161 set ret [eval {$db get} $gflags {$key}] 162 error_check_good get [llength $ret] $ndups 163 incr count 164 } 165 166 puts "\tTest$tnum.d: traverse checking duplicates before close" 167 if { $txnenv == 1 } { 168 set t [$env txn] 169 error_check_good txn [is_valid_txn $t $env] TRUE 170 set txn "-txn $t" 171 } 172 dup_file_check $db $txn $t1 $dlist 173 if { $txnenv == 1 } { 174 error_check_good txn [$t commit] 0 175 set testdir [get_home $env] 176 } 177 error_check_good db_close [$db close] 0 178 179 # Clean up the test directory, since there's currently 180 # no way to specify a dup_compare function to berkdb dbverify 181 # and without one it will fail. 182 cleanup $testdir $env 183} 184 185# Simple dup comparison. 186proc test094_cmp { a b } { 187 return [string compare $b $a] 188} 189