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