1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 2000,2008 Oracle. All rights reserved. 4# 5# $Id: test083.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test083 8# TEST Test of DB->key_range. 9proc test083 { method {pgsz 512} {maxitems 5000} {step 2} args} { 10 source ./include.tcl 11 12 global rand_init 13 error_check_good set_random_seed [berkdb srand $rand_init] 0 14 15 set omethod [convert_method $method] 16 set args [convert_args $method $args] 17 18 puts "Test083 $method ($args): Test of DB->key_range" 19 if { [is_btree $method] != 1 } { 20 puts "\tTest083: Skipping for method $method." 21 return 22 } 23 set pgindex [lsearch -exact $args "-pagesize"] 24 if { $pgindex != -1 } { 25 puts "Test083: skipping for specific pagesizes" 26 return 27 } 28 29 # If we are using an env, then testfile should just be the db name. 30 # Otherwise it is the test directory and the name. 31 set txnenv 0 32 set eindex [lsearch -exact $args "-env"] 33 if { $eindex == -1 } { 34 set testfile $testdir/test083.db 35 set env NULL 36 } else { 37 set testfile test083.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 set testdir [get_home $env] 45 } 46 47 # We assume that numbers will be at most six digits wide 48 error_check_bad maxitems_range [expr $maxitems > 999999] 1 49 50 # We want to test key_range on a variety of sizes of btree. 51 # Start at ten keys and work up to $maxitems keys, at each step 52 # multiplying the number of keys by $step. 53 for { set nitems 10 } { $nitems <= $maxitems }\ 54 { set nitems [expr $nitems * $step] } { 55 56 puts "\tTest083.a: Opening new database" 57 if { $env != "NULL"} { 58 set testdir [get_home $env] 59 } 60 cleanup $testdir $env 61 set db [eval {berkdb_open -create -mode 0644} \ 62 -pagesize $pgsz $omethod $args $testfile] 63 error_check_good dbopen [is_valid_db $db] TRUE 64 65 t83_build $db $nitems $env $txnenv 66 t83_test $db $nitems $env $txnenv 67 68 error_check_good db_close [$db close] 0 69 } 70} 71 72proc t83_build { db nitems env txnenv } { 73 source ./include.tcl 74 75 puts "\tTest083.b: Populating database with $nitems keys" 76 77 set keylist {} 78 puts "\t\tTest083.b.1: Generating key list" 79 for { set i 0 } { $i < $nitems } { incr i } { 80 lappend keylist $i 81 } 82 83 # With randomly ordered insertions, the range of errors we 84 # get from key_range can be unpredictably high [#2134]. For now, 85 # just skip the randomization step. 86 #puts "\t\tTest083.b.2: Randomizing key list" 87 #set keylist [randomize_list $keylist] 88 #puts "\t\tTest083.b.3: Populating database with randomized keys" 89 90 puts "\t\tTest083.b.2: Populating database" 91 set data [repeat . 50] 92 set txn "" 93 foreach keynum $keylist { 94 if { $txnenv == 1 } { 95 set t [$env txn] 96 error_check_good txn [is_valid_txn $t $env] TRUE 97 set txn "-txn $t" 98 } 99 set ret [eval {$db put} $txn {key[format %6d $keynum] $data}] 100 error_check_good db_put $ret 0 101 if { $txnenv == 1 } { 102 error_check_good txn [$t commit] 0 103 } 104 } 105} 106 107proc t83_test { db nitems env txnenv } { 108 # Look at the first key, then at keys about 1/4, 1/2, 3/4, and 109 # all the way through the database. Make sure the key_ranges 110 # aren't off by more than 10%. 111 112 if { $txnenv == 1 } { 113 set t [$env txn] 114 error_check_good txn [is_valid_txn $t $env] TRUE 115 set txn "-txn $t" 116 } else { 117 set txn "" 118 } 119 set dbc [eval {$db cursor} $txn] 120 error_check_good dbc [is_valid_cursor $dbc $db] TRUE 121 122 puts "\tTest083.c: Verifying ranges..." 123 124 for { set i 0 } { $i < $nitems } \ 125 { incr i [expr $nitems / [berkdb random_int 3 16]] } { 126 puts "\t\t...key $i" 127 error_check_bad key0 [llength [set dbt [$dbc get -first]]] 0 128 129 for { set j 0 } { $j < $i } { incr j } { 130 error_check_bad key$j \ 131 [llength [set dbt [$dbc get -next]]] 0 132 } 133 134 set ranges [$db keyrange [lindex [lindex $dbt 0] 0]] 135 136 #puts $ranges 137 error_check_good howmanyranges [llength $ranges] 3 138 139 set lessthan [lindex $ranges 0] 140 set morethan [lindex $ranges 2] 141 142 set rangesum [expr $lessthan + [lindex $ranges 1] + $morethan] 143 144 roughly_equal $rangesum 1 0.05 145 146 # Wild guess. 147 if { $nitems < 500 } { 148 set tol 0.3 149 } elseif { $nitems > 500 } { 150 set tol 0.15 151 } 152 153 roughly_equal $lessthan [expr $i * 1.0 / $nitems] $tol 154 155 } 156 157 error_check_good dbc_close [$dbc close] 0 158 if { $txnenv == 1 } { 159 error_check_good txn [$t commit] 0 160 } 161} 162 163proc roughly_equal { a b tol } { 164 error_check_good "$a =~ $b" [expr $a - $b < $tol] 1 165} 166