1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: test052.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test052 8# TEST Renumbering record Recno test. 9proc test052 { method args } { 10 global alphabet 11 global errorInfo 12 global errorCode 13 source ./include.tcl 14 15 set args [convert_args $method $args] 16 set omethod [convert_method $method] 17 18 puts "Test052: Test of renumbering recno." 19 if { [is_rrecno $method] != 1} { 20 puts "Test052: skipping for method $method." 21 return 22 } 23 24 set data "data" 25 set txn "" 26 set flags "" 27 28 puts "\tTest052: Create $method database." 29 set txnenv 0 30 set eindex [lsearch -exact $args "-env"] 31 # 32 # If we are using an env, then testfile should just be the db name. 33 # Otherwise it is the test directory and the name. 34 if { $eindex == -1 } { 35 set testfile $testdir/test052.db 36 set env NULL 37 } else { 38 set testfile test052.db 39 incr eindex 40 set env [lindex $args $eindex] 41 set txnenv [is_txnenv $env] 42 if { $txnenv == 1 } { 43 append args " -auto_commit " 44 } 45 set testdir [get_home $env] 46 } 47 set t1 $testdir/t1 48 cleanup $testdir $env 49 50 set oflags "-create -mode 0644 $args $omethod" 51 set db [eval {berkdb_open} $oflags $testfile] 52 error_check_good dbopen [is_valid_db $db] TRUE 53 54 # keep nkeys even 55 set nkeys 20 56 57 # Fill page w/ small key/data pairs 58 puts "\tTest052: Fill page with $nkeys small key/data pairs." 59 for { set i 1 } { $i <= $nkeys } { incr i } { 60 if { $txnenv == 1 } { 61 set t [$env txn] 62 error_check_good txn [is_valid_txn $t $env] TRUE 63 set txn "-txn $t" 64 } 65 set ret [eval {$db put} $txn {$i $data$i}] 66 error_check_good dbput $ret 0 67 if { $txnenv == 1 } { 68 error_check_good txn [$t commit] 0 69 } 70 } 71 72 # open curs to db 73 if { $txnenv == 1 } { 74 set t [$env txn] 75 error_check_good txn [is_valid_txn $t $env] TRUE 76 set txn "-txn $t" 77 } 78 set dbc [eval {$db cursor} $txn] 79 error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE 80 81 # get db order of keys 82 for {set i 1; set ret [$dbc get -first]} { [llength $ret] != 0} { \ 83 set ret [$dbc get -next]} { 84 set keys($i) [lindex [lindex $ret 0] 0] 85 set darray($i) [lindex [lindex $ret 0] 1] 86 incr i 87 } 88 89 puts "\tTest052: Deletes by key." 90 puts "\tTest052.a: Get data with SET, then delete before cursor." 91 # get key in middle of page, call this the nth set curr to it 92 set i [expr $nkeys/2] 93 set k $keys($i) 94 set ret [$dbc get -set $k] 95 error_check_bad dbc_get:set [llength $ret] 0 96 error_check_good dbc_get:set [lindex [lindex $ret 0] 1] $darray($i) 97 98 # delete by key before current 99 set i [incr i -1] 100 error_check_good db_del:before [eval {$db del} $txn {$keys($i)}] 0 101 # with renumber, current's data should be constant, but key==--key 102 set i [incr i +1] 103 error_check_good dbc:data \ 104 [lindex [lindex [$dbc get -current] 0] 1] $darray($i) 105 error_check_good dbc:keys \ 106 [lindex [lindex [$dbc get -current] 0] 0] $keys([expr $nkeys/2 - 1]) 107 108 puts "\tTest052.b: Delete cursor item by key." 109 set i [expr $nkeys/2 ] 110 111 set ret [$dbc get -set $keys($i)] 112 error_check_bad dbc:get [llength $ret] 0 113 error_check_good dbc:get:curs [lindex [lindex $ret 0] 1] \ 114 $darray([expr $i + 1]) 115 error_check_good db_del:curr [eval {$db del} $txn {$keys($i)}] 0 116 set ret [$dbc get -current] 117 118 # After a delete, cursor should return DB_NOTFOUND. 119 error_check_good dbc:get:key [llength [lindex [lindex $ret 0] 0]] 0 120 error_check_good dbc:get:data [llength [lindex [lindex $ret 0] 1]] 0 121 122 # And the item after the cursor should now be 123 # key: $nkeys/2, data: $nkeys/2 + 2 124 set ret [$dbc get -next] 125 error_check_bad dbc:getnext [llength $ret] 0 126 error_check_good dbc:getnext:data \ 127 [lindex [lindex $ret 0] 1] $darray([expr $i + 2]) 128 error_check_good dbc:getnext:keys \ 129 [lindex [lindex $ret 0] 0] $keys($i) 130 131 puts "\tTest052.c: Delete item after cursor." 132 # should be { keys($nkeys/2), darray($nkeys/2 + 2) } 133 set i [expr $nkeys/2] 134 # deleting data for key after current (key $nkeys/2 + 1) 135 error_check_good db_del [eval {$db del} $txn {$keys([expr $i + 1])}] 0 136 137 # current should be constant 138 set ret [$dbc get -current] 139 error_check_bad dbc:get:current [llength $ret] 0 140 error_check_good dbc:get:keys [lindex [lindex $ret 0] 0] \ 141 $keys($i) 142 error_check_good dbc:get:data [lindex [lindex $ret 0] 1] \ 143 $darray([expr $i + 2]) 144 145 puts "\tTest052: Deletes by cursor." 146 puts "\tTest052.d: Delete, do DB_NEXT." 147 set i 1 148 set ret [$dbc get -first] 149 error_check_bad dbc_get:first [llength $ret] 0 150 error_check_good dbc_get:first [lindex [lindex $ret 0] 1] $darray($i) 151 error_check_good dbc_del [$dbc del] 0 152 set ret [$dbc get -current] 153 error_check_good dbc_get:current [llength $ret] 0 154 155 set ret [$dbc get -next] 156 error_check_bad dbc_get:next [llength $ret] 0 157 error_check_good dbc:get:curs \ 158 [lindex [lindex $ret 0] 1] $darray([expr $i + 1]) 159 error_check_good dbc:get:keys \ 160 [lindex [lindex $ret 0] 0] $keys($i) 161 162 # Move one more forward, so we're not on the first item. 163 error_check_bad dbc:getnext [llength [$dbc get -next]] 0 164 165 puts "\tTest052.e: Delete, do DB_PREV." 166 error_check_good dbc:del [$dbc del] 0 167 set ret [$dbc get -current] 168 error_check_good dbc:get:curr [llength $ret] 0 169 170 # next should now reference the record that was previously after 171 # old current 172 set ret [$dbc get -next] 173 error_check_bad get:next [llength $ret] 0 174 error_check_good dbc:get:next:data \ 175 [lindex [lindex $ret 0] 1] $darray([expr $i + 3]) 176 error_check_good dbc:get:next:keys \ 177 [lindex [lindex $ret 0] 0] $keys([expr $i + 1]) 178 179 180 set ret [$dbc get -prev] 181 error_check_bad dbc:get:curr [llength $ret] 0 182 error_check_good dbc:get:curr:compare \ 183 [lindex [lindex $ret 0] 1] $darray([expr $i + 1]) 184 error_check_good dbc:get:curr:keys \ 185 [lindex [lindex $ret 0] 0] $keys($i) 186 187 # The rest of the test was written with the old rrecno semantics, 188 # which required a separate c_del(CURRENT) test; to leave 189 # the database in the expected state, we now delete the first item. 190 set ret [$dbc get -first] 191 error_check_bad getfirst [llength $ret] 0 192 error_check_good delfirst [$dbc del] 0 193 194 puts "\tTest052: Inserts." 195 puts "\tTest052.g: Insert before (DB_BEFORE)." 196 set i 1 197 set ret [$dbc get -first] 198 error_check_bad dbc:get:first [llength $ret] 0 199 error_check_good dbc_get:first \ 200 [lindex [lindex $ret 0] 0] $keys($i) 201 error_check_good dbc_get:first:data \ 202 [lindex [lindex $ret 0] 1] $darray([expr $i + 3]) 203 204 set ret [$dbc put -before $darray($i)] 205 # should return new key, which should be $keys($i) 206 error_check_good dbc_put:before $ret $keys($i) 207 # cursor should adjust to point to new item 208 set ret [$dbc get -current] 209 error_check_bad dbc_get:curr [llength $ret] 0 210 error_check_good dbc_put:before:keys \ 211 [lindex [lindex $ret 0] 0] $keys($i) 212 error_check_good dbc_put:before:data \ 213 [lindex [lindex $ret 0] 1] $darray($i) 214 215 set ret [$dbc get -next] 216 error_check_bad dbc_get:next [llength $ret] 0 217 error_check_good dbc_get:next:compare \ 218 $ret [list [list $keys([expr $i + 1]) $darray([expr $i + 3])]] 219 set ret [$dbc get -prev] 220 error_check_bad dbc_get:prev [llength $ret] 0 221 222 puts "\tTest052.h: Insert by cursor after (DB_AFTER)." 223 set i [incr i] 224 set ret [$dbc put -after $darray($i)] 225 # should return new key, which should be $keys($i) 226 error_check_good dbcput:after $ret $keys($i) 227 # cursor should reference new item 228 set ret [$dbc get -current] 229 error_check_good dbc:get:current:keys \ 230 [lindex [lindex $ret 0] 0] $keys($i) 231 error_check_good dbc:get:current:data \ 232 [lindex [lindex $ret 0] 1] $darray($i) 233 234 # items after curs should be adjusted 235 set ret [$dbc get -next] 236 error_check_bad dbc:get:next [llength $ret] 0 237 error_check_good dbc:get:next:compare \ 238 $ret [list [list $keys([expr $i + 1]) $darray([expr $i + 2])]] 239 240 puts "\tTest052.i: Insert (overwrite) current item (DB_CURRENT)." 241 set i 1 242 set ret [$dbc get -first] 243 error_check_bad dbc_get:first [llength $ret] 0 244 # choose a datum that is not currently in db 245 set ret [$dbc put -current $darray([expr $i + 2])] 246 error_check_good dbc_put:curr $ret 0 247 # curs should be on new item 248 set ret [$dbc get -current] 249 error_check_bad dbc_get:current [llength $ret] 0 250 error_check_good dbc_get:curr:keys \ 251 [lindex [lindex $ret 0] 0] $keys($i) 252 error_check_good dbc_get:curr:data \ 253 [lindex [lindex $ret 0] 1] $darray([expr $i + 2]) 254 255 set ret [$dbc get -next] 256 error_check_bad dbc_get:next [llength $ret] 0 257 set i [incr i] 258 error_check_good dbc_get:next \ 259 $ret [list [list $keys($i) $darray($i)]] 260 261 error_check_good dbc_close [$dbc close] 0 262 if { $txnenv == 1 } { 263 error_check_good txn [$t commit] 0 264 } 265 error_check_good db_close [$db close] 0 266 267 puts "\tTest052 complete." 268} 269