diff options
Diffstat (limited to 'bdb/test/sdb011.tcl')
| -rw-r--r-- | bdb/test/sdb011.tcl | 143 |
1 files changed, 143 insertions, 0 deletions
diff --git a/bdb/test/sdb011.tcl b/bdb/test/sdb011.tcl new file mode 100644 index 00000000000..862e32f73ed --- /dev/null +++ b/bdb/test/sdb011.tcl @@ -0,0 +1,143 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999-2002 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb011.tcl,v 11.9 2002/07/11 18:53:47 sandstro Exp $ +# +# TEST subdb011 +# TEST Test deleting Subdbs with overflow pages +# TEST Create 1 db with many large subdbs. +# TEST Test subdatabases with overflow pages. +proc subdb011 { method {ndups 13} {nsubdbs 10} args} { + global names + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_queue $method] == 1 || [is_fixed_length $method] == 1 } { + puts "Subdb011: skipping for method $method" + return + } + set txnenv 0 + set envargs "" + set max_files 0 + set eindex [lsearch -exact $args "-env"] + # + # If we are using an env, then testfile should just be the db name. + # Otherwise it is the test directory and the name. + if { $eindex == -1 } { + set testfile $testdir/subdb011.db + set env NULL + set tfpath $testfile + } else { + set testfile subdb011.db + incr eindex + set env [lindex $args $eindex] + set envargs " -env $env " + set txnenv [is_txnenv $env] + if { $txnenv == 1 } { + append args " -auto_commit " + append envargs " -auto_commit " + set max_files 50 + if { $ndups == 13 } { + set ndups 7 + } + } + set testdir [get_home $env] + set tfpath $testdir/$testfile + } + + # Create the database and open the dictionary + + cleanup $testdir $env + set txn "" + + # Here is the loop where we put and get each key/data pair + set file_list [get_file_list] + if { $max_files != 0 && [llength $file_list] > $max_files } { + set fend [expr $max_files - 1] + set file_list [lrange $file_list 0 $fend] + } + set flen [llength $file_list] + puts "Subdb011: $method ($args) $ndups overflow dups with \ + $flen filename=key filecontents=data pairs" + + puts "\tSubdb011.a: Create each of $nsubdbs subdbs and dups" + set slist {} + set i 0 + set count 0 + foreach f $file_list { + set i [expr $i % $nsubdbs] + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + set names([expr $count + 1]) $f + } else { + set key $f + } + # Should really catch errors + set fid [open $f r] + fconfigure $fid -translation binary + set filecont [read $fid] + set subdb subdb$i + lappend slist $subdb + close $fid + set db [eval {berkdb_open -create -mode 0644} \ + $args {$omethod $testfile $subdb}] + error_check_good dbopen [is_valid_db $db] TRUE + for {set dup 0} {$dup < $ndups} {incr dup} { + set data $dup:$filecont + if { $txnenv == 1 } { + set t [$env txn] + error_check_good txn [is_valid_txn $t $env] TRUE + set txn "-txn $t" + } + set ret [eval {$db put} $txn {$key \ + [chop_data $method $data]}] + error_check_good put $ret 0 + if { $txnenv == 1 } { + error_check_good txn [$t commit] 0 + } + } + error_check_good dbclose [$db close] 0 + incr i + incr count + } + + puts "\tSubdb011.b: Verify overflow pages" + foreach subdb $slist { + set db [eval {berkdb_open -create -mode 0644} \ + $args {$omethod $testfile $subdb}] + error_check_good dbopen [is_valid_db $db] TRUE + set stat [$db stat] + + # What everyone else calls overflow pages, hash calls "big + # pages", so we need to special-case hash here. (Hash + # overflow pages are additional pages after the first in a + # bucket.) + if { [string compare [$db get_type] hash] == 0 } { + error_check_bad overflow \ + [is_substr $stat "{{Number of big pages} 0}"] 1 + } else { + error_check_bad overflow \ + [is_substr $stat "{{Overflow pages} 0}"] 1 + } + error_check_good dbclose [$db close] 0 + } + + puts "\tSubdb011.c: Delete subdatabases" + for {set i $nsubdbs} {$i > 0} {set i [expr $i - 1]} { + # + # Randomly delete a subdatabase + set sindex [berkdb random_int 0 [expr $i - 1]] + set subdb [lindex $slist $sindex] + # + # Delete the one we did from the list + set slist [lreplace $slist $sindex $sindex] + error_check_good file_exists_before [file exists $tfpath] 1 + error_check_good db_remove [eval {berkdb dbremove} $envargs \ + {$testfile $subdb}] 0 + } +} + |