global nsecondaries
set nsecondaries 2
proc sindex { {verbose 0} args } {
global verbose_check_secondaries
set verbose_check_secondaries $verbose
foreach n { 200 5000 } {
foreach pm { btree hash recno frecno queue queueext } {
foreach sm { dbtree dhash ddbtree ddhash btree hash } {
sindex001 [list $pm $sm $sm] $n
sindex002 [list $pm $sm $sm] $n
if { $n < 1000 } {
sindex003 [list $pm $sm $sm] $n
sindex004 [list $pm $sm $sm] $n
}
sindex006 [list $pm $sm $sm] $n
}
}
}
foreach pm { btree hash recno } {
foreach sm { btree hash } {
sindex005 [list $pm $sm $sm] 1000
}
sindex005 [list $pm btree hash] 1000
sindex005 [list $pm hash btree] 1000
}
foreach pm { btree hash } {
set methlist [list $pm]
for { set i 0 } { $i < 50 } { incr i } {
if { $i % 2 == 0 } {
lappend methlist "dbtree"
} else {
lappend methlist "ddbtree"
}
}
sindex001 $methlist 500
sindex002 $methlist 500
sindex003 $methlist 500
sindex004 $methlist 500
}
}
proc callback_n { n } {
switch $n {
0 { return _s_reversedata }
1 { return _s_noop }
2 { return _s_concatkeydata }
3 { return _s_concatdatakey }
4 { return _s_reverseconcat }
5 { return _s_truncdata }
6 { return _s_alwayscocacola }
}
return _s_noop
}
proc _s_reversedata { a b } { return [reverse $b] }
proc _s_truncdata { a b } { return [string range $b 1 end] }
proc _s_concatkeydata { a b } { return $a$b }
proc _s_concatdatakey { a b } { return $b$a }
proc _s_reverseconcat { a b } { return [reverse $a$b] }
proc _s_alwayscocacola { a b } { return "Coca-Cola" }
proc _s_noop { a b } { return $b }
set verbose_check_secondaries 0
proc check_secondaries { pdb sdbs nentries keyarr dataarr {pref "Check"} } {
upvar $keyarr keys
upvar $dataarr data
global verbose_check_secondaries
if { $verbose_check_secondaries } {
puts "\t\t$pref.1: Each key/data pair is in the primary"
}
for { set i 0 } { $i < $nentries } { incr i } {
error_check_good pdb_get($i) [$pdb get $keys($i)] \
[list [list $keys($i) $data($i)]]
}
for { set j 0 } { $j < [llength $sdbs] } { incr j } {
if { $verbose_check_secondaries } {
puts "\t\t$pref.2:\
Each skey/key/data tuple is in secondary #$j"
}
for { set i 0 } { $i < $nentries } { incr i } {
set sdb [lindex $sdbs $j]
set skey [[callback_n $j] $keys($i) $data($i)]
error_check_good sdb($j)_pget($i) \
[$sdb pget -get_both $skey $keys($i)] \
[list [list $skey $keys($i) $data($i)]]
}
if { $verbose_check_secondaries } {
puts "\t\t$pref.3: Secondary #$j has $nentries items"
}
set dbc [$sdb cursor]
error_check_good dbc($i) \
[is_valid_cursor $dbc $sdb] TRUE
for { set k 0 } { [llength [$dbc get -next]] > 0 } \
{ incr k } { }
error_check_good numitems($i) $k $nentries
error_check_good dbc($i)_close [$dbc close] 0
}
if { $verbose_check_secondaries } {
puts "\t\t$pref.4: Primary has $nentries items"
}
set dbc [$pdb cursor]
error_check_good pdbc [is_valid_cursor $dbc $pdb] TRUE
for { set k 0 } { [llength [$dbc get -next]] > 0 } { incr k } { }
error_check_good numitems $k $nentries
error_check_good pdbc_close [$dbc close] 0
}
proc cursor_check_secondaries { pdb sdbs nentries { pref "Check" } } {
global verbose_check_secondaries
set pdbc [$pdb cursor]
error_check_good ccs_pdbc [is_valid_cursor $pdbc $pdb] TRUE
set i 0
if { $verbose_check_secondaries } {
puts "\t\t$pref.1:\
Key/data in primary => key/data in secondaries"
}
for { set dbt [$pdbc get -first] } { [llength $dbt] > 0 } \
{ set dbt [$pdbc get -next] } {
incr i
set pkey [lindex [lindex $dbt 0] 0]
set pdata [lindex [lindex $dbt 0] 1]
for { set j 0 } { $j < [llength $sdbs] } { incr j } {
set sdb [lindex $sdbs $j]
set sdbt [$sdb pget -get_both \
[[callback_n $j] $pkey $pdata] $pkey]
error_check_good pkey($pkey,$j) \
[lindex [lindex $sdbt 0] 1] $pkey
error_check_good pdata($pdata,$j) \
[lindex [lindex $sdbt 0] 2] $pdata
}
}
error_check_good ccs_pdbc_close [$pdbc close] 0
error_check_good primary_has_nentries $i $nentries
for { set j 0 } { $j < [llength $sdbs] } { incr j } {
if { $verbose_check_secondaries } {
puts "\t\t$pref.2:\
Key/data in secondary #$j => key/data in primary"
}
set sdb [lindex $sdbs $j]
set sdbc [$sdb cursor]
error_check_good ccs_sdbc($j) [is_valid_cursor $sdbc $sdb] TRUE
set i 0
for { set dbt [$sdbc pget -first] } { [llength $dbt] > 0 } \
{ set dbt [$sdbc pget -next] } {
incr i
set pkey [lindex [lindex $dbt 0] 1]
set pdata [lindex [lindex $dbt 0] 2]
error_check_good pdb_get($pkey/$pdata,$j) \
[$pdb get -get_both $pkey $pdata] \
[list [list $pkey $pdata]]
}
error_check_good secondary($j)_has_nentries $i $nentries
set i 0
for { set dbt [$sdbc pget -last] } { [llength $dbt] > 0 } \
{ set dbt [$sdbc pget -prev] } {
incr i
set pkey [lindex [lindex $dbt 0] 1]
set pdata [lindex [lindex $dbt 0] 2]
error_check_good pdb_get_bkwds($pkey/$pdata,$j) \
[$pdb get -get_both $pkey $pdata] \
[list [list $pkey $pdata]]
}
error_check_good secondary($j)_has_nentries_bkwds $i $nentries
error_check_good ccs_sdbc_close($j) [$sdbc close] 0
}
}
proc convert_argses { methods largs } {
set ret {}
foreach m $methods {
lappend ret [convert_args $m $largs]
}
return $ret
}
proc convert_methods { methods } {
set ret {}
foreach m $methods {
lappend ret [convert_method $m]
}
return $ret
}