proc test102 { method {nsets 1000} {tnum "102"} args } {
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
if { [is_rbtree $method] == 1 || [is_record_based $method] == 0} {
puts "Test$tnum skipping for method $method"
return
}
set txnenv 0
set eindex [lsearch -exact $args "-env"]
if { $eindex == -1 } {
set basename $testdir/test$tnum
set env NULL
set carg { -cachesize {0 25000000 0} }
} else {
set basename test$tnum
incr eindex
set env [lindex $args $eindex]
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
puts "Skipping for environment with txns"
return
}
set testdir [get_home $env]
set carg {}
}
cleanup $testdir $env
puts "Test$tnum: $method ($args) Bulk get test"
puts "\tTest$tnum.a: Creating $method database\
with $nsets entries."
set dargs "$carg $args"
set testfile $basename.db
set db [eval {berkdb_open_noerr -create} $omethod $dargs $testfile]
error_check_good db_open [is_valid_db $db] TRUE
t102_populate $db $method $nsets $txnenv 0
set stat [$db stat]
set pagesize [get_pagesize $stat]
set maxpage [expr 1024 * 64]
set bigbuf [expr $maxpage + 1024]
set smallbuf 1024
if { $pagesize > 1024 } {
t102_gettest $db $tnum b $smallbuf 1
} else {
puts "Skipping Test$tnum.b for small pagesize."
}
t102_gettest $db $tnum c $bigbuf 0
if { $pagesize > 1024 } {
t102_gettest $db $tnum d $smallbuf 1
} else {
puts "Skipping Test$tnum.b for small pagesize."
}
t102_cgettest $db $tnum e $bigbuf 0
if { [is_fixed_length $method] == 1 } {
puts "Skipping overflow tests for fixed-length method $omethod."
} else {
puts "\tTest$tnum.f: Growing database with overflow sets"
t102_populate $db $method [expr $nsets / 100] $txnenv 10000
t102_gettest $db $tnum g $bigbuf 1
t102_gettest $db $tnum h [expr $bigbuf * 2] 0
t102_cgettest $db $tnum i 8192 1
t102_cgettest $db $tnum j $bigbuf 0
}
error_check_good db_close [$db close] 0
}
proc t102_gettest { db tnum letter bufsize expectfail } {
t102_gettest_body $db $tnum $letter $bufsize $expectfail 0
}
proc t102_cgettest { db tnum letter bufsize expectfail } {
t102_gettest_body $db $tnum $letter $bufsize $expectfail 1
}
proc t102_gettest_body { db tnum letter bufsize expectfail usecursor } {
global errorCode
foreach flag { multi multi_key } {
if { $usecursor == 0 } {
if { $flag == "multi_key" } {
continue
} else {
set action "db get -$flag"
}
} else {
set action "dbc get -$flag -set/-next"
}
puts "\tTest$tnum.$letter: $action with bufsize $bufsize"
set allpassed TRUE
set saved_err ""
if { $usecursor != 0 } {
set getcurs [$db cursor]
error_check_good \
getcurs [is_valid_cursor $getcurs $db] TRUE
}
set dbc [$db cursor]
error_check_good is_valid_dbc [is_valid_cursor $dbc $db] TRUE
for { set dbt [$dbc get -first] } { [llength $dbt] != 0 } \
{ set dbt [$dbc get -next] } {
set key [lindex [lindex $dbt 0] 0]
set datum [lindex [lindex $dbt 0] 1]
if { $usecursor == 0 } {
set ret [catch \
{eval $db get -$flag $bufsize $key} res]
} else {
set res {}
for { set ret [catch {eval $getcurs get\
-$flag $bufsize -set $key} tres] } \
{ $ret == 0 && [llength $tres] != 0 } \
{ set ret [catch {eval $getcurs get\
-$flag $bufsize -next} tres]} {
eval lappend res $tres
}
}
if { $expectfail != 0 && $ret != 0 } {
if { [is_substr $errorCode ENOMEM] != 1 && \
[is_substr $errorCode EINVAL] != 1 } {
error_check_good \
"$flag failure errcode" \
$errorCode "ENOMEM or EINVAL"
}
set allpassed FALSE
continue
}
error_check_good "get_$flag ($key)" $ret 0
}
if { $expectfail == 1 } {
error_check_good allpassed $allpassed FALSE
puts "\t\tTest$tnum.$letter:\
returned at least one ENOMEM (as expected)"
} else {
error_check_good allpassed $allpassed TRUE
puts "\t\tTest$tnum.$letter: succeeded (as expected)"
}
error_check_good dbc_close [$dbc close] 0
if { $usecursor != 0 } {
error_check_good getcurs_close [$getcurs close] 0
}
}
}
proc t102_populate { db method nentries txnenv pad_bytes } {
source ./include.tcl
set did [open $dict]
set count 0
set txn ""
set pflags ""
set gflags " -recno "
while { [gets $did str] != -1 && $count < $nentries } {
set key [expr $count + 1]
set datastr $str
if { [is_fixed_length $method] == 0 } {
append datastr [repeat "a" $pad_bytes]
}
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
set ret [eval {$db put} \
$txn $pflags {$key [chop_data $method $datastr]}]
error_check_good put $ret 0
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
set ret [eval {$db get} $gflags {$key}]
error_check_good $key:dbget [llength $ret] 1
incr count
}
close $did
error_check_good db_sync [$db sync] 0
}