proc test095 { method {tnum "095"} args } {
source ./include.tcl
global is_je_test
global is_qnx_test
set args [convert_args $method $args]
set omethod [convert_method $method]
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"
if { $is_qnx_test } {
puts "Test$tnum skipping for QNX"
return
}
if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } {
puts "Test$tnum skipping for method $method"
return
}
set nsets 300
set noverflows 25
foreach { dflag sort } { -dup unsorted {-dup -dupsort} sorted } {
if { $is_je_test && $sort == "unsorted" } {
continue
}
set testfile $basename-$sort.db
set did [open $dict]
puts "\tTest$tnum.a:\
Creating database with $nsets sets of $sort dups."
set dargs "$dflag $carg $args"
set db [eval {berkdb_open_noerr -create} \
$omethod $dargs $testfile]
error_check_good db_open [is_valid_db $db] TRUE
t95_populate $db $did $nsets 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 } {
t95_gettest $db $tnum b $smallbuf 1
} else {
puts "Skipping small buffer test Test$tnum.b"
}
t95_gettest $db $tnum c $bigbuf 0
if { $pagesize > 1024 } {
t95_cgettest $db $tnum b $smallbuf 1
} else {
puts "Skipping small buffer test Test$tnum.d"
}
t95_cgettest $db $tnum e $bigbuf 0
error_check_good db_sync [$db sync] 0
set noerrdb [eval berkdb_open_noerr $dargs $testfile]
t95_flagtest $noerrdb $tnum f [expr 8192]
t95_cflagtest $noerrdb $tnum g [expr 100]
error_check_good noerrdb_close [$noerrdb close] 0
set max [expr 4096 * $noverflows]
puts "\tTest$tnum.h: Add $noverflows overflow sets\
to database (max item size $max)"
t95_populate $db $did $noverflows 4096
t95_gettest $db $tnum i $bigbuf 1
t95_gettest $db $tnum j [expr $bigbuf * 2] 1
t95_gettest $db $tnum k [expr $max * $noverflows * 2] 0
t95_cgettest $db $tnum l $bigbuf 1
t95_cgettest $db $tnum m [expr ($max + 512) * 2] 0
error_check_good db_close [$db close] 0
close $did
}
}
proc t95_gettest { db tnum letter bufsize expectfail } {
t95_gettest_body $db $tnum $letter $bufsize $expectfail 0
}
proc t95_cgettest { db tnum letter bufsize expectfail } {
t95_gettest_body $db $tnum $letter $bufsize $expectfail 1
}
proc t95_flagtest { db tnum letter bufsize } {
t95_flagtest_body $db $tnum $letter $bufsize 0
}
proc t95_cflagtest { db tnum letter bufsize } {
t95_flagtest_body $db $tnum $letter $bufsize 1
}
proc t95_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 -nextnodup] } {
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\
-nextdup} tres]} {
eval lappend res $tres
}
}
if { $expectfail != 0 && $ret != 0 } {
if { [is_substr $errorCode DB_BUFFER_SMALL] != 1 && \
[is_substr $errorCode EINVAL] != 1 } {
error_check_good \
"$flag failure errcode" \
$errorCode "DB_BUFFER_SMALL or EINVAL"
}
set allpassed FALSE
continue
}
error_check_good "get_$flag ($key)" $ret 0
if { $flag == "multi_key" } {
t95_verify $res TRUE
} else {
t95_verify $res FALSE
}
}
set ret [catch {eval $db get -$flag $bufsize} res]
if { $expectfail == 1 } {
error_check_good allpassed $allpassed FALSE
puts "\t\tTest$tnum.$letter:\
returned at least one DB_BUFFER_SMALL (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 t95_flagtest_body { db tnum letter bufsize 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"
}
puts "\tTest$tnum.$letter: $action with invalid flag combinations"
if { $usecursor != 0 } {
set getcurs [$db cursor]
error_check_good getcurs [is_valid_cursor $getcurs $db] TRUE
}
if { $usecursor == 0 } {
set badflags [list consume consume_wait {rmw some_key}]
foreach badflag $badflags {
catch {eval $db get -$flag $bufsize -$badflag} ret
error_check_good \
db:get:$flag:$badflag [is_substr $errorCode EINVAL] 1
}
} else {
set cbadflags [list last get_recno join_item \
{multi_key 1000} prev prevnodup]
set dbc [$db cursor]
$dbc get -first
foreach badflag $cbadflags {
catch {eval $dbc get -$flag $bufsize -$badflag} ret
error_check_good dbc:get:$flag:$badflag \
[is_substr $errorCode EINVAL] 1
}
error_check_good dbc_close [$dbc close] 0
}
if { $usecursor != 0 } {
error_check_good getcurs_close [$getcurs close] 0
}
}
puts "\t\tTest$tnum.$letter completed"
}
proc t95_verify { res multiple_keys } {
global alphabet
set i 0
set orig_key [lindex [lindex $res 0] 0]
set nkeys [string trim $orig_key $alphabet']
set base_key [string trim $orig_key 0123456789]
set datum_count 0
while { 1 } {
set key [lindex [lindex $res $i] 0]
set datum [lindex [lindex $res $i] 1]
if { $datum_count >= $nkeys } {
if { [llength $key] != 0 } {
error_check_bad "keys beyond number $i allowed"\
$multiple_keys FALSE
set orig_key $key
set nkeys [eval string trim \
$orig_key {$alphabet'}]
set base_key [eval string trim \
$orig_key 0123456789]
set datum_count 0
} else {
return
}
}
error_check_good returned_key($i) $key $orig_key
error_check_good returned_datum($i) \
$datum $base_key.[format %4u $datum_count]
incr datum_count
incr i
}
}
proc t95_populate { db did nsets pad_bytes } {
set txn ""
for { set i 1 } { $i <= $nsets } { incr i } {
gets $did basekey
append basekey [repeat "a" [expr $pad_bytes * $i]]
set key $basekey$i
for { set j 0 } { $j < $i } { incr j } {
set data $basekey.[format %4u $j]
error_check_good db_put($key,$data) \
[eval {$db put} $txn {$key $data}] 0
}
}
error_check_good db_sync [$db sync] 0
}