1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999-2009 Oracle. All rights reserved. 4# 5# $Id$ 6# 7# TEST test073 8# TEST Test of cursor stability on duplicate pages. 9# TEST 10# TEST Does the following: 11# TEST a. Initialize things by DB->putting ndups dups and 12# TEST setting a reference cursor to point to each. 13# TEST b. c_put ndups dups (and correspondingly expanding 14# TEST the set of reference cursors) after the last one, making sure 15# TEST after each step that all the reference cursors still point to 16# TEST the right item. 17# TEST c. Ditto, but before the first one. 18# TEST d. Ditto, but after each one in sequence first to last. 19# TEST e. Ditto, but after each one in sequence from last to first. 20# TEST occur relative to the new datum) 21# TEST f. Ditto for the two sequence tests, only doing a 22# TEST DBC->c_put(DB_CURRENT) of a larger datum instead of adding a 23# TEST new one. 24proc test073 { method {pagesize 512} {ndups 50} {tnum "073"} args } { 25 source ./include.tcl 26 global alphabet 27 28 set omethod [convert_method $method] 29 set args [convert_args $method $args] 30 31 set txnenv 0 32 set eindex [lsearch -exact $args "-env"] 33 # 34 # If we are using an env, then testfile should just be the db name. 35 # Otherwise it is the test directory and the name. 36 if { $eindex == -1 } { 37 set testfile $testdir/test$tnum.db 38 set env NULL 39 } else { 40 set testfile test$tnum.db 41 incr eindex 42 set env [lindex $args $eindex] 43 set txnenv [is_txnenv $env] 44 if { $txnenv == 1 } { 45 append args " -auto_commit " 46 } 47 set testdir [get_home $env] 48 } 49 cleanup $testdir $env 50 51 set key "the key" 52 set txn "" 53 54 puts -nonewline "Test$tnum $omethod ($args): " 55 if { [is_record_based $method] || [is_rbtree $method] } { 56 puts "Skipping for method $method." 57 return 58 } 59 60 # Btree with compression does not support unsorted duplicates. 61 if { [is_compressed $args] == 1 } { 62 puts "Test$tnum skipping for btree with compression." 63 return 64 } 65 66 puts "cursor stability on duplicate pages." 67 68 set pgindex [lsearch -exact $args "-pagesize"] 69 if { $pgindex != -1 } { 70 puts "Test073: skipping for specific pagesizes" 71 return 72 } 73 74 append args " -pagesize $pagesize -dup" 75 76 set db [eval {berkdb_open \ 77 -create -mode 0644} $omethod $args $testfile] 78 error_check_good "db open" [is_valid_db $db] TRUE 79 80 # Number of outstanding keys. 81 set keys 0 82 83 puts "\tTest$tnum.a.1: Initializing put loop; $ndups dups, short data." 84 85 for { set i 0 } { $i < $ndups } { incr i } { 86 set datum [makedatum_t73 $i 0] 87 88 if { $txnenv == 1 } { 89 set t [$env txn] 90 error_check_good txn [is_valid_txn $t $env] TRUE 91 set txn "-txn $t" 92 } 93 set ret [eval {$db put} $txn {$key $datum}] 94 error_check_good "db put ($i)" $ret 0 95 if { $txnenv == 1 } { 96 error_check_good txn [$t commit] 0 97 } 98 99 set is_long($i) 0 100 incr keys 101 } 102 103 puts "\tTest$tnum.a.2: Initializing cursor get loop; $keys dups." 104 if { $txnenv == 1 } { 105 set t [$env txn] 106 error_check_good txn [is_valid_txn $t $env] TRUE 107 set txn "-txn $t" 108 } 109 for { set i 0 } { $i < $keys } { incr i } { 110 set datum [makedatum_t73 $i 0] 111 112 set dbc($i) [eval {$db cursor} $txn] 113 error_check_good "db cursor ($i)"\ 114 [is_valid_cursor $dbc($i) $db] TRUE 115 error_check_good "dbc get -get_both ($i)"\ 116 [$dbc($i) get -get_both $key $datum]\ 117 [list [list $key $datum]] 118 } 119 120 puts "\tTest$tnum.b: Cursor put (DB_KEYLAST); $ndups new dups,\ 121 short data." 122 123 for { set i 0 } { $i < $ndups } { incr i } { 124 # !!! keys contains the number of the next dup 125 # to be added (since they start from zero) 126 127 set datum [makedatum_t73 $keys 0] 128 set curs [eval {$db cursor} $txn] 129 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 130 TRUE 131 error_check_good "c_put(DB_KEYLAST, $keys)"\ 132 [$curs put -keylast $key $datum] 0 133 134 set dbc($keys) $curs 135 set is_long($keys) 0 136 incr keys 137 138 verify_t73 is_long dbc $keys $key 139 } 140 141 puts "\tTest$tnum.c: Cursor put (DB_KEYFIRST); $ndups new dups,\ 142 short data." 143 144 for { set i 0 } { $i < $ndups } { incr i } { 145 # !!! keys contains the number of the next dup 146 # to be added (since they start from zero) 147 148 set datum [makedatum_t73 $keys 0] 149 set curs [eval {$db cursor} $txn] 150 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 151 TRUE 152 error_check_good "c_put(DB_KEYFIRST, $keys)"\ 153 [$curs put -keyfirst $key $datum] 0 154 155 set dbc($keys) $curs 156 set is_long($keys) 0 157 incr keys 158 159 verify_t73 is_long dbc $keys $key 160 } 161 162 puts "\tTest$tnum.d: Cursor put (DB_AFTER) first to last;\ 163 $keys new dups, short data" 164 # We want to add a datum after each key from 0 to the current 165 # value of $keys, which we thus need to save. 166 set keysnow $keys 167 for { set i 0 } { $i < $keysnow } { incr i } { 168 set datum [makedatum_t73 $keys 0] 169 set curs [eval {$db cursor} $txn] 170 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 171 TRUE 172 173 # Which datum to insert this guy after. 174 set curdatum [makedatum_t73 $i 0] 175 error_check_good "c_get(DB_GET_BOTH, $i)"\ 176 [$curs get -get_both $key $curdatum]\ 177 [list [list $key $curdatum]] 178 error_check_good "c_put(DB_AFTER, $i)"\ 179 [$curs put -after $datum] 0 180 181 set dbc($keys) $curs 182 set is_long($keys) 0 183 incr keys 184 185 verify_t73 is_long dbc $keys $key 186 } 187 188 puts "\tTest$tnum.e: Cursor put (DB_BEFORE) last to first;\ 189 $keys new dups, short data" 190 191 for { set i [expr $keys - 1] } { $i >= 0 } { incr i -1 } { 192 set datum [makedatum_t73 $keys 0] 193 set curs [eval {$db cursor} $txn] 194 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 195 TRUE 196 197 # Which datum to insert this guy before. 198 set curdatum [makedatum_t73 $i 0] 199 error_check_good "c_get(DB_GET_BOTH, $i)"\ 200 [$curs get -get_both $key $curdatum]\ 201 [list [list $key $curdatum]] 202 error_check_good "c_put(DB_BEFORE, $i)"\ 203 [$curs put -before $datum] 0 204 205 set dbc($keys) $curs 206 set is_long($keys) 0 207 incr keys 208 209 if { $i % 10 == 1 } { 210 verify_t73 is_long dbc $keys $key 211 } 212 } 213 verify_t73 is_long dbc $keys $key 214 215 puts "\tTest$tnum.f: Cursor put (DB_CURRENT), first to last,\ 216 growing $keys data." 217 set keysnow $keys 218 for { set i 0 } { $i < $keysnow } { incr i } { 219 set olddatum [makedatum_t73 $i 0] 220 set newdatum [makedatum_t73 $i 1] 221 set curs [eval {$db cursor} $txn] 222 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 223 TRUE 224 225 error_check_good "c_get(DB_GET_BOTH, $i)"\ 226 [$curs get -get_both $key $olddatum]\ 227 [list [list $key $olddatum]] 228 error_check_good "c_put(DB_CURRENT, $i)"\ 229 [$curs put -current $newdatum] 0 230 231 error_check_good "cursor close" [$curs close] 0 232 233 set is_long($i) 1 234 235 if { $i % 10 == 1 } { 236 verify_t73 is_long dbc $keys $key 237 } 238 } 239 verify_t73 is_long dbc $keys $key 240 241 # Close cursors. 242 puts "\tTest$tnum.g: Closing cursors." 243 for { set i 0 } { $i < $keys } { incr i } { 244 error_check_good "dbc close ($i)" [$dbc($i) close] 0 245 } 246 if { $txnenv == 1 } { 247 error_check_good txn [$t commit] 0 248 } 249 error_check_good "db close" [$db close] 0 250} 251 252# !!!: This procedure is also used by test087. 253proc makedatum_t73 { num is_long } { 254 global alphabet 255 if { $is_long == 1 } { 256 set a $alphabet$alphabet$alphabet 257 } else { 258 set a abcdefghijklm 259 } 260 261 # format won't do leading zeros, alas. 262 if { $num / 1000 > 0 } { 263 set i $num 264 } elseif { $num / 100 > 0 } { 265 set i 0$num 266 } elseif { $num / 10 > 0 } { 267 set i 00$num 268 } else { 269 set i 000$num 270 } 271 272 return $i$a 273} 274 275# !!!: This procedure is also used by test087. 276proc verify_t73 { is_long_array curs_array numkeys key } { 277 upvar $is_long_array is_long 278 upvar $curs_array dbc 279 upvar db db 280 281 #useful for debugging, perhaps. 282 eval $db sync 283 284 for { set j 0 } { $j < $numkeys } { incr j } { 285 set dbt [$dbc($j) get -current] 286 set k [lindex [lindex $dbt 0] 0] 287 set d [lindex [lindex $dbt 0] 1] 288 289 error_check_good\ 290 "cursor $j key correctness (with $numkeys total items)"\ 291 $k $key 292 error_check_good\ 293 "cursor $j data correctness (with $numkeys total items)"\ 294 $d [makedatum_t73 $j $is_long($j)] 295 } 296} 297