diff options
Diffstat (limited to 'db/test/si005.tcl')
| -rw-r--r-- | db/test/si005.tcl | 230 |
1 files changed, 93 insertions, 137 deletions
diff --git a/db/test/si005.tcl b/db/test/si005.tcl index 0cde6f539..e824c808d 100644 --- a/db/test/si005.tcl +++ b/db/test/si005.tcl @@ -1,179 +1,135 @@ - # See the file LICENSE for redistribution information. # -# Copyright (c) 2001-2002 +# Copyright (c) 2001-2003 # Sleepycat Software. All rights reserved. # -# Id: si005.tcl,v 11.4 2002/04/29 17:12:03 sandstro Exp +# $Id: si005.tcl,v 11.7 2003/01/08 05:53:28 bostic Exp $ # -# Sindex005: Secondary index and join test. -proc sindex005 { methods {nitems 1000} {tnum 5} args } { +# TEST si005 +# TEST Basic secondary index put/delete test with transactions +proc si005 { methods {nentries 200} {tnum "005"} args } { source ./include.tcl + global dict nsecondaries # Primary method/args. set pmethod [lindex $methods 0] set pargs [convert_args $pmethod $args] set pomethod [convert_method $pmethod] - # Sindex005 does a join within a simulated database schema - # in which the primary index maps a record ID to a ZIP code and - # name in the form "XXXXXname", and there are two secondaries: - # one mapping ZIP to ID, the other mapping name to ID. - # The primary may be of any database type; the two secondaries - # must be either btree or hash. - # Method/args for all the secondaries. If only one method - # was specified, assume the same method for the two secondaries. + # was specified, assume the same method and a standard N + # secondaries. set methods [lrange $methods 1 end] if { [llength $methods] == 0 } { - for { set i 0 } { $i < 2 } { incr i } { + for { set i 0 } { $i < $nsecondaries } { incr i } { lappend methods $pmethod } - } elseif { [llength $methods] != 2 } { - puts "FAIL: Sindex00$tnum requires exactly two secondaries." + } + + # Since this is a transaction test, don't allow nentries to be large. + if { $nentries > 1000 } { + puts "Skipping si005 for large lists (over 1000 items)." return } set argses [convert_argses $methods $args] set omethods [convert_methods $methods] - puts "Sindex00$tnum ($pmethod/$methods) Secondary index join test." + puts "Si$tnum ($pmethod/$methods) $nentries equal key/data pairs" + puts " with transactions" env_cleanup $testdir - set pname "sindex00$tnum-primary.db" - set zipname "sindex00$tnum-zip.db" - set namename "sindex00$tnum-name.db" + set pname "primary$tnum.db" + set snamebase "secondary$tnum" # Open an environment # XXX if one is not supplied! - set env [berkdb_env -create -home $testdir] + set env [berkdb_env -create -home $testdir -txn] error_check_good env_open [is_valid_env $env] TRUE - # Open the databases. - set pdb [eval {berkdb_open -create -env} $env $pomethod $pargs $pname] + # Open the primary. + set pdb [eval {berkdb_open -create -auto_commit -env} $env $pomethod \ + $pargs $pname] error_check_good primary_open [is_valid_db $pdb] TRUE - set zipdb [eval {berkdb_open -create -dup -env} $env \ - [lindex $omethods 0] [lindex $argses 0] $zipname] - error_check_good zip_open [is_valid_db $zipdb] TRUE - error_check_good zip_associate [$pdb associate s5_getzip $zipdb] 0 - - set namedb [eval {berkdb_open -create -dup -env} $env \ - [lindex $omethods 1] [lindex $argses 1] $namename] - error_check_good name_open [is_valid_db $namedb] TRUE - error_check_good name_associate [$pdb associate s5_getname $namedb] 0 - - puts "\tSindex00$tnum.a: Populate database with $nitems \"names\"" - s5_populate $pdb $nitems - puts "\tSindex00$tnum.b: Perform a join on each \"name\" and \"ZIP\"" - s5_jointest $pdb $zipdb $namedb - - error_check_good name_close [$namedb close] 0 - error_check_good zip_close [$zipdb close] 0 - error_check_good primary_close [$pdb close] 0 - error_check_good env_close [$env close] 0 -} + # Open and associate the secondaries + set sdbs {} + for { set i 0 } { $i < [llength $omethods] } { incr i } { + set sdb [eval {berkdb_open -create -auto_commit -env} $env \ + [lindex $omethods $i] [lindex $argses $i] $snamebase.$i.db] + error_check_good second_open($i) [is_valid_db $sdb] TRUE -proc s5_jointest { pdb zipdb namedb } { - set pdbc [$pdb cursor] - error_check_good pdb_cursor [is_valid_cursor $pdbc $pdb] TRUE - for { set dbt [$pdbc get -first] } { [llength $dbt] > 0 } \ - { set dbt [$pdbc get -next] } { - set item [lindex [lindex $dbt 0] 1] - set retlist [s5_dojoin $item $pdb $zipdb $namedb] + error_check_good db_associate($i) \ + [$pdb associate -auto_commit [callback_n $i] $sdb] 0 + lappend sdbs $sdb } -} - -proc s5_dojoin { item pdb zipdb namedb } { - set name [s5_getname "" $item] - set zip [s5_getzip "" $item] - - set zipc [$zipdb cursor] - error_check_good zipc($item) [is_valid_cursor $zipc $zipdb] TRUE - - set namec [$namedb cursor] - error_check_good namec($item) [is_valid_cursor $namec $namedb] TRUE - - set pc [$pdb cursor] - error_check_good pc($item) [is_valid_cursor $pc $pdb] TRUE - - set ret [$zipc get -set $zip] - set zd [lindex [lindex $ret 0] 1] - error_check_good zipset($zip) [s5_getzip "" $zd] $zip - - set ret [$namec get -set $name] - set nd [lindex [lindex $ret 0] 1] - error_check_good nameset($name) [s5_getname "" $nd] $name - - set joinc [$pdb join $zipc $namec] - - set anyreturned 0 - for { set dbt [$joinc get] } { [llength $dbt] > 0 } \ - { set dbt [$joinc get] } { - set ritem [lindex [lindex $dbt 0] 1] - error_check_good returned_item($item) $ritem $item - incr anyreturned - } - error_check_bad anyreturned($item) $anyreturned 0 - - error_check_good joinc_close($item) [$joinc close] 0 - error_check_good pc_close($item) [$pc close] 0 - error_check_good namec_close($item) [$namec close] 0 - error_check_good zipc_close($item) [$zipc close] 0 -} - -proc s5_populate { db nitems } { - global dict + puts "\tSi$tnum.a: Put loop" set did [open $dict] - for { set i 1 } { $i <= $nitems } { incr i } { - gets $did word - if { [string length $word] < 3 } { - gets $did word - if { [string length $word] < 3 } { - puts "FAIL:\ - unexpected pair of words < 3 chars long" - } - } - set datalist [s5_name2zips $word] - foreach data $datalist { - error_check_good db_put($data) [$db put $i $data$word] 0 + for { set n 0 } { [gets $did str] != -1 && $n < $nentries } { incr n } { + if { [is_record_based $pmethod] == 1 } { + set key [expr $n + 1] + set datum $str + } else { + set key $str + gets $did datum } + set keys($n) $key + set data($n) [pad_data $pmethod $datum] + + set txn [$env txn] + set ret [eval {$pdb put} -txn $txn \ + {$key [chop_data $pmethod $datum]}] + error_check_good put($n) $ret 0 + error_check_good txn_commit($n) [$txn commit] 0 } close $did -} - -proc s5_getzip { key data } { return [string range $data 0 4] } -proc s5_getname { key data } { return [string range $data 5 end] } - -# The dirty secret of this test is that the ZIP code is a function of the -# name, so we can generate a database and then verify join results easily -# without having to consult actual data. -# -# Any word passed into this function will generate from 1 to 26 ZIP -# entries, out of the set {00000, 01000 ... 99000}. The number of entries -# is just the position in the alphabet of the word's first letter; the -# entries are then hashed to the set {00, 01 ... 99} N different ways. -proc s5_name2zips { name } { - global alphabet - - set n [expr [string first [string index $name 0] $alphabet] + 1] - error_check_bad starts_with_abc($name) $n -1 - - set ret {} - for { set i 0 } { $i < $n } { incr i } { - set b 0 - for { set j 1 } { $j < [string length $name] } \ - { incr j } { - set b [s5_nhash $name $i $j $b] - } - lappend ret [format %05u [expr $b % 100]000] + check_secondaries $pdb $sdbs $nentries keys data "Si$tnum.a" + + puts "\tSi$tnum.b: Put/overwrite loop" + for { set n 0 } { $n < $nentries } { incr n } { + set newd $data($n).$keys($n) + + set txn [$env txn] + set ret [eval {$pdb put} -txn $txn \ + {$keys($n) [chop_data $pmethod $newd]}] + error_check_good put_overwrite($n) $ret 0 + set data($n) [pad_data $pmethod $newd] + error_check_good txn_commit($n) [$txn commit] 0 } - return $ret -} -proc s5_nhash { name i j b } { - global alphabet + check_secondaries $pdb $sdbs $nentries keys data "Si$tnum.b" + + # Delete the second half of the entries through the primary. + # We do the second half so we can just pass keys(0 ... n/2) + # to check_secondaries. + set half [expr $nentries / 2] + puts "\tSi$tnum.c: Primary delete loop: deleting $half entries" + for { set n $half } { $n < $nentries } { incr n } { + set txn [$env txn] + set ret [$pdb del -txn $txn $keys($n)] + error_check_good pdel($n) $ret 0 + error_check_good txn_commit($n) [$txn commit] 0 + } + check_secondaries $pdb $sdbs $half keys data "Si$tnum.c" + + # Delete half of what's left, through the first secondary. + set quar [expr $half / 2] + puts "\tSi$tnum.d: Secondary delete loop: deleting $quar entries" + set sdb [lindex $sdbs 0] + set callback [callback_n 0] + for { set n $quar } { $n < $half } { incr n } { + set skey [$callback $keys($n) [pad_data $pmethod $data($n)]] + set txn [$env txn] + set ret [$sdb del -txn $txn $skey] + error_check_good sdel($n) $ret 0 + error_check_good txn_commit($n) [$txn commit] 0 + } + check_secondaries $pdb $sdbs $quar keys data "Si$tnum.d" - set c [string first [string index $name $j] $alphabet'] - return [expr (($b * 991) + ($i * 997) + $c) % 10000000] + puts "\tSi$tnum.e: Closing/disassociating primary first" + error_check_good primary_close [$pdb close] 0 + foreach sdb $sdbs { + error_check_good secondary_close [$sdb close] 0 + } + error_check_good env_close [$env close] 0 } |