1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test033.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test033 8# TEST DB_GET_BOTH without comparison function 9# TEST 10# TEST Use the first 10,000 entries from the dictionary. Insert each with 11# TEST self as key and data; add duplicate records for each. After all are 12# TEST entered, retrieve all and verify output using DB_GET_BOTH (on DB and 13# TEST DBC handles) and DB_GET_BOTH_RANGE (on a DBC handle) on existent and 14# TEST nonexistent keys. 15# TEST 16# TEST XXX 17# TEST This does not work for rbtree. 18proc test033 { method {nentries 10000} {ndups 5} {tnum "033"} args } { 19 source ./include.tcl 20 21 set args [convert_args $method $args] 22 set omethod [convert_method $method] 23 if { [is_rbtree $method] == 1 } { 24 puts "Test$tnum skipping for method $method" 25 return 26 } 27 28 set txnenv 0 29 set eindex [lsearch -exact $args "-env"] 30 # 31 # If we are using an env, then testfile should just be the db name. 32 # Otherwise it is the test directory and the name. 33 if { $eindex == -1 } { 34 set testfile $testdir/test$tnum.db 35 set env NULL 36 } else { 37 set testfile test$tnum.db 38 incr eindex 39 set env [lindex $args $eindex] 40 set txnenv [is_txnenv $env] 41 if { $txnenv == 1 } { 42 append args " -auto_commit " 43 # 44 # If we are using txns and running with the 45 # default, set the default down a bit. 46 # 47 if { $nentries == 10000 } { 48 set nentries 100 49 } 50 reduce_dups nentries ndups 51 } 52 set testdir [get_home $env] 53 } 54 55 puts "Test$tnum: $method ($args) $nentries small $ndups dup key/data pairs" 56 set t1 $testdir/t1 57 set t2 $testdir/t2 58 set t3 $testdir/t3 59 cleanup $testdir $env 60 61 # Duplicate data entries are not allowed in record based methods. 62 if { [is_record_based $method] == 1 } { 63 set db [eval {berkdb_open -create -mode 0644 \ 64 $omethod} $args {$testfile}] 65 } else { 66 set db [eval {berkdb_open -create -mode 0644 \ 67 $omethod -dup} $args {$testfile}] 68 } 69 error_check_good dbopen [is_valid_db $db] TRUE 70 71 set pflags "" 72 set gflags "" 73 set txn "" 74 75 # Allocate a cursor for DB_GET_BOTH_RANGE. 76 if { $txnenv == 1 } { 77 set t [$env txn] 78 error_check_good txn [is_valid_txn $t $env] TRUE 79 set txn "-txn $t" 80 } 81 set dbc [eval {$db cursor} $txn] 82 error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE 83 84 puts "\tTest$tnum.a: Put/get loop." 85 # Here is the loop where we put and get each key/data pair 86 set count 0 87 set did [open $dict] 88 while { [gets $did str] != -1 && $count < $nentries } { 89 if { [is_record_based $method] == 1 } { 90 set key [expr $count + 1] 91 set ret [eval {$db put} $txn $pflags \ 92 {$key [chop_data $method $str]}] 93 error_check_good put $ret 0 94 } else { 95 for { set i 1 } { $i <= $ndups } { incr i } { 96 set datastr $i:$str 97 set ret [eval {$db put} \ 98 $txn $pflags {$str [chop_data $method $datastr]}] 99 error_check_good db_put $ret 0 100 } 101 } 102 103 # Now retrieve all the keys matching this key and dup 104 # for non-record based AMs. 105 if { [is_record_based $method] == 1 } { 106 test033_recno.check $db $dbc $method $str $txn $key 107 } else { 108 test033_check $db $dbc $method $str $txn $ndups 109 } 110 incr count 111 } 112 113 close $did 114 115 puts "\tTest$tnum.b: Verifying DB_GET_BOTH after creation." 116 set count 0 117 set did [open $dict] 118 while { [gets $did str] != -1 && $count < $nentries } { 119 # Now retrieve all the keys matching this key 120 # for non-record based AMs. 121 if { [is_record_based $method] == 1 } { 122 set key [expr $count + 1] 123 test033_recno.check $db $dbc $method $str $txn $key 124 } else { 125 test033_check $db $dbc $method $str $txn $ndups 126 } 127 incr count 128 } 129 close $did 130 131 error_check_good dbc_close [$dbc close] 0 132 if { $txnenv == 1 } { 133 error_check_good txn [$t commit] 0 134 } 135 error_check_good db_close [$db close] 0 136} 137 138# No testing of dups is done on record-based methods. 139proc test033_recno.check {db dbc method str txn key} { 140 set ret [eval {$db get} $txn {-recno $key}] 141 error_check_good "db_get:$method" \ 142 [lindex [lindex $ret 0] 1] [pad_data $method $str] 143 set ret [$dbc get -get_both $key [pad_data $method $str]] 144 error_check_good "db_get_both:$method" \ 145 [lindex [lindex $ret 0] 1] [pad_data $method $str] 146} 147 148# Testing of non-record-based methods includes duplicates 149# and get_both_range. 150proc test033_check {db dbc method str txn ndups} { 151 for {set i 1} {$i <= $ndups } { incr i } { 152 set datastr $i:$str 153 154 set ret [eval {$db get} $txn {-get_both $str $datastr}] 155 error_check_good "db_get_both:dup#" \ 156 [lindex [lindex $ret 0] 1] $datastr 157 158 set ret [$dbc get -get_both $str $datastr] 159 error_check_good "dbc_get_both:dup#" \ 160 [lindex [lindex $ret 0] 1] $datastr 161 162 set ret [$dbc get -get_both_range $str $datastr] 163 error_check_good "dbc_get_both_range:dup#" \ 164 [lindex [lindex $ret 0] 1] $datastr 165 } 166 167 # Now retrieve non-existent dup (i is ndups + 1) 168 set datastr $i:$str 169 set ret [eval {$db get} $txn {-get_both $str $datastr}] 170 error_check_good db_get_both:dupfailure [llength $ret] 0 171 set ret [$dbc get -get_both $str $datastr] 172 error_check_good dbc_get_both:dupfailure [llength $ret] 0 173 set ret [$dbc get -get_both_range $str $datastr] 174 error_check_good dbc_get_both_range [llength $ret] 0 175} 176