1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: test073.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 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 } else { 59 puts "cursor stability on duplicate pages." 60 } 61 set pgindex [lsearch -exact $args "-pagesize"] 62 if { $pgindex != -1 } { 63 puts "Test073: skipping for specific pagesizes" 64 return 65 } 66 67 append args " -pagesize $pagesize -dup" 68 69 set db [eval {berkdb_open \ 70 -create -mode 0644} $omethod $args $testfile] 71 error_check_good "db open" [is_valid_db $db] TRUE 72 73 # Number of outstanding keys. 74 set keys 0 75 76 puts "\tTest$tnum.a.1: Initializing put loop; $ndups dups, short data." 77 78 for { set i 0 } { $i < $ndups } { incr i } { 79 set datum [makedatum_t73 $i 0] 80 81 if { $txnenv == 1 } { 82 set t [$env txn] 83 error_check_good txn [is_valid_txn $t $env] TRUE 84 set txn "-txn $t" 85 } 86 set ret [eval {$db put} $txn {$key $datum}] 87 error_check_good "db put ($i)" $ret 0 88 if { $txnenv == 1 } { 89 error_check_good txn [$t commit] 0 90 } 91 92 set is_long($i) 0 93 incr keys 94 } 95 96 puts "\tTest$tnum.a.2: Initializing cursor get loop; $keys dups." 97 if { $txnenv == 1 } { 98 set t [$env txn] 99 error_check_good txn [is_valid_txn $t $env] TRUE 100 set txn "-txn $t" 101 } 102 for { set i 0 } { $i < $keys } { incr i } { 103 set datum [makedatum_t73 $i 0] 104 105 set dbc($i) [eval {$db cursor} $txn] 106 error_check_good "db cursor ($i)"\ 107 [is_valid_cursor $dbc($i) $db] TRUE 108 error_check_good "dbc get -get_both ($i)"\ 109 [$dbc($i) get -get_both $key $datum]\ 110 [list [list $key $datum]] 111 } 112 113 puts "\tTest$tnum.b: Cursor put (DB_KEYLAST); $ndups new dups,\ 114 short data." 115 116 for { set i 0 } { $i < $ndups } { incr i } { 117 # !!! keys contains the number of the next dup 118 # to be added (since they start from zero) 119 120 set datum [makedatum_t73 $keys 0] 121 set curs [eval {$db cursor} $txn] 122 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 123 TRUE 124 error_check_good "c_put(DB_KEYLAST, $keys)"\ 125 [$curs put -keylast $key $datum] 0 126 127 set dbc($keys) $curs 128 set is_long($keys) 0 129 incr keys 130 131 verify_t73 is_long dbc $keys $key 132 } 133 134 puts "\tTest$tnum.c: Cursor put (DB_KEYFIRST); $ndups new dups,\ 135 short data." 136 137 for { set i 0 } { $i < $ndups } { incr i } { 138 # !!! keys contains the number of the next dup 139 # to be added (since they start from zero) 140 141 set datum [makedatum_t73 $keys 0] 142 set curs [eval {$db cursor} $txn] 143 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 144 TRUE 145 error_check_good "c_put(DB_KEYFIRST, $keys)"\ 146 [$curs put -keyfirst $key $datum] 0 147 148 set dbc($keys) $curs 149 set is_long($keys) 0 150 incr keys 151 152 verify_t73 is_long dbc $keys $key 153 } 154 155 puts "\tTest$tnum.d: Cursor put (DB_AFTER) first to last;\ 156 $keys new dups, short data" 157 # We want to add a datum after each key from 0 to the current 158 # value of $keys, which we thus need to save. 159 set keysnow $keys 160 for { set i 0 } { $i < $keysnow } { incr i } { 161 set datum [makedatum_t73 $keys 0] 162 set curs [eval {$db cursor} $txn] 163 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 164 TRUE 165 166 # Which datum to insert this guy after. 167 set curdatum [makedatum_t73 $i 0] 168 error_check_good "c_get(DB_GET_BOTH, $i)"\ 169 [$curs get -get_both $key $curdatum]\ 170 [list [list $key $curdatum]] 171 error_check_good "c_put(DB_AFTER, $i)"\ 172 [$curs put -after $datum] 0 173 174 set dbc($keys) $curs 175 set is_long($keys) 0 176 incr keys 177 178 verify_t73 is_long dbc $keys $key 179 } 180 181 puts "\tTest$tnum.e: Cursor put (DB_BEFORE) last to first;\ 182 $keys new dups, short data" 183 184 for { set i [expr $keys - 1] } { $i >= 0 } { incr i -1 } { 185 set datum [makedatum_t73 $keys 0] 186 set curs [eval {$db cursor} $txn] 187 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 188 TRUE 189 190 # Which datum to insert this guy before. 191 set curdatum [makedatum_t73 $i 0] 192 error_check_good "c_get(DB_GET_BOTH, $i)"\ 193 [$curs get -get_both $key $curdatum]\ 194 [list [list $key $curdatum]] 195 error_check_good "c_put(DB_BEFORE, $i)"\ 196 [$curs put -before $datum] 0 197 198 set dbc($keys) $curs 199 set is_long($keys) 0 200 incr keys 201 202 if { $i % 10 == 1 } { 203 verify_t73 is_long dbc $keys $key 204 } 205 } 206 verify_t73 is_long dbc $keys $key 207 208 puts "\tTest$tnum.f: Cursor put (DB_CURRENT), first to last,\ 209 growing $keys data." 210 set keysnow $keys 211 for { set i 0 } { $i < $keysnow } { incr i } { 212 set olddatum [makedatum_t73 $i 0] 213 set newdatum [makedatum_t73 $i 1] 214 set curs [eval {$db cursor} $txn] 215 error_check_good "db cursor create" [is_valid_cursor $curs $db]\ 216 TRUE 217 218 error_check_good "c_get(DB_GET_BOTH, $i)"\ 219 [$curs get -get_both $key $olddatum]\ 220 [list [list $key $olddatum]] 221 error_check_good "c_put(DB_CURRENT, $i)"\ 222 [$curs put -current $newdatum] 0 223 224 error_check_good "cursor close" [$curs close] 0 225 226 set is_long($i) 1 227 228 if { $i % 10 == 1 } { 229 verify_t73 is_long dbc $keys $key 230 } 231 } 232 verify_t73 is_long dbc $keys $key 233 234 # Close cursors. 235 puts "\tTest$tnum.g: Closing cursors." 236 for { set i 0 } { $i < $keys } { incr i } { 237 error_check_good "dbc close ($i)" [$dbc($i) close] 0 238 } 239 if { $txnenv == 1 } { 240 error_check_good txn [$t commit] 0 241 } 242 error_check_good "db close" [$db close] 0 243} 244 245# !!!: This procedure is also used by test087. 246proc makedatum_t73 { num is_long } { 247 global alphabet 248 if { $is_long == 1 } { 249 set a $alphabet$alphabet$alphabet 250 } else { 251 set a abcdefghijklm 252 } 253 254 # format won't do leading zeros, alas. 255 if { $num / 1000 > 0 } { 256 set i $num 257 } elseif { $num / 100 > 0 } { 258 set i 0$num 259 } elseif { $num / 10 > 0 } { 260 set i 00$num 261 } else { 262 set i 000$num 263 } 264 265 return $i$a 266} 267 268# !!!: This procedure is also used by test087. 269proc verify_t73 { is_long_array curs_array numkeys key } { 270 upvar $is_long_array is_long 271 upvar $curs_array dbc 272 upvar db db 273 274 #useful for debugging, perhaps. 275 eval $db sync 276 277 for { set j 0 } { $j < $numkeys } { incr j } { 278 set dbt [$dbc($j) get -current] 279 set k [lindex [lindex $dbt 0] 0] 280 set d [lindex [lindex $dbt 0] 1] 281 282 error_check_good\ 283 "cursor $j key correctness (with $numkeys total items)"\ 284 $k $key 285 error_check_good\ 286 "cursor $j data correctness (with $numkeys total items)"\ 287 $d [makedatum_t73 $j $is_long($j)] 288 } 289} 290