1#See the file LICENSE for redistribution information. 2# 3# Copyright (c) 2001,2008 Oracle. All rights reserved. 4# 5# $Id: siutils.tcl,v 12.7 2008/01/08 20:58:53 bostic Exp $ 6# 7# Secondary index utilities. This file used to be known as 8# sindex.tcl. 9# 10# The secondary index tests themselves live in si0*.tcl. 11# 12# Standard number of secondary indices to create if a single-element 13# list of methods is passed into the secondary index tests. 14global nsecondaries 15set nsecondaries 2 16 17# The callback function we use for each given secondary in most tests 18# is a simple function of its place in the list of secondaries (0-based) 19# and the access method (since recnos may need different callbacks). 20# 21# !!! 22# Note that callbacks 0-3 return unique secondary keys if the input data 23# are unique; callbacks 4 and higher may not, so don't use them with 24# the normal wordlist and secondaries that don't support dups. 25# The callbacks that incorporate a key don't work properly with recno 26# access methods, at least not in the current test framework (the 27# error_check_good lines test for e.g. 1foo, when the database has 28# e.g. 0x010x000x000x00foo). 29proc callback_n { n } { 30 switch $n { 31 0 { return _s_reversedata } 32 1 { return _s_noop } 33 2 { return _s_concatkeydata } 34 3 { return _s_concatdatakey } 35 4 { return _s_reverseconcat } 36 5 { return _s_truncdata } 37 6 { return _s_constant } 38 7 { return _s_twokeys } 39 8 { return _s_variablekeys } 40 } 41 return _s_noop 42} 43 44proc _s_noop { a b } { return $b } 45proc _s_reversedata { a b } { return [reverse $b] } 46proc _s_truncdata { a b } { return [string range $b 1 end] } 47proc _s_concatkeydata { a b } { return $a$b } 48proc _s_concatdatakey { a b } { return $b$a } 49proc _s_reverseconcat { a b } { return [reverse $a$b] } 50proc _s_constant { a b } { return "constant-data" } 51proc _s_twokeys { a b } { return [list 1 2] } 52proc _s_variablekeys { a b } { 53 set rlen [string length $b] 54 set result {} 55 for {set i 0} {$i < $rlen} {incr i} { 56 lappend $result $i 57 } 58 return $result 59} 60 61# Should the check_secondary routines print lots of output? 62set verbose_check_secondaries 0 63 64# Given a primary database handle, a list of secondary handles, a 65# number of entries, and arrays of keys and data, verify that all 66# databases have what they ought to. 67proc check_secondaries { pdb sdbs nentries keyarr dataarr {pref "Check"} \ 68 {errp NONE} {errs NONE} {errsg NONE}} { 69 upvar $keyarr keys 70 upvar $dataarr data 71 global verbose_check_secondaries 72 73 if { [string compare $errp NONE] != 0 } { 74 upvar $errp errorp 75 } 76 set errorp 0 77 if { [string compare $errs NONE] != 0 } { 78 upvar $errs errors 79 } 80 set errors 0 81 if { [string compare $errsg NONE] != 0 } { 82 upvar $errsg errorsg 83 } 84 set errorsg 0 85 # Make sure each key/data pair is in the primary. 86 if { $verbose_check_secondaries } { 87 puts "\t\t$pref.1: Each key/data pair is in the primary" 88 } 89 for { set i 0 } { $i < $nentries } { incr i } { 90 if { [string equal $errp NONE] } { 91 error_check_good pdb_get($i) [$pdb get $keys($i)] \ 92 [list [list $keys($i) $data($i)]] 93 } else { 94 set stat [catch {$pdb get $keys($i)} ret] 95 if { $stat == 1 } { 96 set errorp $ret 97 break 98 } else { 99 error_check_good pdb_get($i) $ret \ 100 [list [list $keys($i) $data($i)]] 101 } 102 } 103 } 104 105 for { set j 0 } { $j < [llength $sdbs] } { incr j } { 106 # Make sure each key/data pair is in this secondary. 107 if { $verbose_check_secondaries } { 108 puts "\t\t$pref.2:\ 109 Each skey/key/data tuple is in secondary #$j" 110 } 111 set sdb [lindex $sdbs $j] 112 set nskeys 0 113 for { set i 0 } { $i < $nentries } { incr i } { 114 set skeys [[callback_n $j] $keys($i) $data($i)] 115 if { [llength $skeys] == 0 } { 116 set skeys [list $skeys] 117 } 118 foreach skey $skeys { 119 incr nskeys 120 # Check with pget on the secondary. 121 set stat [catch {$sdb pget -get_both \ 122 $skey $keys($i)} ret] 123 if { [string equal $errs NONE] } { 124 error_check_good stat $stat 0 125 error_check_good sdb($j)_pget($i) $ret \ 126 [list [list \ 127 $skey $keys($i) $data($i)]] 128 } else { 129 if { $stat == 1 } { 130 set errors $ret 131 } else { 132 error_check_good \ 133 sdb($j)_pget($i) $ret \ 134 [list [list \ 135 $skey $keys($i) $data($i)]] 136 } 137 } 138 # Check again with get on the secondary. Since 139 # get_both is not an allowed option with get on 140 # a secondary handle, we can't guarantee an 141 # exact match on method 5 and over. We just 142 # make sure that one of the returned key/data 143 # pairs is the right one. 144 if { $j >= 5 } { 145 error_check_good sdb($j)_get($i) \ 146 [is_substr [$sdb get $skey] \ 147 [list [list $skey $data($i)]]] 1 148 } else { 149 set stat [catch {$sdb get $skey} ret] 150 if { [string equal $errs NONE] } { 151 error_check_good \ 152 sdb($j)_get($i) $ret \ 153 [list [list \ 154 $skey $data($i)]] 155 } else { 156 if { $stat == 1 } { 157 set errorsg $ret 158 break 159 } else { 160 error_check_good \ 161 sdb($j)_get($i) \ 162 $ret [list [list \ 163 $skey $data($i)]] 164 } 165 } 166 } 167 # 168 # We couldn't break above because we need to 169 # execute the errorsg error as well. 170 # 171 if { $errors != 0 } { 172 break 173 } 174 } 175 } 176 if { $errors != 0 || $errorsg != 0 } { 177 break 178 } 179 180 # Make sure this secondary contains only $nskeys 181 # items. 182 if { $verbose_check_secondaries } { 183 puts "\t\t$pref.3: Secondary #$j has $nskeys items" 184 } 185 set dbc [$sdb cursor] 186 error_check_good dbc($i) \ 187 [is_valid_cursor $dbc $sdb] TRUE 188 for { set k 0 } { [llength [$dbc get -next]] > 0 } \ 189 { incr k } { } 190 error_check_good numitems($i) $k $nskeys 191 error_check_good dbc($i)_close [$dbc close] 0 192 } 193 if { $errorp != 0 || $errors != 0 || $errorsg != 0 } { 194 return 195 } 196 197 if { $verbose_check_secondaries } { 198 puts "\t\t$pref.4: Primary has $nentries items" 199 } 200 set dbc [$pdb cursor] 201 error_check_good pdbc [is_valid_cursor $dbc $pdb] TRUE 202 for { set k 0 } { [llength [$dbc get -next]] > 0 } { incr k } { } 203 error_check_good numitems $k $nentries 204 error_check_good pdbc_close [$dbc close] 0 205} 206 207# Given a primary database handle and a list of secondary handles, walk 208# through the primary and make sure all the secondaries are correct, 209# then walk through the secondaries and make sure the primary is correct. 210# 211# This is slightly less rigorous than the normal check_secondaries--we 212# use it whenever we don't have up-to-date "keys" and "data" arrays. 213proc cursor_check_secondaries { pdb sdbs nentries { pref "Check" } } { 214 global verbose_check_secondaries 215 216 # Make sure each key/data pair in the primary is in each secondary. 217 set pdbc [$pdb cursor] 218 error_check_good ccs_pdbc [is_valid_cursor $pdbc $pdb] TRUE 219 set i 0 220 if { $verbose_check_secondaries } { 221 puts "\t\t$pref.1:\ 222 Key/data in primary => key/data in secondaries" 223 } 224 225 for { set dbt [$pdbc get -first] } { [llength $dbt] > 0 } \ 226 { set dbt [$pdbc get -next] } { 227 incr i 228 set pkey [lindex [lindex $dbt 0] 0] 229 set pdata [lindex [lindex $dbt 0] 1] 230 for { set j 0 } { $j < [llength $sdbs] } { incr j } { 231 set sdb [lindex $sdbs $j] 232 # Check with pget. 233 foreach skey [[callback_n $j] $pkey $pdata] { 234 set sdbt [$sdb pget -get_both $skey $pkey] 235 error_check_good pkey($pkey,$j) \ 236 [lindex [lindex $sdbt 0] 1] $pkey 237 error_check_good pdata($pdata,$j) \ 238 [lindex [lindex $sdbt 0] 2] $pdata 239 } 240 } 241 } 242 error_check_good ccs_pdbc_close [$pdbc close] 0 243 error_check_good primary_has_nentries $i $nentries 244 245 for { set j 0 } { $j < [llength $sdbs] } { incr j } { 246 if { $verbose_check_secondaries } { 247 puts "\t\t$pref.2:\ 248 Key/data in secondary #$j => key/data in primary" 249 } 250 set sdb [lindex $sdbs $j] 251 set sdbc [$sdb cursor] 252 error_check_good ccs_sdbc($j) [is_valid_cursor $sdbc $sdb] TRUE 253 for { set dbt [$sdbc pget -first] } { [llength $dbt] > 0 } \ 254 { set dbt [$sdbc pget -next] } { 255 set pkey [lindex [lindex $dbt 0] 1] 256 set pdata [lindex [lindex $dbt 0] 2] 257 error_check_good pdb_get($pkey/$pdata,$j) \ 258 [$pdb get -get_both $pkey $pdata] \ 259 [list [list $pkey $pdata]] 260 } 261 262 # To exercise pget -last/pget -prev, we do it backwards too. 263 for { set dbt [$sdbc pget -last] } { [llength $dbt] > 0 } \ 264 { set dbt [$sdbc pget -prev] } { 265 set pkey [lindex [lindex $dbt 0] 1] 266 set pdata [lindex [lindex $dbt 0] 2] 267 error_check_good pdb_get_bkwds($pkey/$pdata,$j) \ 268 [$pdb get -get_both $pkey $pdata] \ 269 [list [list $pkey $pdata]] 270 } 271 272 error_check_good ccs_sdbc_close($j) [$sdbc close] 0 273 } 274} 275 276# The secondary index tests take a list of the access methods that 277# each array ought to use. Convert at one blow into a list of converted 278# argses and omethods for each method in the list. 279proc convert_argses { methods largs } { 280 set ret {} 281 foreach m $methods { 282 lappend ret [convert_args $m $largs] 283 } 284 return $ret 285} 286proc convert_methods { methods } { 287 set ret {} 288 foreach m $methods { 289 lappend ret [convert_method $m] 290 } 291 return $ret 292} 293