1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test021.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test021 8# TEST Btree range tests. 9# TEST 10# TEST Use the first 10,000 entries from the dictionary. 11# TEST Insert each with self, reversed as key and self as data. 12# TEST After all are entered, retrieve each using a cursor SET_RANGE, and 13# TEST getting about 20 keys sequentially after it (in some cases we'll 14# TEST run out towards the end of the file). 15proc test021 { method {nentries 10000} args } { 16 source ./include.tcl 17 18 set args [convert_args $method $args] 19 set omethod [convert_method $method] 20 21 # Create the database and open the dictionary 22 set txnenv 0 23 set eindex [lsearch -exact $args "-env"] 24 # 25 # If we are using an env, then testfile should just be the db name. 26 # Otherwise it is the test directory and the name. 27 if { $eindex == -1 } { 28 set testfile $testdir/test021.db 29 set env NULL 30 } else { 31 set testfile test021.db 32 incr eindex 33 set env [lindex $args $eindex] 34 set txnenv [is_txnenv $env] 35 if { $txnenv == 1 } { 36 append args " -auto_commit " 37 # 38 # If we are using txns and running with the 39 # default, set the default down a bit. 40 # 41 if { $nentries == 10000 } { 42 set nentries 100 43 } 44 } 45 set testdir [get_home $env] 46 } 47 puts "Test021: $method ($args) $nentries equal key/data pairs" 48 49 set t1 $testdir/t1 50 set t2 $testdir/t2 51 set t3 $testdir/t3 52 cleanup $testdir $env 53 set db [eval {berkdb_open \ 54 -create -mode 0644} $args {$omethod $testfile}] 55 error_check_good dbopen [is_valid_db $db] TRUE 56 57 set did [open $dict] 58 59 set pflags "" 60 set gflags "" 61 set txn "" 62 set count 0 63 64 if { [is_record_based $method] == 1 } { 65 set checkfunc test021_recno.check 66 append gflags " -recno" 67 } else { 68 set checkfunc test021.check 69 } 70 puts "\tTest021.a: put loop" 71 # Here is the loop where we put each key/data pair 72 while { [gets $did str] != -1 && $count < $nentries } { 73 if { [is_record_based $method] == 1 } { 74 global kvals 75 76 set key [expr $count + 1] 77 set kvals($key) [pad_data $method $str] 78 } else { 79 set key [reverse $str] 80 } 81 82 if { $txnenv == 1 } { 83 set t [$env txn] 84 error_check_good txn [is_valid_txn $t $env] TRUE 85 set txn "-txn $t" 86 } 87 set r [eval {$db put} \ 88 $txn $pflags {$key [chop_data $method $str]}] 89 error_check_good db_put $r 0 90 if { $txnenv == 1 } { 91 error_check_good txn [$t commit] 0 92 } 93 incr count 94 } 95 close $did 96 97 # Now we will get each key from the DB and retrieve about 20 98 # records after it. 99 error_check_good db_close [$db close] 0 100 101 puts "\tTest021.b: test ranges" 102 set db [eval {berkdb_open -rdonly} $args $omethod $testfile ] 103 error_check_good dbopen [is_valid_db $db] TRUE 104 105 # Open a cursor 106 if { $txnenv == 1 } { 107 set t [$env txn] 108 error_check_good txn [is_valid_txn $t $env] TRUE 109 set txn "-txn $t" 110 } 111 set dbc [eval {$db cursor} $txn] 112 error_check_good db_cursor [is_substr $dbc $db] 1 113 114 set did [open $dict] 115 set i 0 116 while { [gets $did str] != -1 && $i < $count } { 117 if { [is_record_based $method] == 1 } { 118 set key [expr $i + 1] 119 } else { 120 set key [reverse $str] 121 } 122 123 set r [$dbc get -set_range $key] 124 error_check_bad dbc_get:$key [string length $r] 0 125 set k [lindex [lindex $r 0] 0] 126 set d [lindex [lindex $r 0] 1] 127 $checkfunc $k $d 128 129 for { set nrecs 0 } { $nrecs < 20 } { incr nrecs } { 130 set r [$dbc get "-next"] 131 # no error checking because we may run off the end 132 # of the database 133 if { [llength $r] == 0 } { 134 continue; 135 } 136 set k [lindex [lindex $r 0] 0] 137 set d [lindex [lindex $r 0] 1] 138 $checkfunc $k $d 139 } 140 incr i 141 } 142 error_check_good dbc_close [$dbc close] 0 143 if { $txnenv == 1 } { 144 error_check_good txn [$t commit] 0 145 } 146 error_check_good db_close [$db close] 0 147 close $did 148} 149 150# Check function for test021; keys and data are reversed 151proc test021.check { key data } { 152 error_check_good "key/data mismatch for $key" $data [reverse $key] 153} 154 155proc test021_recno.check { key data } { 156 global dict 157 global kvals 158 159 error_check_good key"$key"_exists [info exists kvals($key)] 1 160 error_check_good "data mismatch: key $key" $data $kvals($key) 161} 162