1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1999,2008 Oracle. All rights reserved. 4# 5# $Id: recd010.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST recd010 8# TEST Test stability of btree duplicates across btree off-page dup splits 9# TEST and reverse splits and across recovery. 10proc recd010 { method {select 0} args} { 11 if { [is_btree $method] != 1 } { 12 puts "Recd010 skipping for method $method." 13 return 14 } 15 16 set pgindex [lsearch -exact $args "-pagesize"] 17 if { $pgindex != -1 } { 18 puts "Recd010: skipping for specific pagesizes" 19 return 20 } 21 set largs $args 22 append largs " -dup " 23 recd010_main $method $select $largs 24 append largs " -dupsort " 25 recd010_main $method $select $largs 26} 27 28proc recd010_main { method select largs } { 29 global fixed_len 30 global kvals 31 global kvals_dups 32 source ./include.tcl 33 34 35 set opts [convert_args $method $largs] 36 set method [convert_method $method] 37 38 puts "Recd010 ($opts): Test duplicates across splits and recovery" 39 40 set testfile recd010.db 41 env_cleanup $testdir 42 # 43 # Set pagesize small to generate lots of off-page dups 44 # 45 set page 512 46 set mkeys 1000 47 set firstkeys 5 48 set data "data" 49 set key "recd010_key" 50 51 puts "\tRecd010.a: Create environment and database." 52 set flags "-create -txn -home $testdir" 53 54 set env_cmd "berkdb_env $flags" 55 set dbenv [eval $env_cmd] 56 error_check_good dbenv [is_valid_env $dbenv] TRUE 57 58 set oflags "-env $dbenv -create -mode 0644 $opts $method" 59 set db [eval {berkdb_open} -pagesize $page $oflags $testfile] 60 error_check_good dbopen [is_valid_db $db] TRUE 61 62 # Fill page with small key/data pairs. Keep at leaf. 63 puts "\tRecd010.b: Fill page with $firstkeys small dups." 64 for { set i 1 } { $i <= $firstkeys } { incr i } { 65 set ret [$db put $key $data$i] 66 error_check_good dbput $ret 0 67 } 68 set kvals 1 69 set kvals_dups $firstkeys 70 error_check_good db_close [$db close] 0 71 error_check_good env_close [$dbenv close] 0 72 73 # List of recovery tests: {CMD MSG} pairs. 74 if { $mkeys < 100 } { 75 puts "Recd010 mkeys of $mkeys too small" 76 return 77 } 78 set rlist { 79 { {recd010_split DB TXNID 1 2 $mkeys} 80 "Recd010.c: btree split 2 large dups"} 81 { {recd010_split DB TXNID 0 2 $mkeys} 82 "Recd010.d: btree reverse split 2 large dups"} 83 { {recd010_split DB TXNID 1 10 $mkeys} 84 "Recd010.e: btree split 10 dups"} 85 { {recd010_split DB TXNID 0 10 $mkeys} 86 "Recd010.f: btree reverse split 10 dups"} 87 { {recd010_split DB TXNID 1 100 $mkeys} 88 "Recd010.g: btree split 100 dups"} 89 { {recd010_split DB TXNID 0 100 $mkeys} 90 "Recd010.h: btree reverse split 100 dups"} 91 } 92 93 foreach pair $rlist { 94 set cmd [subst [lindex $pair 0]] 95 set msg [lindex $pair 1] 96 if { $select != 0 } { 97 set tag [lindex $msg 0] 98 set tail [expr [string length $tag] - 2] 99 set tag [string range $tag $tail $tail] 100 if { [lsearch $select $tag] == -1 } { 101 continue 102 } 103 } 104 set reverse [string first "reverse" $msg] 105 op_recover abort $testdir $env_cmd $testfile $cmd $msg 106 recd010_check $testdir $testfile $opts abort $reverse $firstkeys 107 op_recover commit $testdir $env_cmd $testfile $cmd $msg 108 recd010_check $testdir $testfile $opts commit $reverse $firstkeys 109 } 110 puts "\tRecd010.i: Verify db_printlog can read logfile" 111 set tmpfile $testdir/printlog.out 112 set stat [catch {exec $util_path/db_printlog -h $testdir \ 113 > $tmpfile} ret] 114 error_check_good db_printlog $stat 0 115 fileremove $tmpfile 116} 117 118# 119# This procedure verifies that the database has only numkeys number 120# of keys and that they are in order. 121# 122proc recd010_check { tdir testfile opts op reverse origdups } { 123 global kvals 124 global kvals_dups 125 source ./include.tcl 126 127 set db [eval {berkdb_open} $opts $tdir/$testfile] 128 error_check_good dbopen [is_valid_db $db] TRUE 129 130 set data "data" 131 132 if { $reverse == -1 } { 133 puts "\tRecd010_check: Verify split after $op" 134 } else { 135 puts "\tRecd010_check: Verify reverse split after $op" 136 } 137 138 set stat [$db stat] 139 if { [expr ([string compare $op "abort"] == 0 && $reverse == -1) || \ 140 ([string compare $op "commit"] == 0 && $reverse != -1)]} { 141 set numkeys 0 142 set allkeys [expr $numkeys + 1] 143 set numdups $origdups 144 # 145 # If we abort the adding of dups, or commit 146 # the removal of dups, either way check that 147 # we are back at the beginning. Check that: 148 # - We have 0 internal pages. 149 # - We have only 1 key (the original we primed the db 150 # with at the beginning of the test). 151 # - We have only the original number of dups we primed 152 # the db with at the beginning of the test. 153 # 154 error_check_good stat:orig0 [is_substr $stat \ 155 "{{Internal pages} 0}"] 1 156 error_check_good stat:orig1 [is_substr $stat \ 157 "{{Number of keys} 1}"] 1 158 error_check_good stat:orig2 [is_substr $stat \ 159 "{{Number of records} $origdups}"] 1 160 } else { 161 set numkeys $kvals 162 set allkeys [expr $numkeys + 1] 163 set numdups $kvals_dups 164 # 165 # If we abort the removal of dups, or commit the 166 # addition of dups, check that: 167 # - We have > 0 internal pages. 168 # - We have the number of keys. 169 # 170 error_check_bad stat:new0 [is_substr $stat \ 171 "{{Internal pages} 0}"] 1 172 error_check_good stat:new1 [is_substr $stat \ 173 "{{Number of keys} $allkeys}"] 1 174 } 175 176 set dbc [$db cursor] 177 error_check_good dbcursor [is_valid_cursor $dbc $db] TRUE 178 puts "\tRecd010_check: Checking key and duplicate values" 179 set key "recd010_key" 180 # 181 # Check dups are there as they should be. 182 # 183 for {set ki 0} {$ki < $numkeys} {incr ki} { 184 set datacnt 0 185 for {set d [$dbc get -set $key$ki]} { [llength $d] != 0 } { 186 set d [$dbc get -nextdup]} { 187 set thisdata [lindex [lindex $d 0] 1] 188 if { $datacnt < 10 } { 189 set pdata $data.$ki.00$datacnt 190 } elseif { $datacnt < 100 } { 191 set pdata $data.$ki.0$datacnt 192 } else { 193 set pdata $data.$ki.$datacnt 194 } 195 error_check_good dup_check $thisdata $pdata 196 incr datacnt 197 } 198 error_check_good dup_count $datacnt $numdups 199 } 200 # 201 # Check that the number of expected keys (allkeys) are 202 # all of the ones that exist in the database. 203 # 204 set dupkeys 0 205 set lastkey "" 206 for {set d [$dbc get -first]} { [llength $d] != 0 } { 207 set d [$dbc get -next]} { 208 set thiskey [lindex [lindex $d 0] 0] 209 if { [string compare $lastkey $thiskey] != 0 } { 210 incr dupkeys 211 } 212 set lastkey $thiskey 213 } 214 error_check_good key_check $allkeys $dupkeys 215 error_check_good curs_close [$dbc close] 0 216 error_check_good db_close [$db close] 0 217} 218 219proc recd010_split { db txn split nkeys mkeys } { 220 global errorCode 221 global kvals 222 global kvals_dups 223 source ./include.tcl 224 225 set data "data" 226 set key "recd010_key" 227 228 set numdups [expr $mkeys / $nkeys] 229 230 set kvals $nkeys 231 set kvals_dups $numdups 232 if { $split == 1 } { 233 puts \ 234"\tRecd010_split: Add $nkeys keys, with $numdups duplicates each to force split." 235 for {set k 0} { $k < $nkeys } { incr k } { 236 for {set i 0} { $i < $numdups } { incr i } { 237 if { $i < 10 } { 238 set pdata $data.$k.00$i 239 } elseif { $i < 100 } { 240 set pdata $data.$k.0$i 241 } else { 242 set pdata $data.$k.$i 243 } 244 set ret [$db put -txn $txn $key$k $pdata] 245 error_check_good dbput:more $ret 0 246 } 247 } 248 } else { 249 puts \ 250"\tRecd010_split: Delete $nkeys keys to force reverse split." 251 for {set k 0} { $k < $nkeys } { incr k } { 252 error_check_good db_del:$k [$db del -txn $txn $key$k] 0 253 } 254 } 255 return 0 256} 257