1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test024.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test024 8# TEST Record number retrieval test. 9# TEST Test the Btree and Record number get-by-number functionality. 10proc test024 { method {nentries 10000} args} { 11 source ./include.tcl 12 global rand_init 13 14 set do_renumber [is_rrecno $method] 15 set args [convert_args $method $args] 16 set omethod [convert_method $method] 17 18 puts "Test024: $method ($args)" 19 20 if { [string compare $omethod "-hash"] == 0 } { 21 puts "Test024 skipping for method HASH" 22 return 23 } 24 25 berkdb srand $rand_init 26 27 # Create the database and open the dictionary 28 set txnenv 0 29 set eindex [lsearch -exact $args "-env"] 30 # 31 # If we are using an env, then testfile should just be the db name. 32 # Otherwise it is the test directory and the name. 33 if { $eindex == -1 } { 34 set testfile $testdir/test024.db 35 set env NULL 36 } else { 37 set testfile test024.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 # If we are using txns and running with the 45 # default, set the default down a bit. 46 # 47 if { $nentries == 10000 } { 48 set nentries 100 49 } 50 } 51 set testdir [get_home $env] 52 } 53 set t1 $testdir/t1 54 set t2 $testdir/t2 55 set t3 $testdir/t3 56 57 cleanup $testdir $env 58 59 # Read the first nentries dictionary elements and reverse them. 60 # Keep a list of these (these will be the keys). 61 puts "\tTest024.a: initialization" 62 set keys "" 63 set did [open $dict] 64 set count 0 65 while { [gets $did str] != -1 && $count < $nentries } { 66 lappend keys [reverse $str] 67 incr count 68 } 69 close $did 70 71 # Generate sorted order for the keys 72 set sorted_keys [lsort $keys] 73 # Create the database 74 if { [string compare $omethod "-btree"] == 0 } { 75 set db [eval {berkdb_open -create \ 76 -mode 0644 -recnum} $args {$omethod $testfile}] 77 error_check_good dbopen [is_valid_db $db] TRUE 78 } else { 79 set db [eval {berkdb_open -create \ 80 -mode 0644} $args {$omethod $testfile}] 81 error_check_good dbopen [is_valid_db $db] TRUE 82 } 83 84 set pflags "" 85 set gflags "" 86 set txn "" 87 88 if { [is_record_based $method] == 1 } { 89 set gflags " -recno" 90 } 91 92 puts "\tTest024.b: put/get loop" 93 foreach k $keys { 94 if { [is_record_based $method] == 1 } { 95 set key [lsearch $sorted_keys $k] 96 incr key 97 } else { 98 set key $k 99 } 100 if { $txnenv == 1 } { 101 set t [$env txn] 102 error_check_good txn [is_valid_txn $t $env] TRUE 103 set txn "-txn $t" 104 } 105 set ret [eval {$db put} \ 106 $txn $pflags {$key [chop_data $method $k]}] 107 error_check_good put $ret 0 108 set ret [eval {$db get} $txn $gflags {$key}] 109 error_check_good \ 110 get $ret [list [list $key [pad_data $method $k]]] 111 if { $txnenv == 1 } { 112 error_check_good txn [$t commit] 0 113 } 114 } 115 116 # Now we will get each key from the DB and compare the results 117 # to the original. 118 puts "\tTest024.c: dump file" 119 120 # Put sorted keys in file 121 set oid [open $t1 w] 122 foreach k $sorted_keys { 123 puts $oid [pad_data $method $k] 124 } 125 close $oid 126 127 # Instead of using dump_file; get all the keys by keynum 128 set oid [open $t2 w] 129 if { [string compare $omethod "-btree"] == 0 } { 130 set do_renumber 1 131 } 132 133 set gflags " -recno" 134 135 if { $txnenv == 1 } { 136 set t [$env txn] 137 error_check_good txn [is_valid_txn $t $env] TRUE 138 set txn "-txn $t" 139 } 140 for { set k 1 } { $k <= $count } { incr k } { 141 set ret [eval {$db get} $txn $gflags {$k}] 142 puts $oid [lindex [lindex $ret 0] 1] 143 error_check_good recnum_get [lindex [lindex $ret 0] 1] \ 144 [pad_data $method [lindex $sorted_keys [expr $k - 1]]] 145 } 146 close $oid 147 if { $txnenv == 1 } { 148 error_check_good txn [$t commit] 0 149 } 150 error_check_good db_close [$db close] 0 151 152 error_check_good Test024.c:diff($t1,$t2) \ 153 [filecmp $t1 $t2] 0 154 155 # Now, reopen the file and run the last test again. 156 puts "\tTest024.d: close, open, and dump file" 157 set db [eval {berkdb_open -rdonly} $args $testfile] 158 error_check_good dbopen [is_valid_db $db] TRUE 159 set oid [open $t2 w] 160 if { $txnenv == 1 } { 161 set t [$env txn] 162 error_check_good txn [is_valid_txn $t $env] TRUE 163 set txn "-txn $t" 164 } 165 for { set k 1 } { $k <= $count } { incr k } { 166 set ret [eval {$db get} $txn $gflags {$k}] 167 puts $oid [lindex [lindex $ret 0] 1] 168 error_check_good recnum_get [lindex [lindex $ret 0] 1] \ 169 [pad_data $method [lindex $sorted_keys [expr $k - 1]]] 170 } 171 if { $txnenv == 1 } { 172 error_check_good txn [$t commit] 0 173 } 174 close $oid 175 error_check_good db_close [$db close] 0 176 error_check_good Test024.d:diff($t1,$t2) \ 177 [filecmp $t1 $t2] 0 178 179 # Now, reopen the file and run the last test again in reverse direction. 180 puts "\tTest024.e: close, open, and dump file in reverse direction" 181 set db [eval {berkdb_open -rdonly} $args $testfile] 182 error_check_good dbopen [is_valid_db $db] TRUE 183 # Put sorted keys in file 184 set rsorted "" 185 foreach k $sorted_keys { 186 set rsorted [linsert $rsorted 0 $k] 187 } 188 set oid [open $t1 w] 189 foreach k $rsorted { 190 puts $oid [pad_data $method $k] 191 } 192 close $oid 193 194 set oid [open $t2 w] 195 if { $txnenv == 1 } { 196 set t [$env txn] 197 error_check_good txn [is_valid_txn $t $env] TRUE 198 set txn "-txn $t" 199 } 200 for { set k $count } { $k > 0 } { incr k -1 } { 201 set ret [eval {$db get} $txn $gflags {$k}] 202 puts $oid [lindex [lindex $ret 0] 1] 203 error_check_good recnum_get [lindex [lindex $ret 0] 1] \ 204 [pad_data $method [lindex $sorted_keys [expr $k - 1]]] 205 } 206 if { $txnenv == 1 } { 207 error_check_good txn [$t commit] 0 208 } 209 close $oid 210 error_check_good db_close [$db close] 0 211 error_check_good Test024.e:diff($t1,$t2) \ 212 [filecmp $t1 $t2] 0 213 214 # Now try deleting elements and making sure they work 215 puts "\tTest024.f: delete test" 216 set db [eval {berkdb_open} $args $testfile] 217 error_check_good dbopen [is_valid_db $db] TRUE 218 while { $count > 0 } { 219 set kndx [berkdb random_int 1 $count] 220 set kval [lindex $keys [expr $kndx - 1]] 221 set recno [expr [lsearch $sorted_keys $kval] + 1] 222 223 if { $txnenv == 1 } { 224 set t [$env txn] 225 error_check_good txn [is_valid_txn $t $env] TRUE 226 set txn "-txn $t" 227 } 228 if { [is_record_based $method] == 1 } { 229 set ret [eval {$db del} $txn {$recno}] 230 } else { 231 set ret [eval {$db del} $txn {$kval}] 232 } 233 error_check_good delete $ret 0 234 if { $txnenv == 1 } { 235 error_check_good txn [$t commit] 0 236 } 237 238 # Remove the key from the key list 239 set ndx [expr $kndx - 1] 240 set keys [lreplace $keys $ndx $ndx] 241 242 if { $do_renumber == 1 } { 243 set r [expr $recno - 1] 244 set sorted_keys [lreplace $sorted_keys $r $r] 245 } 246 247 # Check that the keys after it have been renumbered 248 if { $txnenv == 1 } { 249 set t [$env txn] 250 error_check_good txn [is_valid_txn $t $env] TRUE 251 set txn "-txn $t" 252 } 253 if { $do_renumber == 1 && $recno != $count } { 254 set r [expr $recno - 1] 255 set ret [eval {$db get} $txn $gflags {$recno}] 256 error_check_good get_after_del \ 257 [lindex [lindex $ret 0] 1] [lindex $sorted_keys $r] 258 } 259 if { $txnenv == 1 } { 260 error_check_good txn [$t commit] 0 261 } 262 263 # Decrement count 264 incr count -1 265 } 266 error_check_good db_close [$db close] 0 267} 268