diff options
Diffstat (limited to 'bdb/test/sdb004.tcl')
-rw-r--r-- | bdb/test/sdb004.tcl | 88 |
1 files changed, 75 insertions, 13 deletions
diff --git a/bdb/test/sdb004.tcl b/bdb/test/sdb004.tcl index fb63f9d6d1d..d3d95f1fde0 100644 --- a/bdb/test/sdb004.tcl +++ b/bdb/test/sdb004.tcl @@ -1,15 +1,23 @@ # See the file LICENSE for redistribution information. # -# Copyright (c) 1999, 2000 +# Copyright (c) 1999-2002 # Sleepycat Software. All rights reserved. # -# $Id: sdb004.tcl,v 11.14 2000/08/25 14:21:53 sue Exp $ +# $Id: sdb004.tcl,v 11.22 2002/07/11 18:53:45 sandstro Exp $ # -# SubDB Test 4 {access method} -# Create 1 db with many large subdbs. Use the contents as subdb names. -# Take the source files and dbtest executable and enter their names as the -# key with their contents as data. After all are entered, retrieve all; -# compare output to original. Close file, reopen, do retrieve and re-verify. +# TEST subdb004 +# TEST Tests large subdb names +# TEST subdb name = filecontents, +# TEST key = filename, data = filecontents +# TEST Put/get per key +# TEST Dump file +# TEST Dump subdbs, verify data and subdb name match +# TEST +# TEST Create 1 db with many large subdbs. Use the contents as subdb names. +# TEST Take the source files and dbtest executable and enter their names as +# TEST the key with their contents as data. After all are entered, retrieve +# TEST all; compare output to original. Close file, reopen, do retrieve and +# TEST re-verify. proc subdb004 { method args} { global names source ./include.tcl @@ -25,14 +33,34 @@ proc subdb004 { method args} { puts "Subdb004: $method ($args) \ filecontents=subdbname filename=key filecontents=data pairs" + set txnenv 0 + set envargs "" + 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/subdb004.db + set env NULL + } else { + set testfile subdb004.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 testdir [get_home $env] + } # Create the database and open the dictionary - set testfile $testdir/subdb004.db set t1 $testdir/t1 set t2 $testdir/t2 set t3 $testdir/t3 set t4 $testdir/t4 - cleanup $testdir NULL + cleanup $testdir $env set pflags "" set gflags "" set txn "" @@ -44,8 +72,14 @@ proc subdb004 { method args} { } # Here is the loop where we put and get each key/data pair - set file_list [glob ../*/*.c ./libdb.so.3.0 ./libtool ./libtool.exe] + # Note that the subdatabase name is passed in as a char *, not + # in a DBT, so it may not contain nulls; use only source files. + set file_list [glob $src_root/*/*.c] set fcount [llength $file_list] + if { $txnenv == 1 && $fcount > 100 } { + set file_list [lrange $file_list 0 99] + set fcount 100 + } set count 0 if { [is_record_based $method] == 1 } { @@ -79,9 +113,17 @@ proc subdb004 { method args} { set db [eval {berkdb_open -create -mode 0644} \ $args {$omethod $testfile $subdb}] 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 ret [eval \ {$db put} $txn $pflags {$key [chop_data $method $data]}] error_check_good put $ret 0 + if { $txnenv == 1 } { + error_check_good txn [$t commit] 0 + } # Should really catch errors set fid [open $t4 w] @@ -104,7 +146,15 @@ proc subdb004 { method args} { # Now we will get each key from the DB and compare the results # to the original. # puts "\tSubdb004.b: dump file" + if { $txnenv == 1 } { + set t [$env txn] + error_check_good txn [is_valid_txn $t $env] TRUE + set txn "-txn $t" + } dump_bin_file $db $txn $t1 $checkfunc + if { $txnenv == 1 } { + error_check_good txn [$t commit] 0 + } error_check_good db_close [$db close] 0 } @@ -114,21 +164,30 @@ proc subdb004 { method args} { # as the data in that subdb and that the filename is the key. # puts "\tSubdb004.b: Compare subdb names with key/data" - set db [berkdb_open -rdonly $testfile] + set db [eval {berkdb_open -rdonly} $envargs {$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 c [eval {$db cursor} $txn] error_check_good db_cursor [is_valid_cursor $c $db] TRUE for {set d [$c get -first] } { [llength $d] != 0 } \ {set d [$c get -next] } { set subdbname [lindex [lindex $d 0] 0] - set subdb [berkdb_open $testfile $subdbname] + set subdb [eval {berkdb_open} $args {$testfile $subdbname}] error_check_good dbopen [is_valid_db $db] TRUE # Output the subdb name set ofid [open $t3 w] fconfigure $ofid -translation binary - set subdbname [string trimright $subdbname \0] + if { [string compare "\0" \ + [string range $subdbname end end]] == 0 } { + set slen [expr [string length $subdbname] - 2] + set subdbname [string range $subdbname 1 $slen] + } puts -nonewline $ofid $subdbname close $ofid @@ -154,6 +213,9 @@ proc subdb004 { method args} { error_check_good db_close [$subdb close] 0 } error_check_good curs_close [$c close] 0 + if { $txnenv == 1 } { + error_check_good txn [$t commit] 0 + } error_check_good db_close [$db close] 0 if { [is_record_based $method] != 1 } { |