diff options
Diffstat (limited to 'bdb/test/test026.tcl')
| -rw-r--r-- | bdb/test/test026.tcl | 67 |
1 files changed, 55 insertions, 12 deletions
diff --git a/bdb/test/test026.tcl b/bdb/test/test026.tcl index 6c19c60a2e5..ce65e925d35 100644 --- a/bdb/test/test026.tcl +++ b/bdb/test/test026.tcl @@ -1,14 +1,18 @@ # See the file LICENSE for redistribution information. # -# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Copyright (c) 1996-2002 # Sleepycat Software. All rights reserved. # -# $Id: test026.tcl,v 11.13 2000/11/17 19:07:51 sue Exp $ +# $Id: test026.tcl,v 11.20 2002/06/11 14:09:56 sue Exp $ # -# DB Test 26 {access method} -# Keyed delete test through cursor. -# If ndups is small; this will test on-page dups; if it's large, it -# will test off-page dups. +# TEST test026 +# TEST Small keys/medium data w/duplicates +# TEST Put/get per key. +# TEST Loop through keys -- delete each key +# TEST ... test that cursors delete duplicates correctly +# TEST +# TEST Keyed delete test through cursor. If ndups is small; this will +# TEST test on-page dups; if it's large, it will test off-page dups. proc test026 { method {nentries 2000} {ndups 5} {tnum 26} args} { source ./include.tcl @@ -20,10 +24,8 @@ proc test026 { method {nentries 2000} {ndups 5} {tnum 26} args} { puts "Test0$tnum skipping for method $method" return } - puts "Test0$tnum: $method ($args) $nentries keys\ - with $ndups dups; cursor delete test" - # Create the database and open the dictionary + set txnenv 0 set eindex [lsearch -exact $args "-env"] # # If we are using an env, then testfile should just be the db name. @@ -35,8 +37,25 @@ proc test026 { method {nentries 2000} {ndups 5} {tnum 26} args} { set testfile test0$tnum.db incr eindex set env [lindex $args $eindex] + set txnenv [is_txnenv $env] + if { $txnenv == 1 } { + append args " -auto_commit " + # + # If we are using txns and running with the + # default, set the defaults down a bit. + # If we are wanting a lot of dups, set that + # down a bit or repl testing takes very long. + # + if { $nentries == 2000 } { + set nentries 100 + } + reduce_dups nentries ndups + } + set testdir [get_home $env] } cleanup $testdir $env + puts "Test0$tnum: $method ($args) $nentries keys\ + with $ndups dups; cursor delete test" set pflags "" set gflags "" @@ -46,16 +65,24 @@ proc test026 { method {nentries 2000} {ndups 5} {tnum 26} args} { # Here is the loop where we put and get each key/data pair puts "\tTest0$tnum.a: Put loop" - set db [eval {berkdb_open -create -truncate \ + set db [eval {berkdb_open -create \ -mode 0644} $args {$omethod -dup $testfile}] error_check_good dbopen [is_valid_db $db] TRUE set did [open $dict] while { [gets $did str] != -1 && $count < [expr $nentries * $ndups] } { set datastr [ make_data_str $str ] for { set j 1 } { $j <= $ndups} {incr j} { - set ret [eval {$db put} \ - $txn $pflags {$str [chop_data $method $j$datastr]}] + 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 $pflags {$str [chop_data $method $j$datastr]}] error_check_good db_put $ret 0 + if { $txnenv == 1 } { + error_check_good txn [$t commit] 0 + } incr count } } @@ -68,6 +95,11 @@ proc test026 { method {nentries 2000} {ndups 5} {tnum 26} args} { # Now we will sequentially traverse the database getting each # item and deleting it. set count 0 + if { $txnenv == 1 } { + set t [$env txn] + error_check_good txn [is_valid_txn $t $env] TRUE + set txn "-txn $t" + } set dbc [eval {$db cursor} $txn] error_check_good db_cursor [is_substr $dbc $db] 1 @@ -97,16 +129,27 @@ proc test026 { method {nentries 2000} {ndups 5} {tnum 26} args} { error_check_good db_del:$key $ret 0 } error_check_good dbc_close [$dbc close] 0 + if { $txnenv == 1 } { + error_check_good txn [$t commit] 0 + } error_check_good db_close [$db close] 0 puts "\tTest0$tnum.c: Verify empty file" # Double check that file is now empty set db [eval {berkdb_open} $args $testfile] error_check_good dbopen [is_valid_db $db] TRUE + if { $txnenv == 1 } { + set t [$env txn] + error_check_good txn [is_valid_txn $t $env] TRUE + set txn "-txn $t" + } set dbc [eval {$db cursor} $txn] error_check_good db_cursor [is_substr $dbc $db] 1 set ret [$dbc get -first] error_check_good get_on_empty [string length $ret] 0 error_check_good dbc_close [$dbc close] 0 + if { $txnenv == 1 } { + error_check_good txn [$t commit] 0 + } error_check_good db_close [$db close] 0 } |