1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: test072.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST test072 8# TEST Test of cursor stability when duplicates are moved off-page. 9proc test072 { method {pagesize 512} {ndups 20} {tnum "072"} args } { 10 source ./include.tcl 11 global alphabet 12 global is_je_test 13 14 set omethod [convert_method $method] 15 set args [convert_args $method $args] 16 17 set txnenv 0 18 set eindex [lsearch -exact $args "-env"] 19 # 20 # If we are using an env, then testfile name should just be 21 # the db name. Otherwise it is the test directory and the name. 22 if { $eindex == -1 } { 23 set basename $testdir/test$tnum 24 set env NULL 25 } else { 26 set basename test$tnum 27 incr eindex 28 set env [lindex $args $eindex] 29 set txnenv [is_txnenv $env] 30 if { $txnenv == 1 } { 31 append args " -auto_commit " 32 } 33 set testdir [get_home $env] 34 } 35 cleanup $testdir $env 36 37 # Keys must sort $prekey < $key < $postkey. 38 set prekey "a key" 39 set key "the key" 40 set postkey "z key" 41 42 # Make these distinguishable from each other and from the 43 # alphabets used for the $key's data. 44 set predatum "1234567890" 45 set postdatum "0987654321" 46 47 puts -nonewline "Test$tnum $omethod ($args): " 48 if { [is_record_based $method] || [is_rbtree $method] } { 49 puts "Skipping for method $method." 50 return 51 } else { 52 puts "\nTest$tnum: Test of cursor stability when\ 53 duplicates are moved off-page." 54 } 55 set pgindex [lsearch -exact $args "-pagesize"] 56 if { $pgindex != -1 } { 57 puts "Test$tnum: skipping for specific pagesizes" 58 return 59 } 60 61 append args " -pagesize $pagesize " 62 set txn "" 63 64 set dlist [list "-dup" "-dup -dupsort"] 65 set testid 0 66 foreach dupopt $dlist { 67 if { $is_je_test && $dupopt == "-dup" } { 68 continue 69 } 70 71 incr testid 72 set duptestfile $basename$testid.db 73 set db [eval {berkdb_open -create -mode 0644} \ 74 $omethod $args $dupopt {$duptestfile}] 75 error_check_good "db open" [is_valid_db $db] TRUE 76 77 puts \ 78"\tTest$tnum.a: ($dupopt) Set up surrounding keys and cursors." 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 ret [eval {$db put} $txn {$prekey $predatum}] 85 error_check_good pre_put $ret 0 86 set ret [eval {$db put} $txn {$postkey $postdatum}] 87 error_check_good post_put $ret 0 88 89 set precursor [eval {$db cursor} $txn] 90 error_check_good precursor [is_valid_cursor $precursor \ 91 $db] TRUE 92 set postcursor [eval {$db cursor} $txn] 93 error_check_good postcursor [is_valid_cursor $postcursor \ 94 $db] TRUE 95 error_check_good preset [$precursor get -set $prekey] \ 96 [list [list $prekey $predatum]] 97 error_check_good postset [$postcursor get -set $postkey] \ 98 [list [list $postkey $postdatum]] 99 100 puts "\tTest$tnum.b: Put/create cursor/verify all cursor loop." 101 102 for { set i 0 } { $i < $ndups } { incr i } { 103 set datum [format "%4d$alphabet" [expr $i + 1000]] 104 set data($i) $datum 105 106 # Uncomment these lines to see intermediate steps. 107 # error_check_good db_sync($i) [$db sync] 0 108 # error_check_good db_dump($i) \ 109 # [catch {exec $util_path/db_dump \ 110 # -da $duptestfile > $testdir/out.$i}] 0 111 112 set ret [eval {$db put} $txn {$key $datum}] 113 error_check_good "db put ($i)" $ret 0 114 115 set dbc($i) [eval {$db cursor} $txn] 116 error_check_good "db cursor ($i)"\ 117 [is_valid_cursor $dbc($i) $db] TRUE 118 119 error_check_good "dbc get -get_both ($i)"\ 120 [$dbc($i) get -get_both $key $datum]\ 121 [list [list $key $datum]] 122 123 for { set j 0 } { $j < $i } { incr j } { 124 set dbt [$dbc($j) get -current] 125 set k [lindex [lindex $dbt 0] 0] 126 set d [lindex [lindex $dbt 0] 1] 127 128 #puts "cursor $j after $i: $d" 129 130 eval {$db sync} 131 132 error_check_good\ 133 "cursor $j key correctness after $i puts" \ 134 $k $key 135 error_check_good\ 136 "cursor $j data correctness after $i puts" \ 137 $d $data($j) 138 } 139 140 # Check correctness of pre- and post- cursors. Do an 141 # error_check_good on the lengths first so that we don't 142 # spew garbage as the "got" field and screw up our 143 # terminal. (It's happened here.) 144 set pre_dbt [$precursor get -current] 145 set post_dbt [$postcursor get -current] 146 error_check_good \ 147 "key earlier cursor correctness after $i puts" \ 148 [string length [lindex [lindex $pre_dbt 0] 0]] \ 149 [string length $prekey] 150 error_check_good \ 151 "data earlier cursor correctness after $i puts" \ 152 [string length [lindex [lindex $pre_dbt 0] 1]] \ 153 [string length $predatum] 154 error_check_good \ 155 "key later cursor correctness after $i puts" \ 156 [string length [lindex [lindex $post_dbt 0] 0]] \ 157 [string length $postkey] 158 error_check_good \ 159 "data later cursor correctness after $i puts" \ 160 [string length [lindex [lindex $post_dbt 0] 1]]\ 161 [string length $postdatum] 162 163 error_check_good \ 164 "earlier cursor correctness after $i puts" \ 165 $pre_dbt [list [list $prekey $predatum]] 166 error_check_good \ 167 "later cursor correctness after $i puts" \ 168 $post_dbt [list [list $postkey $postdatum]] 169 } 170 171 puts "\tTest$tnum.c: Reverse Put/create cursor/verify all cursor loop." 172 set end [expr $ndups * 2 - 1] 173 for { set i $end } { $i >= $ndups } { set i [expr $i - 1] } { 174 set datum [format "%4d$alphabet" [expr $i + 1000]] 175 set data($i) $datum 176 177 # Uncomment these lines to see intermediate steps. 178 # error_check_good db_sync($i) [$db sync] 0 179 # error_check_good db_dump($i) \ 180 # [catch {exec $util_path/db_dump \ 181 # -da $duptestfile > $testdir/out.$i}] 0 182 183 set ret [eval {$db put} $txn {$key $datum}] 184 error_check_good "db put ($i)" $ret 0 185 186 error_check_bad dbc($i)_stomped [info exists dbc($i)] 1 187 set dbc($i) [eval {$db cursor} $txn] 188 error_check_good "db cursor ($i)"\ 189 [is_valid_cursor $dbc($i) $db] TRUE 190 191 error_check_good "dbc get -get_both ($i)"\ 192 [$dbc($i) get -get_both $key $datum]\ 193 [list [list $key $datum]] 194 195 for { set j $i } { $j < $end } { incr j } { 196 set dbt [$dbc($j) get -current] 197 set k [lindex [lindex $dbt 0] 0] 198 set d [lindex [lindex $dbt 0] 1] 199 200 #puts "cursor $j after $i: $d" 201 202 eval {$db sync} 203 204 error_check_good\ 205 "cursor $j key correctness after $i puts" \ 206 $k $key 207 error_check_good\ 208 "cursor $j data correctness after $i puts" \ 209 $d $data($j) 210 } 211 212 # Check correctness of pre- and post- cursors. Do an 213 # error_check_good on the lengths first so that we don't 214 # spew garbage as the "got" field and screw up our 215 # terminal. (It's happened here.) 216 set pre_dbt [$precursor get -current] 217 set post_dbt [$postcursor get -current] 218 error_check_good \ 219 "key earlier cursor correctness after $i puts" \ 220 [string length [lindex [lindex $pre_dbt 0] 0]] \ 221 [string length $prekey] 222 error_check_good \ 223 "data earlier cursor correctness after $i puts" \ 224 [string length [lindex [lindex $pre_dbt 0] 1]] \ 225 [string length $predatum] 226 error_check_good \ 227 "key later cursor correctness after $i puts" \ 228 [string length [lindex [lindex $post_dbt 0] 0]] \ 229 [string length $postkey] 230 error_check_good \ 231 "data later cursor correctness after $i puts" \ 232 [string length [lindex [lindex $post_dbt 0] 1]]\ 233 [string length $postdatum] 234 235 error_check_good \ 236 "earlier cursor correctness after $i puts" \ 237 $pre_dbt [list [list $prekey $predatum]] 238 error_check_good \ 239 "later cursor correctness after $i puts" \ 240 $post_dbt [list [list $postkey $postdatum]] 241 } 242 243 # Close cursors. 244 puts "\tTest$tnum.d: Closing cursors." 245 for { set i 0 } { $i <= $end } { incr i } { 246 error_check_good "dbc close ($i)" [$dbc($i) close] 0 247 } 248 unset dbc 249 error_check_good precursor_close [$precursor close] 0 250 error_check_good postcursor_close [$postcursor close] 0 251 if { $txnenv == 1 } { 252 error_check_good txn [$t commit] 0 253 } 254 error_check_good "db close" [$db close] 0 255 } 256} 257