1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 2000,2008 Oracle. All rights reserved. 4# 5# $Id: test102.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test102 8# TEST Bulk get test for record-based methods. [#2934] 9proc test102 { method {nsets 1000} {tnum "102"} args } { 10 source ./include.tcl 11 set args [convert_args $method $args] 12 set omethod [convert_method $method] 13 14 if { [is_rbtree $method] == 1 || [is_record_based $method] == 0} { 15 puts "Test$tnum skipping for method $method" 16 return 17 } 18 19 set txnenv 0 20 set eindex [lsearch -exact $args "-env"] 21 # 22 # If we are using an env, then testfile should just be the db name. 23 # Otherwise it is the test directory and the name. 24 if { $eindex == -1 } { 25 set basename $testdir/test$tnum 26 set env NULL 27 # If we've our own env, no reason to swap--this isn't 28 # an mpool test. 29 set carg { -cachesize {0 25000000 0} } 30 } else { 31 set basename test$tnum 32 incr eindex 33 set env [lindex $args $eindex] 34 set txnenv [is_txnenv $env] 35 if { $txnenv == 1 } { 36 puts "Skipping for environment with txns" 37 return 38 } 39 set testdir [get_home $env] 40 set carg {} 41 } 42 cleanup $testdir $env 43 44 puts "Test$tnum: $method ($args) Bulk get test" 45 46 # Open and populate the database. 47 puts "\tTest$tnum.a: Creating $method database\ 48 with $nsets entries." 49 set dargs "$carg $args" 50 set testfile $basename.db 51 set db [eval {berkdb_open_noerr -create} $omethod $dargs $testfile] 52 error_check_good db_open [is_valid_db $db] TRUE 53 t102_populate $db $method $nsets $txnenv 0 54 55 # Determine the pagesize so we can use it to size the buffer. 56 set stat [$db stat] 57 set pagesize [get_pagesize $stat] 58 59 # Run get tests. The gettest should succeed as long as 60 # the buffer is at least as large as the page size. Test for 61 # failure of a small buffer unless the page size is so small 62 # we can't define a smaller buffer (buffers must be multiples 63 # of 1024). A "big buffer" should succeed in all cases because 64 # we define it to be larger than 65536, the largest page 65 # currently allowed. 66 set maxpage [expr 1024 * 64] 67 set bigbuf [expr $maxpage + 1024] 68 set smallbuf 1024 69 70 # Run regular db->get tests. 71 if { $pagesize > 1024 } { 72 t102_gettest $db $tnum b $smallbuf 1 73 } else { 74 puts "Skipping Test$tnum.b for small pagesize." 75 } 76 t102_gettest $db $tnum c $bigbuf 0 77 78 # Run cursor get tests. 79 if { $pagesize > 1024 } { 80 t102_gettest $db $tnum d $smallbuf 1 81 } else { 82 puts "Skipping Test$tnum.b for small pagesize." 83 } 84 t102_cgettest $db $tnum e $bigbuf 0 85 86 if { [is_fixed_length $method] == 1 } { 87 puts "Skipping overflow tests for fixed-length method $omethod." 88 } else { 89 90 # Set up for overflow tests 91 puts "\tTest$tnum.f: Growing database with overflow sets" 92 t102_populate $db $method [expr $nsets / 100] $txnenv 10000 93 94 # Run overflow get tests. Test should fail for overflow pages 95 # with our standard big buffer but succeed at twice that size. 96 t102_gettest $db $tnum g $bigbuf 1 97 t102_gettest $db $tnum h [expr $bigbuf * 2] 0 98 99 # Run overflow cursor get tests. Test will fail for overflow 100 # pages with 8K buffer but succeed with a large buffer. 101 t102_cgettest $db $tnum i 8192 1 102 t102_cgettest $db $tnum j $bigbuf 0 103 } 104 error_check_good db_close [$db close] 0 105} 106 107proc t102_gettest { db tnum letter bufsize expectfail } { 108 t102_gettest_body $db $tnum $letter $bufsize $expectfail 0 109} 110proc t102_cgettest { db tnum letter bufsize expectfail } { 111 t102_gettest_body $db $tnum $letter $bufsize $expectfail 1 112} 113 114# Basic get test 115proc t102_gettest_body { db tnum letter bufsize expectfail usecursor } { 116 global errorCode 117 118 foreach flag { multi multi_key } { 119 if { $usecursor == 0 } { 120 if { $flag == "multi_key" } { 121 # db->get does not allow multi_key 122 continue 123 } else { 124 set action "db get -$flag" 125 } 126 } else { 127 set action "dbc get -$flag -set/-next" 128 } 129 puts "\tTest$tnum.$letter: $action with bufsize $bufsize" 130 131 set allpassed TRUE 132 set saved_err "" 133 134 # Cursor for $usecursor. 135 if { $usecursor != 0 } { 136 set getcurs [$db cursor] 137 error_check_good \ 138 getcurs [is_valid_cursor $getcurs $db] TRUE 139 } 140 141 # Traverse DB with cursor; do get/c_get($flag) on each item. 142 set dbc [$db cursor] 143 error_check_good is_valid_dbc [is_valid_cursor $dbc $db] TRUE 144 for { set dbt [$dbc get -first] } { [llength $dbt] != 0 } \ 145 { set dbt [$dbc get -next] } { 146 set key [lindex [lindex $dbt 0] 0] 147 set datum [lindex [lindex $dbt 0] 1] 148 149 if { $usecursor == 0 } { 150 set ret [catch \ 151 {eval $db get -$flag $bufsize $key} res] 152 } else { 153 set res {} 154 for { set ret [catch {eval $getcurs get\ 155 -$flag $bufsize -set $key} tres] } \ 156 { $ret == 0 && [llength $tres] != 0 } \ 157 { set ret [catch {eval $getcurs get\ 158 -$flag $bufsize -next} tres]} { 159 eval lappend res $tres 160 } 161 } 162 163 # If we expect a failure, be more tolerant if the above 164 # fails; just make sure it's a DB_BUFFER_SMALL or an 165 # EINVAL (if the buffer is smaller than the pagesize, 166 # it's EINVAL), mark it, and move along. 167 if { $expectfail != 0 && $ret != 0 } { 168 if { [is_substr $errorCode DB_BUFFER_SMALL] != 1 && \ 169 [is_substr $errorCode EINVAL] != 1 } { 170 error_check_good \ 171 "$flag failure errcode" \ 172 $errorCode "DB_BUFFER_SMALL or EINVAL" 173 } 174 set allpassed FALSE 175 continue 176 } 177 error_check_good "get_$flag ($key)" $ret 0 178 } 179 180 if { $expectfail == 1 } { 181 error_check_good allpassed $allpassed FALSE 182 puts "\t\tTest$tnum.$letter:\ 183 returned at least one DB_BUFFER_SMALL (as expected)" 184 } else { 185 error_check_good allpassed $allpassed TRUE 186 puts "\t\tTest$tnum.$letter: succeeded (as expected)" 187 } 188 189 error_check_good dbc_close [$dbc close] 0 190 if { $usecursor != 0 } { 191 error_check_good getcurs_close [$getcurs close] 0 192 } 193 } 194} 195 196proc t102_populate { db method nentries txnenv pad_bytes } { 197 source ./include.tcl 198 199 set did [open $dict] 200 set count 0 201 set txn "" 202 set pflags "" 203 set gflags " -recno " 204 205 while { [gets $did str] != -1 && $count < $nentries } { 206 set key [expr $count + 1] 207 set datastr $str 208 # Create overflow pages only if method is not fixed-length. 209 if { [is_fixed_length $method] == 0 } { 210 append datastr [repeat "a" $pad_bytes] 211 } 212 if { $txnenv == 1 } { 213 set t [$env txn] 214 error_check_good txn [is_valid_txn $t $env] TRUE 215 set txn "-txn $t" 216 } 217 set ret [eval {$db put} \ 218 $txn $pflags {$key [chop_data $method $datastr]}] 219 error_check_good put $ret 0 220 if { $txnenv == 1 } { 221 error_check_good txn [$t commit] 0 222 } 223 224 set ret [eval {$db get} $gflags {$key}] 225 error_check_good $key:dbget [llength $ret] 1 226 incr count 227 } 228 close $did 229 230 # This will make debugging easier, and since the database is 231 # read-only from here out, it's cheap. 232 error_check_good db_sync [$db sync] 0 233} 234 235