1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: test099.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test099 8# TEST 9# TEST Test of DB->get and DBC->c_get with set_recno and get_recno. 10# TEST 11# TEST Populate a small btree -recnum database. 12# TEST After all are entered, retrieve each using -recno with DB->get. 13# TEST Open a cursor and do the same for DBC->c_get with set_recno. 14# TEST Verify that set_recno sets the record number position properly. 15# TEST Verify that get_recno returns the correct record numbers. 16# TEST 17# TEST Using the same database, open 3 cursors and position one at 18# TEST the beginning, one in the middle, and one at the end. Delete 19# TEST by cursor and check that record renumbering is done properly. 20# 21proc test099 { method {nentries 10000} args } { 22 source ./include.tcl 23 24 set args [convert_args $method $args] 25 set omethod [convert_method $method] 26 27 puts "Test099: Test of set_recno and get_recno in DBC->c_get." 28 if { [is_rbtree $method] != 1 } { 29 puts "Test099: skipping for method $method." 30 return 31 } 32 33 set txnenv 0 34 set eindex [lsearch -exact $args "-env"] 35 # 36 # If we are using an env, then testfile should just be the db name. 37 # Otherwise it is the test directory and the name. 38 if { $eindex == -1 } { 39 set testfile $testdir/test099.db 40 set env NULL 41 } else { 42 set testfile test099.db 43 incr eindex 44 set env [lindex $args $eindex] 45 set txnenv [is_txnenv $env] 46 if { $txnenv == 1 } { 47 append args " -auto_commit " 48 # 49 # If we are using txns and running with the 50 # default, set the default down a bit. 51 # 52 if { $nentries == 10000 } { 53 set nentries 100 54 } 55 } 56 set testdir [get_home $env] 57 } 58 set t1 $testdir/t1 59 cleanup $testdir $env 60 61 # Create the database and open the dictionary 62 set db [eval {berkdb_open \ 63 -create -mode 0644} $args {$omethod $testfile}] 64 error_check_good dbopen [is_valid_db $db] TRUE 65 66 set did [open $dict] 67 68 set pflags "" 69 set gflags "" 70 set txn "" 71 set count 1 72 73 append gflags " -recno" 74 75 puts "\tTest099.a: put loop" 76 # Here is the loop where we put each key/data pair 77 while { [gets $did str] != -1 && $count <= $nentries } { 78 set key $str 79 if { $txnenv == 1 } { 80 set t [$env txn] 81 error_check_good txn [is_valid_txn $t $env] TRUE 82 set txn "-txn $t" 83 } 84 set r [eval {$db put} \ 85 $txn $pflags {$key [chop_data $method $str]}] 86 error_check_good db_put $r 0 87 if { $txnenv == 1 } { 88 error_check_good txn [$t commit] 0 89 } 90 incr count 91 } 92 close $did 93 94 puts "\tTest099.b: dump file" 95 if { $txnenv == 1 } { 96 set t [$env txn] 97 error_check_good txn [is_valid_txn $t $env] TRUE 98 set txn "-txn $t" 99 } 100 dump_file $db $txn $t1 test099.check 101 if { $txnenv == 1 } { 102 error_check_good txn [$t commit] 0 103 } 104 error_check_good db_close [$db close] 0 105 106 puts "\tTest099.c: Test set_recno then get_recno" 107 set db [eval {berkdb_open -rdonly} $args $omethod $testfile ] 108 error_check_good dbopen [is_valid_db $db] TRUE 109 110 # Open a cursor 111 if { $txnenv == 1 } { 112 set t [$env txn] 113 error_check_good txn [is_valid_txn $t $env] TRUE 114 set txn "-txn $t" 115 } 116 set dbc [eval {$db cursor} $txn] 117 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 118 119 set did [open $t1] 120 set recno 1 121 122 # Create key(recno) array to use for later comparison 123 while { [gets $did str] != -1 } { 124 set kvals($recno) $str 125 incr recno 126 } 127 128 set recno 1 129 set ret [$dbc get -first] 130 error_check_bad dbc_get_first [llength $ret] 0 131 132 # First walk forward through the database .... 133 while { $recno < $count } { 134 # Test set_recno: verify it sets the record number properly. 135 set current [$dbc get -current] 136 set r [$dbc get -set_recno $recno] 137 error_check_good set_recno $current $r 138 # Test set_recno: verify that we find the expected key 139 # at the current record number position. 140 set k [lindex [lindex $r 0] 0] 141 error_check_good set_recno $kvals($recno) $k 142 143 # Test get_recno: verify that the return from 144 # get_recno matches the record number just set. 145 set g [$dbc get -get_recno] 146 error_check_good get_recno $recno $g 147 set ret [$dbc get -next] 148 incr recno 149 } 150 151 # ... and then backward. 152 set recno [expr $count - 1] 153 while { $recno > 0 } { 154 # Test set_recno: verify that we find the expected key 155 # at the current record number position. 156 set r [$dbc get -set_recno $recno] 157 set k [lindex [lindex $r 0] 0] 158 error_check_good set_recno $kvals($recno) $k 159 160 # Test get_recno: verify that the return from 161 # get_recno matches the record number just set. 162 set g [$dbc get -get_recno] 163 error_check_good get_recno $recno $g 164 set recno [expr $recno - 1] 165 } 166 167 error_check_good cursor_close [$dbc close] 0 168 if { $txnenv == 1 } { 169 error_check_good txn [$t commit] 0 170 } 171 error_check_good db_close [$db close] 0 172 close $did 173 174 puts "\tTest099.d: Test record renumbering with cursor deletes." 175 # Reopen the database, this time with write permission. 176 set db [eval {berkdb_open} $args $omethod $testfile ] 177 error_check_good dbopen [is_valid_db $db] TRUE 178 179 # Open three cursors. 180 if { $txnenv == 1 } { 181 set t [$env txn] 182 error_check_good txn [is_valid_txn $t $env] TRUE 183 set txn "-txn $t" 184 } 185 set dbc0 [eval {$db cursor} $txn] 186 error_check_good db_cursor [is_valid_cursor $dbc0 $db] TRUE 187 set dbc1 [eval {$db cursor} $txn] 188 error_check_good db_cursor [is_valid_cursor $dbc1 $db] TRUE 189 set dbc2 [eval {$db cursor} $txn] 190 error_check_good db_cursor [is_valid_cursor $dbc2 $db] TRUE 191 192 # Initialize cursor positions. Set dbc0 at the beginning, 193 # dbc1 at the middle, and dbc2 at the end. 194 set ret [$dbc0 get -first] 195 error_check_bad dbc0_get_first [llength $ret] 0 196 197 set middle [expr $nentries / 2 + 1] 198 set ret [$dbc1 get -set_recno $middle] 199 error_check_bad dbc1_get_middle [llength $ret] 0 200 201 set ret [$dbc2 get -last] 202 error_check_bad dbc2_get_last [llength $ret] 0 203 204 # At each iteration, delete the first entry, delete the middle 205 # entry, and check the record number for beginning, middle and end. 206 set count 1 207 while { $count <= [expr $nentries / 2] } { 208 # Delete first item. 209 error_check_good dbc0_del [$dbc0 del] 0 210 211 # For non-txn env's, check that db_stat is recalculating 212 # to adjust for items marked for deletion. We can't do this 213 # in txn env's because the live txn will cause deadlock. 214 if { $txnenv == 0 } { 215 set nkeys [expr $nentries - [expr $count * 2] + 1] 216 set stat [$db stat] 217 error_check_good keys_after_delete [is_substr $stat \ 218 "{Number of keys} $nkeys"] 1 219 error_check_good records_after_delete [is_substr $stat \ 220 "{Number of records} $nkeys"] 1 221 222 # Now delete the same entry again (which should not 223 # change the database) and make sure db->stat returns 224 # the same number of keys and records as before. 225 catch {[$dbc0 del]} result 226 227 set stat [$db stat] 228 error_check_good keys_after_baddelete [is_substr $stat \ 229 "{Number of keys} $nkeys"] 1 230 error_check_good recs_after_baddelete [is_substr $stat \ 231 "{Number of records} $nkeys"] 1 232 } 233 234 # Reposition cursor to new first item, check that record number 235 # is 1. 236 set ret0 [$dbc0 get -next] 237 error_check_good beginning_recno [$dbc0 get -get_recno] 1 238 239 # Calculate the current middle recno and compare to actual. 240 set middle [$dbc1 get -get_recno] 241 set calcmiddle [expr [expr $nentries / 2] - $count + 1] 242 error_check_good middle_recno $middle $calcmiddle 243 244 # Delete middle item, reposition cursor to next item. 245 error_check_good dbc1_del [$dbc1 del] 0 246 set ret1 [$dbc1 get -next] 247 248 # Calculate the expected end recno and compare to actual. 249 set end [$dbc2 get -get_recno] 250 set calcend [expr $nentries - [expr $count * 2]] 251 # On the last iteration, all items have been deleted so 252 # there is no recno. 253 if { $calcend == 0 } { 254 error_check_good end_recno $end "" 255 } else { 256 error_check_good end_recno $end $calcend 257 } 258 incr count 259 } 260 261 # Close all three cursors. 262 error_check_good cursor_close [$dbc0 close] 0 263 error_check_good cursor_close [$dbc1 close] 0 264 error_check_good cursor_close [$dbc2 close] 0 265 266 if { $txnenv == 1 } { 267 error_check_good txn [$t commit] 0 268 } 269 error_check_good db_close [$db close] 0 270} 271 272# Check function for dumped file; data should be fixed are identical 273proc test099.check { key data } { 274 error_check_good "data mismatch for key $key" $key $data 275} 276