Import BSDDB 4.7.25 (as of svn r89086)
This commit is contained in:
Zachary Ware
165
test/test083.tcl
Normal file
165
test/test083.tcl
Normal file
@@ -0,0 +1,165 @@
|
||||
# See the file LICENSE for redistribution information.
|
||||
#
|
||||
# Copyright (c) 2000,2008 Oracle. All rights reserved.
|
||||
#
|
||||
# $Id: test083.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
|
||||
#
|
||||
# TEST test083
|
||||
# TEST Test of DB->key_range.
|
||||
proc test083 { method {pgsz 512} {maxitems 5000} {step 2} args} {
|
||||
source ./include.tcl
|
||||
|
||||
global rand_init
|
||||
error_check_good set_random_seed [berkdb srand $rand_init] 0
|
||||
|
||||
set omethod [convert_method $method]
|
||||
set args [convert_args $method $args]
|
||||
|
||||
puts "Test083 $method ($args): Test of DB->key_range"
|
||||
if { [is_btree $method] != 1 } {
|
||||
puts "\tTest083: Skipping for method $method."
|
||||
return
|
||||
}
|
||||
set pgindex [lsearch -exact $args "-pagesize"]
|
||||
if { $pgindex != -1 } {
|
||||
puts "Test083: skipping for specific pagesizes"
|
||||
return
|
||||
}
|
||||
|
||||
# If we are using an env, then testfile should just be the db name.
|
||||
# Otherwise it is the test directory and the name.
|
||||
set txnenv 0
|
||||
set eindex [lsearch -exact $args "-env"]
|
||||
if { $eindex == -1 } {
|
||||
set testfile $testdir/test083.db
|
||||
set env NULL
|
||||
} else {
|
||||
set testfile test083.db
|
||||
incr eindex
|
||||
set env [lindex $args $eindex]
|
||||
set txnenv [is_txnenv $env]
|
||||
if { $txnenv == 1 } {
|
||||
append args " -auto_commit "
|
||||
}
|
||||
set testdir [get_home $env]
|
||||
}
|
||||
|
||||
# We assume that numbers will be at most six digits wide
|
||||
error_check_bad maxitems_range [expr $maxitems > 999999] 1
|
||||
|
||||
# We want to test key_range on a variety of sizes of btree.
|
||||
# Start at ten keys and work up to $maxitems keys, at each step
|
||||
# multiplying the number of keys by $step.
|
||||
for { set nitems 10 } { $nitems <= $maxitems }\
|
||||
{ set nitems [expr $nitems * $step] } {
|
||||
|
||||
puts "\tTest083.a: Opening new database"
|
||||
if { $env != "NULL"} {
|
||||
set testdir [get_home $env]
|
||||
}
|
||||
cleanup $testdir $env
|
||||
set db [eval {berkdb_open -create -mode 0644} \
|
||||
-pagesize $pgsz $omethod $args $testfile]
|
||||
error_check_good dbopen [is_valid_db $db] TRUE
|
||||
|
||||
t83_build $db $nitems $env $txnenv
|
||||
t83_test $db $nitems $env $txnenv
|
||||
|
||||
error_check_good db_close [$db close] 0
|
||||
}
|
||||
}
|
||||
|
||||
proc t83_build { db nitems env txnenv } {
|
||||
source ./include.tcl
|
||||
|
||||
puts "\tTest083.b: Populating database with $nitems keys"
|
||||
|
||||
set keylist {}
|
||||
puts "\t\tTest083.b.1: Generating key list"
|
||||
for { set i 0 } { $i < $nitems } { incr i } {
|
||||
lappend keylist $i
|
||||
}
|
||||
|
||||
# With randomly ordered insertions, the range of errors we
|
||||
# get from key_range can be unpredictably high [#2134]. For now,
|
||||
# just skip the randomization step.
|
||||
#puts "\t\tTest083.b.2: Randomizing key list"
|
||||
#set keylist [randomize_list $keylist]
|
||||
#puts "\t\tTest083.b.3: Populating database with randomized keys"
|
||||
|
||||
puts "\t\tTest083.b.2: Populating database"
|
||||
set data [repeat . 50]
|
||||
set txn ""
|
||||
foreach keynum $keylist {
|
||||
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 {key[format %6d $keynum] $data}]
|
||||
error_check_good db_put $ret 0
|
||||
if { $txnenv == 1 } {
|
||||
error_check_good txn [$t commit] 0
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc t83_test { db nitems env txnenv } {
|
||||
# Look at the first key, then at keys about 1/4, 1/2, 3/4, and
|
||||
# all the way through the database. Make sure the key_ranges
|
||||
# aren't off by more than 10%.
|
||||
|
||||
if { $txnenv == 1 } {
|
||||
set t [$env txn]
|
||||
error_check_good txn [is_valid_txn $t $env] TRUE
|
||||
set txn "-txn $t"
|
||||
} else {
|
||||
set txn ""
|
||||
}
|
||||
set dbc [eval {$db cursor} $txn]
|
||||
error_check_good dbc [is_valid_cursor $dbc $db] TRUE
|
||||
|
||||
puts "\tTest083.c: Verifying ranges..."
|
||||
|
||||
for { set i 0 } { $i < $nitems } \
|
||||
{ incr i [expr $nitems / [berkdb random_int 3 16]] } {
|
||||
puts "\t\t...key $i"
|
||||
error_check_bad key0 [llength [set dbt [$dbc get -first]]] 0
|
||||
|
||||
for { set j 0 } { $j < $i } { incr j } {
|
||||
error_check_bad key$j \
|
||||
[llength [set dbt [$dbc get -next]]] 0
|
||||
}
|
||||
|
||||
set ranges [$db keyrange [lindex [lindex $dbt 0] 0]]
|
||||
|
||||
#puts $ranges
|
||||
error_check_good howmanyranges [llength $ranges] 3
|
||||
|
||||
set lessthan [lindex $ranges 0]
|
||||
set morethan [lindex $ranges 2]
|
||||
|
||||
set rangesum [expr $lessthan + [lindex $ranges 1] + $morethan]
|
||||
|
||||
roughly_equal $rangesum 1 0.05
|
||||
|
||||
# Wild guess.
|
||||
if { $nitems < 500 } {
|
||||
set tol 0.3
|
||||
} elseif { $nitems > 500 } {
|
||||
set tol 0.15
|
||||
}
|
||||
|
||||
roughly_equal $lessthan [expr $i * 1.0 / $nitems] $tol
|
||||
|
||||
}
|
||||
|
||||
error_check_good dbc_close [$dbc close] 0
|
||||
if { $txnenv == 1 } {
|
||||
error_check_good txn [$t commit] 0
|
||||
}
|
||||
}
|
||||
|
||||
proc roughly_equal { a b tol } {
|
||||
error_check_good "$a =~ $b" [expr $a - $b < $tol] 1
|
||||
}
|
||||
Reference in New Issue
Block a user