diff options
Diffstat (limited to 'bdb/test')
169 files changed, 39783 insertions, 0 deletions
diff --git a/bdb/test/TESTS b/bdb/test/TESTS new file mode 100644 index 00000000000..a585bdddcde --- /dev/null +++ b/bdb/test/TESTS @@ -0,0 +1,448 @@ +# $Id: TESTS,v 11.34 2000/11/06 19:31:56 sue Exp $ + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Access method tests +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +test001 Small keys/data + Put/get per key + Dump file + Close, reopen + Dump file + +test002 Small keys/medium data + Put/get per key + Dump file + Close, reopen + Dump file + +test003 Small keys/large data + Put/get per key + Dump file + Close, reopen + Dump file + +test004 Small keys/medium data + Put/get per key + Sequential (cursor) get/delete + +test005 Small keys/medium data + Put/get per key + Close, reopen + Sequential (cursor) get/delete + +test006 Small keys/medium data + Put/get per key + Keyed delete and verify + +test007 Small keys/medium data + Put/get per key + Close, reopen + Keyed delete + +test008 Small keys/large data + Put/get per key + Loop through keys by steps (which change) + ... delete each key at step + ... add each key back + ... change step + Confirm that overflow pages are getting reused + +test009 Small keys/large data + Same as test008; close and reopen database + +test010 Duplicate test + Small key/data pairs. + +test011 Duplicate test + Small key/data pairs. + Test DB_KEYFIRST, DB_KEYLAST, DB_BEFORE and DB_AFTER. + To test off-page duplicates, run with small pagesize. + +test012 Large keys/small data + Same as test003 except use big keys (source files and + executables) and small data (the file/executable names). + +test013 Partial put test + Overwrite entire records using partial puts. Make sure + that NOOVERWRITE flag works. + +test014 Exercise partial puts on short data + Run 5 combinations of numbers of characters to replace, + and number of times to increase the size by. + +test015 Partial put test + Partial put test where the key does not initially exist. + +test016 Partial put test + Partial put where the datum gets shorter as a result of + the put. + +test017 Basic offpage duplicate test. + +test018 Offpage duplicate test + Key_{first,last,before,after} offpage duplicates. + +test019 Partial get test. + +test020 In-Memory database tests. + +test021 Btree range tests. + +test022 Test of DB->getbyteswapped(). + +test023 Duplicate test + Exercise deletes and cursor operations within a + duplicate set. + +test024 Record number retrieval test. + +test025 DB_APPEND flag test. + +test026 Small keys/medium data w/duplicates + Put/get per key. + Loop through keys -- delete each key + ... test that cursors delete duplicates correctly + +test027 Off-page duplicate test + Test026 with parameters to force off-page duplicates. + +test028 Cursor delete test + Test put operations after deleting through a cursor. + +test029 Record renumbering + +test030 DB_NEXT_DUP functionality + +test031 Duplicate sorting functionality + Make sure DB_NODUPDATA works. + +test032 DB_GET_BOTH + +test033 DB_GET_BOTH without comparison function + +test034 Test032 with off-page duplicates + +test035 Test033 with off-page duplicates + +test036 Test KEYFIRST and KEYLAST when the key doesn't exist + +test037 Test DB_RMW + +test038 DB_GET_BOTH on deleted items + +test039 DB_GET_BOTH on deleted items without comparison function + +test040 Test038 with off-page duplicates + +test041 Test039 with off-page duplicates + +test042 Concurrent Data Store test + +test043 Recno renumbering and implicit creation test + +test044 Small system integration tests + Test proper functioning of the checkpoint daemon, + recovery, transactions, etc. + +test045 Small random tester + Runs a number of random add/delete/retrieve operations. + Tests both successful conditions and error conditions. + +test046 Overwrite test of small/big key/data with cursor checks. + +test047 Cursor get test with SET_RANGE option. + +test048 Cursor stability across Btree splits. + +test049 Cursor operations on unitialized cursors. + +test050 Cursor overwrite test for Recno. + +test051 Fixed-length record Recno test. + +test052 Renumbering record Recno test. + +test053 DB_REVSPLITOFF flag test + +test054 Cursor maintenance during key/data deletion. + +test054 Basic cursor operations. + +test055 Cursor maintenance during key deletes. + +test056 Cursor maintenance during deletes. + +test057 Cursor maintenance during key deletes. + +test058 Verify that deleting and reading duplicates results in + correct ordering. + +test059 Cursor ops work with a partial length of 0. + +test060 Test of the DB_EXCL flag to DB->open(). + +test061 Test of txn abort and commit for in-memory databases. + +test062 Test of partial puts (using DB_CURRENT) onto duplicate pages. + +test063 Test of the DB_RDONLY flag to DB->open + +test064 Test of DB->get_type + +test065 Test of DB->stat(DB_RECORDCOUNT) + +test066 Test of cursor overwrites of DB_CURRENT w/ duplicates. + +test067 Test of DB_CURRENT partial puts onto almost empty duplicate + pages, with and without DB_DUP_SORT. + +test068 Test of DB_BEFORE and DB_AFTER with partial puts. + +test069 Test of DB_CURRENT partial puts without duplicates-- + test067 w/ small ndups. + +test070 Test of DB_CONSUME (Four consumers, 1000 items.) + +test071 Test of DB_CONSUME (One consumer, 10000 items.) + +test072 Cursor stability test when dups are moved off-page + +test073 Test of cursor stability on duplicate pages. + +test074 Test of DB_NEXT_NODUP. + +test075 Test of DB->rename(). + (formerly test of DB_TRUNCATE cached page invalidation [#1487]) + +test076 Test creation of many small databases in a single environment. + [#1528]. + +test077 Test of DB_GET_RECNO [#1206]. + +test078 Test of DBC->c_count(). + +test079 Test of deletes in large trees. (test006 w/ sm. pagesize). + +test080 Test of DB->remove() + +test081 Test off-page duplicates and overflow pages together with + very large keys (key/data as file contents). + +test082 Test of DB_PREV_NODUP (uses test074). + +test083 Test of DB->key_range. + +test084 Sanity test of large (64K) pages. + +test085 Test of cursor behavior when a cursor is pointing to a deleted + btree key which then has duplicates added. [#2473] + +test086 Test of cursor stability across btree splits/rsplits with + subtransaction aborts (a variant of test048). [#2373] + + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Cursor Join. +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +jointest Test duplicate assisted joins. + Executes 1, 2, 3 and 4-way joins with differing + index orders and selectivity. + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Deadlock detection. +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +dead001 Use two different configurations to test deadlock + detection among a variable number of processes. One + configuration has the processes deadlocked in a ring. + The other has the processes all deadlocked on a single + resource. + +dead002 Same test as dead001, but use "detect on every collision" + instead of separate deadlock detector. + +dead003 Same test as dead002, but explicitly specify oldest or + youngest. Verify the correct lock was aborted/granted. + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Lock tests +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +lock001 Basic lock test, gets/puts. Contention without waiting. + +lock002 Multi-process lock tests. + +lock003 Multiprocess random lock test. + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Logging test +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +log001 Read/write log records. + +log002 Tests multiple logs + Log truncation + lsn comparison and file functionality. + +log003 Verify that log_flush is flushing records correctly. + +log004 Prev on log when beginning of log has been truncated. + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Mpool test +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +memp001 Randomly updates pages. + +memp002 Tests multiple processes accessing and modifying the same + files. + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Recovery +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +recd001 Per-operation recovery tests for non-duplicate, non-split + messages. Makes sure that we exercise redo, undo, and + do-nothing condition. Any test that appears with the + message (change state) indicates that we've already run + the particular test, but we are running it again so that + we can change the state of the data base to prepare for + the next test (this applies to all other recovery tests + as well). + +recd002 Split recovery tests. For every known split log message, + makes sure that we exercise redo, undo, and do-nothing + condition. + +recd003 Duplicate recovery tests. For every known duplicate log + message, makes sure that we exercise redo, undo, and + do-nothing condition. + +recd004 Big key test where big key gets elevated to internal page. + +recd005 Verify reuse of file ids works on catastrophic recovery. + +recd006 Nested transactions. + +recd007 File create/delete tests. + +recd008 Test deeply nested transactions. + +recd009 Verify record numbering across split/reverse splits + and recovery. + +recd010 Verify duplicates across split/reverse splits + and recovery. + +recd011 Verify that recovery to a specific timestamp works. + +recd012 Test of log file ID management. [#2288] + +recd013 Test of cursor adjustment on child transaction aborts. [#2373] + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Subdatabase tests +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +subdb001 Tests mixing db and subdb operations + Create a db, add data, try to create a subdb. + Test naming db and subdb with a leading - for + correct parsing + Existence check -- test use of -excl with subdbs + +subdb002 Tests basic subdb functionality + Small keys, small data + Put/get per key + Dump file + Close, reopen + Dump file + +subdb003 Tests many subdbs + Creates many subdbs and puts a small amount of + data in each (many defaults to 2000) + +subdb004 Tests large subdb names + subdb name = filecontents, + key = filename, data = filecontents + Put/get per key + Dump file + Dump subdbs, verify data and subdb name match + +subdb005 Tests cursor operations in subdbs + Put/get per key + Verify cursor operations work within subdb + Verify cursor operations do not work across subdbs + +subdb006 Tests intra-subdb join + +subdb007 Tests page size differences between subdbs + Open several subdbs, each with a different pagesize + Small keys, small data + Put/get per key per subdb + Dump file, verify per subdb + Close, reopen per subdb + Dump file, verify per subdb + +subdb008 Tests lorder differences between subdbs + Open several subdbs, each with a different/random lorder + Small keys, small data + Put/get per key per subdb + Dump file, verify per subdb + Close, reopen per subdb + Dump file, verify per subdb + +subdb009 Test DB->rename() method for subdbs + +subdb010 Test DB->remove() method for subdbs + +subdbtest001 Tests multiple access methods in one subdb + Open several subdbs, each with a different access method + Small keys, small data + Put/get per key per subdb + Dump file, verify per subdb + Close, reopen per subdb + Dump file, verify per subdb + +subdbtest002 Tests multiple access methods in one subdb access by + multiple processes + Open several subdbs, each with a different access method + Small keys, small data + Put/get per key per subdb + Fork off several child procs to each delete selected + data from their subdb and then exit + Dump file, verify contents of each subdb is correct + Close, reopen per subdb + Dump file, verify per subdb + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Transaction tests +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +txn001 Begin, commit, abort testing. + +txn002 Verify that read-only transactions do not write log records. + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Environment tests +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +env001 Test of env remove interface (formerly env_remove). + +env002 Test of DB_LOG_DIR and env name resolution. + +env003 Test of DB_TMP_DIR and env name resolution. + +env004 Multiple data directories test. + +env005 Test for using subsystems without initializing them correctly. + +env006 Smoke test that the utilities all run. + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +RPC tests +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +[RPC tests also include running all Access Method tests for all methods +via an RPC server] + +rpc001 Test RPC server timeouts for cursor, txn and env handles. + +rpc002 Test unsupported functions + +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Recno backing file tests +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +rsrc001 Basic backing file test (put/get) + +rsrc002 Test of set_re_delim diff --git a/bdb/test/archive.tcl b/bdb/test/archive.tcl new file mode 100644 index 00000000000..9fdbe82d137 --- /dev/null +++ b/bdb/test/archive.tcl @@ -0,0 +1,232 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: archive.tcl,v 11.14 2000/10/27 13:23:55 sue Exp $ +# +# Options are: +# -checkrec <checkpoint frequency" +# -dir <dbhome directory> +# -maxfilesize <maxsize of log file> +# -stat +proc archive_usage {} { + puts "archive -checkrec <checkpt freq> -dir <directory> \ + -maxfilesize <max size of log files>" +} +proc archive_command { args } { + source ./include.tcl + + # Catch a list of files output by db_archive. + catch { eval exec $util_path/db_archive $args } output + + if { $is_windows_test == 1 || 1 } { + # On Windows, convert all filenames to use forward slashes. + regsub -all {[\\]} $output / output + } + + # Output the [possibly-transformed] list. + return $output +} +proc archive { args } { + global alphabet + source ./include.tcl + + # Set defaults + set maxbsize [expr 8 * 1024] + set maxfile [expr 32 * 1024] + set dostat 0 + set checkrec 500 + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -c.* { incr i; set checkrec [lindex $args $i] } + -d.* { incr i; set testdir [lindex $args $i] } + -m.* { incr i; set maxfile [lindex $args $i] } + -s.* { set dostat 1 } + default { + puts -nonewline "FAIL:[timestamp] Usage: " + archive_usage + return + } + + } + } + + # Clean out old log if it existed + puts "Unlinking log: error message OK" + env_cleanup $testdir + + # Now run the various functionality tests + set eflags "-create -txn -home $testdir \ + -log_buffer $maxbsize -log_max $maxfile" + set dbenv [eval {berkdb env} $eflags] + error_check_bad dbenv $dbenv NULL + error_check_good dbenv [is_substr $dbenv env] 1 + + # The basic test structure here is that we write a lot of log + # records (enough to fill up 100 log files; each log file it + # small). We take periodic checkpoints. Between each pair + # of checkpoints, we refer to 2 files, overlapping them each + # checkpoint. We also start transactions and let them overlap + # checkpoints as well. The pattern that we try to create is: + # ---- write log records----|||||--- write log records --- + # -T1 T2 T3 --- D1 D2 ------CHECK--- CT1 --- D2 D3 CD1 ----CHECK + # where TX is begin transaction, CTx is commit transaction, DX is + # open data file and CDx is close datafile. + + set baserec "1:$alphabet:2:$alphabet:3:$alphabet:4:$alphabet" + puts "Archive.a: Writing log records; checkpoint every $checkrec records" + set nrecs $maxfile + set rec 0:$baserec + + # Begin transaction and write a log record + set t1 [$dbenv txn] + error_check_good t1:txn_begin [is_substr $t1 "txn"] 1 + + set l1 [$dbenv log_put $rec] + error_check_bad l1:log_put [llength $l1] 0 + + set lsnlist [list [lindex $l1 0]] + + set t2 [$dbenv txn] + error_check_good t2:txn_begin [is_substr $t2 "txn"] 1 + + set l1 [$dbenv log_put $rec] + lappend lsnlist [lindex $l1 0] + + set t3 [$dbenv txn] + set l1 [$dbenv log_put $rec] + lappend lsnlist [lindex $l1 0] + + set txnlist [list $t1 $t2 $t3] + set db1 [eval {berkdb_open} "-create -mode 0644 -hash -env $dbenv ar1"] + set db2 [eval {berkdb_open} "-create -mode 0644 -btree -env $dbenv ar2"] + set dbcount 3 + set dblist [list $db1 $db2] + + for { set i 1 } { $i <= $nrecs } { incr i } { + set rec $i:$baserec + set lsn [$dbenv log_put $rec] + error_check_bad log_put [llength $lsn] 0 + if { [expr $i % $checkrec] == 0 } { + # Take a checkpoint + $dbenv txn_checkpoint + set ckp_file [lindex [lindex [$dbenv log_get -last] 0] 0] + catch { archive_command -h $testdir -a } res_log_full + if { [string first db_archive $res_log_full] == 0 } { + set res_log_full "" + } + catch { archive_command -h $testdir } res_log + if { [string first db_archive $res_log] == 0 } { + set res_log "" + } + catch { archive_command -h $testdir -l } res_alllog + catch { archive_command -h $testdir -a -s } \ + res_data_full + catch { archive_command -h $testdir -s } res_data + error_check_good nlogfiles [llength $res_alllog] \ + [lindex [lindex [$dbenv log_get -last] 0] 0] + error_check_good logs_match [llength $res_log_full] \ + [llength $res_log] + error_check_good data_match [llength $res_data_full] \ + [llength $res_data] + + # Check right number of log files + error_check_good nlogs [llength $res_log] \ + [expr [lindex $lsnlist 0] - 1] + + # Check that the relative names are a subset of the + # full names + set n 0 + foreach x $res_log { + error_check_bad log_name_match:$res_log \ + [string first $x \ + [lindex $res_log_full $n]] -1 + incr n + } + + set n 0 + foreach x $res_data { + error_check_bad log_name_match:$res_data \ + [string first $x \ + [lindex $res_data_full $n]] -1 + incr n + } + + # Begin/commit any transactions + set t [lindex $txnlist 0] + if { [string length $t] != 0 } { + error_check_good txn_commit:$t [$t commit] 0 + set txnlist [lrange $txnlist 1 end] + } + set lsnlist [lrange $lsnlist 1 end] + + if { [llength $txnlist] == 0 } { + set t1 [$dbenv txn] + error_check_bad tx_begin $t1 NULL + error_check_good \ + tx_begin [is_substr $t1 $dbenv] 1 + set l1 [lindex [$dbenv log_put $rec] 0] + lappend lsnlist [min $l1 $ckp_file] + + set t2 [$dbenv txn] + error_check_bad tx_begin $t2 NULL + error_check_good \ + tx_begin [is_substr $t2 $dbenv] 1 + set l1 [lindex [$dbenv log_put $rec] 0] + lappend lsnlist [min $l1 $ckp_file] + + set t3 [$dbenv txn] + error_check_bad tx_begin $t3 NULL + error_check_good \ + tx_begin [is_substr $t3 $dbenv] 1 + set l1 [lindex [$dbenv log_put $rec] 0] + lappend lsnlist [min $l1 $ckp_file] + + set txnlist [list $t1 $t2 $t3] + } + + # Open/close some DB files + if { [expr $dbcount % 2] == 0 } { + set type "-hash" + } else { + set type "-btree" + } + set db [eval {berkdb_open} \ + "-create -mode 0644 $type -env $dbenv ar$dbcount"] + error_check_bad db_open:$dbcount $db NULL + error_check_good db_open:$dbcount [is_substr $db db] 1 + incr dbcount + + lappend dblist $db + set db [lindex $dblist 0] + error_check_good db_close:$db [$db close] 0 + set dblist [lrange $dblist 1 end] + + } + } + # Commit any transactions still running. + puts "Archive: Commit any transactions still running." + foreach t $txnlist { + error_check_good txn_commit:$t [$t commit] 0 + } + + # Close any files that are still open. + puts "Archive: Close open files." + foreach d $dblist { + error_check_good db_close:$db [$d close] 0 + } + + # Close and unlink the file + reset_env $dbenv + + puts "Archive: Complete." +} + +proc min { a b } { + if {$a < $b} { + return $a + } else { + return $b + } +} diff --git a/bdb/test/byteorder.tcl b/bdb/test/byteorder.tcl new file mode 100644 index 00000000000..d9e44e1d27d --- /dev/null +++ b/bdb/test/byteorder.tcl @@ -0,0 +1,23 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: byteorder.tcl,v 11.7 2000/11/16 23:56:18 ubell Exp $ +# +# Byte Order Test +# Use existing tests and run with both byte orders. +proc byteorder { method {nentries 1000} } { + puts "Byteorder: $method $nentries" + + eval {test001 $method $nentries 0 "01" -lorder 1234} + eval {test001 $method $nentries 0 "01" -lorder 4321} + eval {test003 $method -lorder 1234} + eval {test003 $method -lorder 4321} + eval {test010 $method $nentries 5 10 -lorder 1234} + eval {test010 $method $nentries 5 10 -lorder 4321} + eval {test011 $method $nentries 5 11 -lorder 1234} + eval {test011 $method $nentries 5 11 -lorder 4321} + eval {test018 $method $nentries -lorder 1234} + eval {test018 $method $nentries -lorder 4321} +} diff --git a/bdb/test/conscript.tcl b/bdb/test/conscript.tcl new file mode 100644 index 00000000000..11d0eb58e7d --- /dev/null +++ b/bdb/test/conscript.tcl @@ -0,0 +1,123 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: conscript.tcl,v 11.12 2000/12/01 04:28:36 ubell Exp $ +# +# Script for DB_CONSUME test (test070.tcl). +# Usage: conscript dir file runtype nitems outputfile tnum args +# dir: DBHOME directory +# file: db file on which to operate +# runtype: PRODUCE or CONSUME--which am I? +# nitems: number of items to put or get +# outputfile: where to log consumer results +# tnum: test number + +proc consumescript_produce { db_cmd nitems tnum args } { + source ./include.tcl + global mydata + + set pid [pid] + puts "\tTest0$tnum: Producer $pid starting, producing $nitems items." + + set db [eval $db_cmd] + error_check_good db_open:$pid [is_valid_db $db] TRUE + + set oret -1 + set ret 0 + for { set ndx 0 } { $ndx < $nitems } { incr ndx } { + set oret $ret + set ret [$db put -append [chop_data q $mydata]] + error_check_good db_put \ + [expr $ret > 0 ? $oret < $ret : \ + $oret < 0 ? $oret < $ret : $oret > $ret] 1 + + } + # XXX: We permit incomplete syncs because they seem to + # be unavoidable and not damaging. + set ret [catch {$db close} res] + error_check_good db_close:$pid [expr ($ret == 0) ||\ + ([is_substr $res DB_INCOMPLETE] == 1)] 1 + puts "\t\tTest0$tnum: Producer $pid finished." +} + +proc consumescript_consume { db_cmd nitems tnum outputfile mode args } { + source ./include.tcl + global mydata + set pid [pid] + puts "\tTest0$tnum: Consumer $pid starting, seeking $nitems items." + + set db [eval $db_cmd] + error_check_good db_open:$pid [is_valid_db $db] TRUE + + set oid [open $outputfile w] + + for { set ndx 0 } { $ndx < $nitems } { } { + set ret [$db get $mode] + if { [llength $ret] > 0 } { + error_check_good correct_data:$pid \ + [lindex [lindex $ret 0] 1] [pad_data q $mydata] + set rno [lindex [lindex $ret 0] 0] + puts $oid $rno + incr ndx + } else { + # No data to consume; wait. + } + } + + error_check_good output_close:$pid [close $oid] "" + # XXX: see above note. + set ret [catch {$db close} res] + error_check_good db_close:$pid [expr ($ret == 0) ||\ + ([is_substr $res DB_INCOMPLETE] == 1)] 1 + puts "\t\tTest0$tnum: Consumer $pid finished." +} + +source ./include.tcl +source $test_path/test.tcl + +# Verify usage +if { $argc < 6 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + exit +} + +set usage "conscript.tcl dir file runtype nitems outputfile tnum" + +# Initialize arguments +set dir [lindex $argv 0] +set file [lindex $argv 1] +set runtype [lindex $argv 2] +set nitems [lindex $argv 3] +set outputfile [lindex $argv 4] +set tnum [lindex $argv 5] +# args is the string "{ -len 20 -pad 0}", so we need to extract the +# " -len 20 -pad 0" part. +set args [lindex [lrange $argv 6 end] 0] + +set mydata "consumer data" + +# Open env +set dbenv [berkdb env -home $dir ] +error_check_good db_env_create [is_valid_env $dbenv] TRUE + +# Figure out db opening command. +set db_cmd [concat {berkdb_open -create -mode 0644 -queue -env}\ + $dbenv $args $file] + +# Invoke consumescript_produce or consumescript_consume based on $runtype +if { $runtype == "PRODUCE" } { + # Producers have nothing to log; make sure outputfile is null. + error_check_good no_producer_outputfile $outputfile "" + consumescript_produce $db_cmd $nitems $tnum $args +} elseif { $runtype == "CONSUME" } { + consumescript_consume $db_cmd $nitems $tnum $outputfile -consume $args +} elseif { $runtype == "WAIT" } { + consumescript_consume $db_cmd $nitems $tnum $outputfile -consume_wait \ + $args +} else { + error_check_good bad_args $runtype "either PRODUCE, CONSUME or WAIT" +} +error_check_good env_close [$dbenv close] 0 +exit diff --git a/bdb/test/dbm.tcl b/bdb/test/dbm.tcl new file mode 100644 index 00000000000..41a5da1f13a --- /dev/null +++ b/bdb/test/dbm.tcl @@ -0,0 +1,128 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: dbm.tcl,v 11.12 2000/08/25 14:21:50 sue Exp $ +# +# Historic DBM interface test. +# Use the first 1000 entries from the dictionary. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Then reopen the file, re-retrieve everything. +# Finally, delete everything. +proc dbm { { nentries 1000 } } { + source ./include.tcl + + puts "DBM interfaces test: $nentries" + + # Create the database and open the dictionary + set testfile $testdir/dbmtest + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir NULL + + error_check_good dbminit [berkdb dbminit $testfile] 0 + set did [open $dict] + + set flags "" + set txn "" + set count 0 + set skippednullkey 0 + + puts "\tDBM.a: put/get loop" + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + # DBM can't handle zero-length keys + if { [string length $str] == 0 } { + set skippednullkey 1 + continue + } + + set ret [berkdb store $str $str] + error_check_good dbm_store $ret 0 + + set d [berkdb fetch $str] + error_check_good dbm_fetch $d $str + incr count + } + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tDBM.b: dump file" + set oid [open $t1 w] + for { set key [berkdb firstkey] } { $key != -1 } {\ + set key [berkdb nextkey $key] } { + puts $oid $key + set d [berkdb fetch $key] + error_check_good dbm_refetch $d $key + } + + # If we had to skip a zero-length key, juggle things to cover up + # this fact in the dump. + if { $skippednullkey == 1 } { + puts $oid "" + incr nentries 1 + } + + close $oid + + # Now compare the keys to see if they match the dictionary (or ints) + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + + error_check_good DBM:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tDBM.c: close, open, and dump file" + + # Now, reopen the file and run the last test again. + error_check_good dbminit2 [berkdb dbminit $testfile] 0 + set oid [open $t1 w] + + for { set key [berkdb firstkey] } { $key != -1 } {\ + set key [berkdb nextkey $key] } { + puts $oid $key + set d [berkdb fetch $key] + error_check_good dbm_refetch $d $key + } + if { $skippednullkey == 1 } { + puts $oid "" + } + close $oid + + # Now compare the keys to see if they match the dictionary (or ints) + filesort $t1 $t3 + + error_check_good DBM:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and delete each entry + puts "\tDBM.d: sequential scan and delete" + + error_check_good dbminit3 [berkdb dbminit $testfile] 0 + set oid [open $t1 w] + + for { set key [berkdb firstkey] } { $key != -1 } {\ + set key [berkdb nextkey $key] } { + puts $oid $key + set ret [berkdb delete $key] + error_check_good dbm_delete $ret 0 + } + if { $skippednullkey == 1 } { + puts $oid "" + } + close $oid + + # Now compare the keys to see if they match the dictionary (or ints) + filesort $t1 $t3 + + error_check_good DBM:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + error_check_good "dbm_close" [berkdb dbmclose] 0 +} diff --git a/bdb/test/dbscript.tcl b/bdb/test/dbscript.tcl new file mode 100644 index 00000000000..3a51b4363d4 --- /dev/null +++ b/bdb/test/dbscript.tcl @@ -0,0 +1,357 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: dbscript.tcl,v 11.10 2000/04/21 18:36:21 krinsky Exp $ +# +# Random db tester. +# Usage: dbscript file numops min_del max_add key_avg data_avgdups +# file: db file on which to operate +# numops: number of operations to do +# ncurs: number of cursors +# min_del: minimum number of keys before you disable deletes. +# max_add: maximum number of keys before you disable adds. +# key_avg: average key size +# data_avg: average data size +# dups: 1 indicates dups allowed, 0 indicates no dups +# errpct: What percent of operations should generate errors +# seed: Random number generator seed (-1 means use pid) + +source ./include.tcl +source $test_path/test.tcl +source $test_path/testutils.tcl + +set alphabet "abcdefghijklmnopqrstuvwxyz" + +set usage "dbscript file numops ncurs min_del max_add key_avg data_avg dups errpcnt" + +# Verify usage +if { $argc != 9 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + exit +} + +# Initialize arguments +set file [lindex $argv 0] +set numops [ lindex $argv 1 ] +set ncurs [ lindex $argv 2 ] +set min_del [ lindex $argv 3 ] +set max_add [ lindex $argv 4 ] +set key_avg [ lindex $argv 5 ] +set data_avg [ lindex $argv 6 ] +set dups [ lindex $argv 7 ] +set errpct [ lindex $argv 8 ] + +berkdb srand $rand_init + +puts "Beginning execution for [pid]" +puts "$file database" +puts "$numops Operations" +puts "$ncurs cursors" +puts "$min_del keys before deletes allowed" +puts "$max_add or fewer keys to add" +puts "$key_avg average key length" +puts "$data_avg average data length" +if { $dups != 1 } { + puts "No dups" +} else { + puts "Dups allowed" +} +puts "$errpct % Errors" + +flush stdout + +set db [berkdb_open $file] +set cerr [catch {error_check_good dbopen [is_substr $db db] 1} cret] +if {$cerr != 0} { + puts $cret + return +} +set method [$db get_type] +set record_based [is_record_based $method] + +# Initialize globals including data +global nkeys +global l_keys +global a_keys + +set nkeys [db_init $db 1] +puts "Initial number of keys: $nkeys" + +set pflags "" +set gflags "" +set txn "" + +# Open the cursors +set curslist {} +for { set i 0 } { $i < $ncurs } { incr i } { + set dbc [$db cursor] + set cerr [catch {error_check_good dbopen [is_substr $dbc $db.c] 1} cret] + if {$cerr != 0} { + puts $cret + return + } + set cerr [catch {error_check_bad cursor_create $dbc NULL} cret] + if {$cerr != 0} { + puts $cret + return + } + lappend curslist $dbc + +} + +# On each iteration we're going to generate random keys and +# data. We'll select either a get/put/delete operation unless +# we have fewer than min_del keys in which case, delete is not +# an option or more than max_add in which case, add is not +# an option. The tcl global arrays a_keys and l_keys keep track +# of key-data pairs indexed by key and a list of keys, accessed +# by integer. +set adds 0 +set puts 0 +set gets 0 +set dels 0 +set bad_adds 0 +set bad_puts 0 +set bad_gets 0 +set bad_dels 0 + +for { set iter 0 } { $iter < $numops } { incr iter } { + set op [pick_op $min_del $max_add $nkeys] + set err [is_err $errpct] + + # The op0's indicate that there aren't any duplicates, so we + # exercise regular operations. If dups is 1, then we'll use + # cursor ops. + switch $op$dups$err { + add00 { + incr adds + + set k [random_data $key_avg 1 a_keys $record_based] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$db put} $txn $pflags \ + {-nooverwrite $k $data}] + set cerr [catch {error_check_good put $ret 0} cret] + if {$cerr != 0} { + puts $cret + return + } + newpair $k [pad_data $method $data] + } + add01 { + incr bad_adds + set k [random_key] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$db put} $txn $pflags \ + {-nooverwrite $k $data}] + set cerr [catch {error_check_good put $ret 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error case so no change to data state + } + add10 { + incr adds + set dbcinfo [random_cursor $curslist] + set dbc [lindex $dbcinfo 0] + if { [berkdb random_int 1 2] == 1 } { + # Add a new key + set k [random_data $key_avg 1 a_keys \ + $record_based] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$dbc put} $txn \ + {-keyfirst $k $data}] + newpair $k [pad_data $method $data] + } else { + # Add a new duplicate + set dbc [lindex $dbcinfo 0] + set k [lindex $dbcinfo 1] + set data [random_data $data_avg 0 0] + + set op [pick_cursput] + set data [chop_data $method $data] + set ret [eval {$dbc put} $txn {$op $k $data}] + adddup $k [lindex $dbcinfo 2] $data + } + } + add11 { + # TODO + incr bad_adds + set ret 1 + } + put00 { + incr puts + set k [random_key] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$db put} $txn {$k $data}] + changepair $k [pad_data $method $data] + } + put01 { + incr bad_puts + set k [random_key] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set ret [eval {$db put} $txn $pflags \ + {-nooverwrite $k $data}] + set cerr [catch {error_check_good put $ret 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error case so no change to data state + } + put10 { + incr puts + set dbcinfo [random_cursor $curslist] + set dbc [lindex $dbcinfo 0] + set k [lindex $dbcinfo 1] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + + set ret [eval {$dbc put} $txn {-current $data}] + changedup $k [lindex $dbcinfo 2] $data + } + put11 { + incr bad_puts + set k [random_key] + set data [random_data $data_avg 0 0] + set data [chop_data $method $data] + set dbc [$db cursor] + set ret [eval {$dbc put} $txn {-current $data}] + set cerr [catch {error_check_good curs_close \ + [$dbc close] 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error case so no change to data state + } + get00 { + incr gets + set k [random_key] + set val [eval {$db get} $txn {$k}] + set data [pad_data $method [lindex [lindex $val 0] 1]] + if { $data == $a_keys($k) } { + set ret 0 + } else { + set ret "FAIL: Error got |$data| expected |$a_keys($k)|" + } + # Get command requires no state change + } + get01 { + incr bad_gets + set k [random_data $key_avg 1 a_keys $record_based] + set ret [eval {$db get} $txn {$k}] + # Error case so no change to data state + } + get10 { + incr gets + set dbcinfo [random_cursor $curslist] + if { [llength $dbcinfo] == 3 } { + set ret 0 + else + set ret 0 + } + # Get command requires no state change + } + get11 { + incr bad_gets + set k [random_key] + set dbc [$db cursor] + if { [berkdb random_int 1 2] == 1 } { + set dir -next + } else { + set dir -prev + } + set ret [eval {$dbc get} $txn {-next $k}] + set cerr [catch {error_check_good curs_close \ + [$dbc close] 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error and get case so no change to data state + } + del00 { + incr dels + set k [random_key] + set ret [eval {$db del} $txn {$k}] + rempair $k + } + del01 { + incr bad_dels + set k [random_data $key_avg 1 a_keys $record_based] + set ret [eval {$db del} $txn {$k}] + # Error case so no change to data state + } + del10 { + incr dels + set dbcinfo [random_cursor $curslist] + set dbc [lindex $dbcinfo 0] + set ret [eval {$dbc del} $txn] + remdup [lindex dbcinfo 1] [lindex dbcinfo 2] + } + del11 { + incr bad_dels + set c [$db cursor] + set ret [eval {$c del} $txn] + set cerr [catch {error_check_good curs_close \ + [$c close] 0} cret] + if {$cerr != 0} { + puts $cret + return + } + # Error case so no change to data state + } + } + if { $err == 1 } { + # Verify failure. + set cerr [catch {error_check_good $op$dups$err:$k \ + [is_substr Error $ret] 1} cret] + if {$cerr != 0} { + puts $cret + return + } + } else { + # Verify success + set cerr [catch {error_check_good $op$dups$err:$k $ret 0} cret] + if {$cerr != 0} { + puts $cret + return + } + } + + flush stdout +} + +# Close cursors and file +foreach i $curslist { + set r [$i close] + set cerr [catch {error_check_good cursor_close:$i $r 0} cret] + if {$cerr != 0} { + puts $cret + return + } +} + +set r [$db close] +set cerr [catch {error_check_good db_close:$db $r 0} cret] +if {$cerr != 0} { + puts $cret + return +} + +puts "[timestamp] [pid] Complete" +puts "Successful ops: $adds adds $gets gets $puts puts $dels dels" +puts "Error ops: $bad_adds adds $bad_gets gets $bad_puts puts $bad_dels dels" +flush stdout + +filecheck $file $txn + +exit diff --git a/bdb/test/ddscript.tcl b/bdb/test/ddscript.tcl new file mode 100644 index 00000000000..9b139a4cbc6 --- /dev/null +++ b/bdb/test/ddscript.tcl @@ -0,0 +1,43 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: ddscript.tcl,v 11.7 2000/05/08 19:26:37 sue Exp $ +# +# Deadlock detector script tester. +# Usage: ddscript dir test lockerid objid numprocs +# dir: DBHOME directory +# test: Which test to run +# lockerid: Lock id for this locker +# objid: Object id to lock. +# numprocs: Total number of processes running + +source ./include.tcl +source $test_path/test.tcl +source $test_path/testutils.tcl + +set usage "ddscript dir test lockerid objid numprocs" + +# Verify usage +if { $argc != 5 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + exit +} + +# Initialize arguments +set dir [lindex $argv 0] +set tnum [ lindex $argv 1 ] +set lockerid [ lindex $argv 2 ] +set objid [ lindex $argv 3 ] +set numprocs [ lindex $argv 4 ] + +set myenv [berkdb env -lock -home $dir -create -mode 0644] +error_check_bad lock_open $myenv NULL +error_check_good lock_open [is_substr $myenv "env"] 1 + +puts [eval $tnum $myenv $lockerid $objid $numprocs] + +error_check_good envclose [$myenv close] 0 + +exit diff --git a/bdb/test/dead001.tcl b/bdb/test/dead001.tcl new file mode 100644 index 00000000000..9e7c71f6a58 --- /dev/null +++ b/bdb/test/dead001.tcl @@ -0,0 +1,76 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: dead001.tcl,v 11.17 2000/11/05 14:23:55 dda Exp $ +# +# Deadlock Test 1. +# We create various deadlock scenarios for different numbers of lockers +# and see if we can get the world cleaned up suitably. +proc dead001 { { procs "2 4 10" } {tests "ring clump" } } { + source ./include.tcl + + puts "Dead001: Deadlock detector tests" + + env_cleanup $testdir + + # Create the environment. + puts "\tDead001.a: creating environment" + set env [berkdb env -create -mode 0644 -lock -home $testdir] + error_check_good lock_env:open [is_valid_env $env] TRUE + + error_check_good lock_env:close [$env close] 0 + + set dpid [exec $util_path/db_deadlock -vw -h $testdir \ + >& $testdir/dd.out &] + + foreach t $tests { + set pidlist "" + foreach n $procs { + + sentinel_init + + # Fire off the tests + puts "\tDead001: $n procs of test $t" + for { set i 0 } { $i < $n } { incr i } { + puts "$tclsh_path $test_path/wrap.tcl \ + $testdir/dead001.log.$i \ + ddscript.tcl $testdir $t $i $i $n" + set p [exec $tclsh_path \ + $test_path/wrap.tcl \ + ddscript.tcl $testdir/dead001.log.$i \ + $testdir $t $i $i $n &] + lappend pidlist $p + } + watch_procs 5 + + # Now check output + set dead 0 + set clean 0 + set other 0 + for { set i 0 } { $i < $n } { incr i } { + set did [open $testdir/dead001.log.$i] + while { [gets $did val] != -1 } { + switch $val { + DEADLOCK { incr dead } + 1 { incr clean } + default { incr other } + } + } + close $did + } + puts "dead check..." + dead_check $t $n $dead $clean $other + } + } + + exec $KILL $dpid + # Windows needs files closed before deleting files, so pause a little + tclsleep 2 + fileremove -f $testdir/dd.out + # Remove log files + for { set i 0 } { $i < $n } { incr i } { + fileremove -f $testdir/dead001.log.$i + } +} diff --git a/bdb/test/dead002.tcl b/bdb/test/dead002.tcl new file mode 100644 index 00000000000..83cc6c7d59b --- /dev/null +++ b/bdb/test/dead002.tcl @@ -0,0 +1,68 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: dead002.tcl,v 11.15 2000/08/25 14:21:50 sue Exp $ +# +# Deadlock Test 2. +# Identical to Test 1 except that instead of running a standalone deadlock +# detector, we create the region with "detect on every wait" +proc dead002 { { procs "2 4 10" } {tests "ring clump" } } { + source ./include.tcl + + puts "Dead002: Deadlock detector tests" + + env_cleanup $testdir + + # Create the environment. + puts "\tDead002.a: creating environment" + set env [berkdb env \ + -create -mode 0644 -home $testdir -lock -lock_detect default] + error_check_good lock_env:open [is_valid_env $env] TRUE + error_check_good lock_env:close [$env close] 0 + + foreach t $tests { + set pidlist "" + foreach n $procs { + sentinel_init + + # Fire off the tests + puts "\tDead002: $n procs of test $t" + for { set i 0 } { $i < $n } { incr i } { + puts "$tclsh_path $test_path/wrap.tcl \ + $testdir/dead002.log.$i \ + ddscript.tcl $testdir $t $i $i $n" + set p [exec $tclsh_path \ + $test_path/wrap.tcl \ + ddscript.tcl $testdir/dead002.log.$i \ + $testdir $t $i $i $n &] + lappend pidlist $p + } + watch_procs 5 + + # Now check output + set dead 0 + set clean 0 + set other 0 + for { set i 0 } { $i < $n } { incr i } { + set did [open $testdir/dead002.log.$i] + while { [gets $did val] != -1 } { + switch $val { + DEADLOCK { incr dead } + 1 { incr clean } + default { incr other } + } + } + close $did + } + dead_check $t $n $dead $clean $other + } + } + + fileremove -f $testdir/dd.out + # Remove log files + for { set i 0 } { $i < $n } { incr i } { + fileremove -f $testdir/dead002.log.$i + } +} diff --git a/bdb/test/dead003.tcl b/bdb/test/dead003.tcl new file mode 100644 index 00000000000..4075eb44f86 --- /dev/null +++ b/bdb/test/dead003.tcl @@ -0,0 +1,92 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: dead003.tcl,v 1.8 2000/08/25 14:21:50 sue Exp $ +# +# Deadlock Test 3. +# Test DB_LOCK_OLDEST and DB_LOCK_YOUNGEST +# Identical to Test 2 except that we create the region with "detect on +# every wait" with first the "oldest" and then "youngest". +proc dead003 { { procs "2 4 10" } {tests "ring clump" } } { + source ./include.tcl + + set detects { oldest youngest } + puts "Dead003: Deadlock detector tests: $detects" + + # Create the environment. + foreach d $detects { + env_cleanup $testdir + puts "\tDead003.a: creating environment for $d" + set env [berkdb env \ + -create -mode 0644 -home $testdir -lock -lock_detect $d] + error_check_good lock_env:open [is_valid_env $env] TRUE + error_check_good lock_env:close [$env close] 0 + + foreach t $tests { + set pidlist "" + foreach n $procs { + sentinel_init + + # Fire off the tests + puts "\tDead003: $n procs of test $t" + for { set i 0 } { $i < $n } { incr i } { + puts "$tclsh_path\ + test_path/ddscript.tcl $testdir \ + $t $i $i $n >& \ + $testdir/dead003.log.$i" + set p [exec $tclsh_path \ + $test_path/wrap.tcl \ + ddscript.tcl \ + $testdir/dead003.log.$i $testdir \ + $t $i $i $n &] + lappend pidlist $p + } + watch_procs 5 + + # Now check output + set dead 0 + set clean 0 + set other 0 + for { set i 0 } { $i < $n } { incr i } { + set did [open $testdir/dead003.log.$i] + while { [gets $did val] != -1 } { + switch $val { + DEADLOCK { incr dead } + 1 { incr clean } + default { incr other } + } + } + close $did + } + dead_check $t $n $dead $clean $other + # + # If we get here we know we have the + # correct number of dead/clean procs, as + # checked by dead_check above. Now verify + # that the right process was the one. + puts "\tDead003: Verify $d locks were aborted" + set l "" + if { $d == "oldest" } { + set l [expr $n - 1] + } + if { $d == "youngest" } { + set l 0 + } + set did [open $testdir/dead003.log.$l] + while { [gets $did val] != -1 } { + error_check_good check_abort \ + $val 1 + } + close $did + } + } + + fileremove -f $testdir/dd.out + # Remove log files + for { set i 0 } { $i < $n } { incr i } { + fileremove -f $testdir/dead003.log.$i + } + } +} diff --git a/bdb/test/env001.tcl b/bdb/test/env001.tcl new file mode 100644 index 00000000000..00837330193 --- /dev/null +++ b/bdb/test/env001.tcl @@ -0,0 +1,147 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: env001.tcl,v 11.21 2000/11/09 19:24:08 sue Exp $ +# +# Test of env remove interface. +proc env001 { } { + global errorInfo + global errorCode + + source ./include.tcl + + set testfile $testdir/env.db + set t1 $testdir/t1 + + puts "Env001: Test of environment remove interface." + env_cleanup $testdir + + # Try opening without Create flag should error + puts "\tEnv001.a: Open without create (should fail)." + catch {set env [berkdb env -home $testdir]} ret + error_check_good env:fail [is_substr $ret "no such file"] 1 + + # Now try opening with create + puts "\tEnv001.b: Open with create." + set env [berkdb env -create -mode 0644 -home $testdir] + error_check_bad env:$testdir $env NULL + error_check_good env:$testdir [is_substr $env "env"] 1 + + # Make sure that close works. + puts "\tEnv001.c: Verify close." + error_check_good env:close:$env [$env close] 0 + + # Make sure we can reopen -- this doesn't work on Windows + # because if there is only one opener, the region disappears + # when it is closed. We can't do a second opener, because + # that will fail on HP-UX. + puts "\tEnv001.d: Remove on closed environments." + if { $is_windows_test != 1 } { + puts "\t\tEnv001.d.1: Verify re-open." + set env [berkdb env -home $testdir] + error_check_bad env:$testdir $env NULL + error_check_good env:$testdir [is_substr $env "env"] 1 + + # remove environment + puts "\t\tEnv001.d.2: Close environment." + error_check_good env:close [$env close] 0 + puts "\t\tEnv001.d.3: Try remove with force (should succeed)." + error_check_good \ + envremove [berkdb envremove -force -home $testdir] 0 + } + + if { $is_windows_test != 1 && $is_hp_test != 1 } { + puts "\tEnv001.e: Remove on open environments." + puts "\t\tEnv001.e.1: Env is open by single proc,\ + remove no force." + set env [berkdb env -create -mode 0644 -home $testdir] + error_check_bad env:$testdir $env NULL + error_check_good env:$testdir [is_substr $env "env"] 1 + set stat [catch {berkdb envremove -home $testdir} ret] + error_check_good env:remove $stat 1 + error_check_good env:close [$env close] 0 + } + + puts \ + "\t\tEnv001.e.2: Env is open by single proc, remove with force." + # Now that envremove doesn't do a close, this won't work on Windows. + if { $is_windows_test != 1 && $is_hp_test != 1} { + set env [berkdb env -create -mode 0644 -home $testdir] + error_check_bad env:$testdir $env NULL + error_check_good env:$testdir [is_substr $env "env"] 1 + set stat [catch {berkdb envremove -force -home $testdir} ret] + error_check_good env:remove(force) $ret 0 + # + # Even though the underlying env is gone, we need to close + # the handle. + # + catch {$env close} + } + + puts "\t\tEnv001.e.3: Env is open by 2 procs, remove no force." + # should fail + set env [berkdb env -create -mode 0644 -home $testdir] + error_check_bad env:$testdir $env NULL + error_check_good env:$testdir [is_substr $env "env"] 1 + + set f1 [open |$tclsh_path r+] + puts $f1 "source $test_path/test.tcl" + + set remote_env [send_cmd $f1 "berkdb env -home $testdir"] + error_check_good remote:env_open [is_valid_env $remote_env] TRUE + # First close our env, but leave remote open + error_check_good env:close [$env close] 0 + catch {berkdb envremove -home $testdir} ret + error_check_good envremove:2procs:noforce [is_substr $errorCode EBUSY] 1 + # + # even though it failed, $env is no longer valid, so remove it in + # the remote process + set remote_close [send_cmd $f1 "$remote_env close"] + error_check_good remote_close $remote_close 0 + + # exit remote process + set err [catch { close $f1 } result] + error_check_good close_remote_process $err 0 + + puts "\t\tEnv001.e.4: Env is open by 2 procs, remove with force." + # You cannot do this on windows because you can't remove files that + # are open, so we skip this test for Windows. On UNIX, it should + # succeed + if { $is_windows_test != 1 && $is_hp_test != 1 } { + set env [berkdb env -create -mode 0644 -home $testdir] + error_check_bad env:$testdir $env NULL + error_check_good env:$testdir [is_substr $env "env"] 1 + set f1 [open |$tclsh_path r+] + puts $f1 "source $test_path/test.tcl" + + set remote_env [send_cmd $f1 "berkdb env -home $testdir"] + error_check_good remote:env_open [is_valid_env $remote_env] TRUE + + catch {berkdb envremove -force -home $testdir} ret + error_check_good envremove:2procs:force $ret 0 + # + # We still need to close our handle. + # + catch {$env close} ret + + # Close down remote process + set err [catch { close $f1 } result] + error_check_good close_remote_process $err 0 + } + + # Try opening in a different dir + puts "\tEnv001.f: Try opening env in another directory." + if { [file exists $testdir/NEWDIR] != 1 } { + file mkdir $testdir/NEWDIR + } + set eflags "-create -home $testdir/NEWDIR -mode 0644" + set env [eval {berkdb env} $eflags] + error_check_bad env:open $env NULL + error_check_good env:close [$env close] 0 + error_check_good berkdb:envremove \ + [berkdb envremove -home $testdir/NEWDIR] 0 + + puts "\tEnv001 complete." +} diff --git a/bdb/test/env002.tcl b/bdb/test/env002.tcl new file mode 100644 index 00000000000..a37ddea17a9 --- /dev/null +++ b/bdb/test/env002.tcl @@ -0,0 +1,156 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: env002.tcl,v 11.11 2000/08/25 14:21:50 sue Exp $ +# +# Env Test 002 +# Test set_lg_dir and env name resolution +# With an environment path specified using -home, and then again +# with it specified by the environment variable DB_HOME: +# 1) Make sure that the set_lg_dir option is respected +# a) as a relative pathname. +# b) as an absolute pathname. +# 2) Make sure that the DB_LOG_DIR db_config argument is respected, +# again as relative and absolute pathnames. +# 3) Make sure that if -both- db_config and a file are present, +# only the file is respected (see doc/env/naming.html). +proc env002 { } { + # env002 is essentially just a small driver that runs + # env002_body--formerly the entire test--twice; once, it + # supplies a "home" argument to use with environment opens, + # and the second time it sets DB_HOME instead. + # Note that env002_body itself calls env002_run_test to run + # the body of the actual test and check for the presence + # of logs. The nesting, I hope, makes this test's structure simpler. + + global env + source ./include.tcl + + puts "Env002: set_lg_dir test." + + puts "\tEnv002: Running with -home argument to berkdb env." + env002_body "-home $testdir" + + puts "\tEnv002: Running with environment variable DB_HOME set." + set env(DB_HOME) $testdir + env002_body "-use_environ" + + unset env(DB_HOME) + + puts "\tEnv002: Running with both DB_HOME and -home set." + # Should respect -only- -home, so we give it a bogus + # environment variable setting. + set env(DB_HOME) $testdir/bogus_home + env002_body "-use_environ -home $testdir" + unset env(DB_HOME) + +} + +proc env002_body { home_arg } { + source ./include.tcl + + env_cleanup $testdir + set logdir "logs_in_here" + + file mkdir $testdir/$logdir + + # Set up full path to $logdir for when we test absolute paths. + set curdir [pwd] + cd $testdir/$logdir + set fulllogdir [pwd] + cd $curdir + + env002_make_config $logdir + + # Run the meat of the test. + env002_run_test a 1 "relative path, config file" $home_arg \ + $testdir/$logdir + + env_cleanup $testdir + + file mkdir $fulllogdir + env002_make_config $fulllogdir + + # Run the test again + env002_run_test a 2 "absolute path, config file" $home_arg \ + $fulllogdir + + env_cleanup $testdir + + # Now we try without a config file, but instead with db_config + # relative paths + file mkdir $testdir/$logdir + env002_run_test b 1 "relative path, db_config" "$home_arg \ + -log_dir $logdir -data_dir ." \ + $testdir/$logdir + + env_cleanup $testdir + + # absolute + file mkdir $fulllogdir + env002_run_test b 2 "absolute path, db_config" "$home_arg \ + -log_dir $fulllogdir -data_dir ." \ + $fulllogdir + + env_cleanup $testdir + + # Now, set db_config -and- have a # DB_CONFIG file, and make + # sure only the latter is honored. + + file mkdir $testdir/$logdir + env002_make_config $logdir + + # note that we supply a -nonexistent- log dir to db_config + env002_run_test c 1 "relative path, both db_config and file" \ + "$home_arg -log_dir $testdir/bogus \ + -data_dir ." $testdir/$logdir + env_cleanup $testdir + + file mkdir $fulllogdir + env002_make_config $fulllogdir + + # note that we supply a -nonexistent- log dir to db_config + env002_run_test c 2 "relative path, both db_config and file" \ + "$home_arg -log_dir $fulllogdir/bogus \ + -data_dir ." $fulllogdir +} + +proc env002_run_test { major minor msg env_args log_path} { + global testdir + set testfile "env002.db" + + puts "\t\tEnv002.$major.$minor: $msg" + + # Create an environment, with logging, and scribble some + # stuff in a [btree] database in it. + # puts [concat {berkdb env -create -log -private} $env_args] + set dbenv [eval {berkdb env -create -log -private} $env_args] + error_check_good env_open [is_valid_env $dbenv] TRUE + set db [berkdb_open -env $dbenv -create -btree -mode 0644 $testfile] + error_check_good db_open [is_valid_db $db] TRUE + + set key "some_key" + set data "some_data" + + error_check_good db_put \ + [$db put $key [chop_data btree $data]] 0 + + error_check_good db_close [$db close] 0 + error_check_good env_close [$dbenv close] 0 + + # Now make sure the log file is where we want it to be. + error_check_good db_exists [file exists $testdir/$testfile] 1 + error_check_good log_exists \ + [file exists $log_path/log.0000000001] 1 +} + +proc env002_make_config { logdir } { + global testdir + + set cid [open $testdir/DB_CONFIG w] + puts $cid "set_data_dir ." + puts $cid "set_lg_dir $logdir" + close $cid +} diff --git a/bdb/test/env003.tcl b/bdb/test/env003.tcl new file mode 100644 index 00000000000..01e0b6188fc --- /dev/null +++ b/bdb/test/env003.tcl @@ -0,0 +1,177 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: env003.tcl,v 11.12 2000/08/25 14:21:50 sue Exp $ +# +# Env Test 003 +# Test DB_TMP_DIR and env name resolution +# With an environment path specified using -home, and then again +# with it specified by the environment variable DB_HOME: +# 1) Make sure that the DB_TMP_DIR config file option is respected +# a) as a relative pathname. +# b) as an absolute pathname. +# 2) Make sure that the DB_TMP_DIR db_config argument is respected, +# again as relative and absolute pathnames. +# 3) Make sure that if -both- db_config and a file are present, +# only the file is respected (see doc/env/naming.html). +proc env003 { } { + # env003 is essentially just a small driver that runs + # env003_body twice. First, it supplies a "home" argument + # to use with environment opens, and the second time it sets + # DB_HOME instead. + # Note that env003_body itself calls env003_run_test to run + # the body of the actual test. + + global env + source ./include.tcl + + puts "Env003: DB_TMP_DIR test." + + puts "\tEnv003: Running with -home argument to berkdb env." + env003_body "-home $testdir" + + puts "\tEnv003: Running with environment variable DB_HOME set." + set env(DB_HOME) $testdir + env003_body "-use_environ" + + unset env(DB_HOME) + + puts "\tEnv003: Running with both DB_HOME and -home set." + # Should respect -only- -home, so we give it a bogus + # environment variable setting. + set env(DB_HOME) $testdir/bogus_home + env003_body "-use_environ -home $testdir" + unset env(DB_HOME) + +} + +proc env003_body { home_arg } { + source ./include.tcl + + env_cleanup $testdir + set tmpdir "tmpfiles_in_here" + + file mkdir $testdir/$tmpdir + + # Set up full path to $tmpdir for when we test absolute paths. + set curdir [pwd] + cd $testdir/$tmpdir + set fulltmpdir [pwd] + cd $curdir + + # Run test with the temp dir. nonexistent--it checks for failure. + env_cleanup $testdir + + env003_make_config $tmpdir + + # Run the meat of the test. + env003_run_test a 1 "relative path, config file" $home_arg \ + $testdir/$tmpdir + + env_cleanup $testdir + + env003_make_config $fulltmpdir + + # Run the test again + env003_run_test a 2 "absolute path, config file" $home_arg \ + $fulltmpdir + + env_cleanup $testdir + + # Now we try without a config file, but instead with db_config + # relative paths + env003_run_test b 1 "relative path, db_config" "$home_arg \ + -tmp_dir $tmpdir -data_dir ." \ + $testdir/$tmpdir + + env_cleanup $testdir + + # absolute + env003_run_test b 2 "absolute path, db_config" "$home_arg \ + -tmp_dir $fulltmpdir -data_dir ." \ + $fulltmpdir + + env_cleanup $testdir + + # Now, set db_config -and- have a # DB_CONFIG file, and make + # sure only the latter is honored. + + # Make a temp directory that actually does exist to supply + # as a bogus argument--the test checks for -nonexistent- temp + # dirs., as success is harder to detect. + file mkdir $testdir/bogus + env003_make_config $tmpdir + + # note that we supply an -existent- tmp dir to db_config as + # a red herring + env003_run_test c 1 "relative path, both db_config and file" \ + "$home_arg -tmp_dir $testdir/bogus -data_dir ." \ + $testdir/$tmpdir + env_cleanup $testdir + + file mkdir $fulltmpdir + file mkdir $fulltmpdir/bogus + env003_make_config $fulltmpdir/nonexistent + + # note that we supply an -existent- tmp dir to db_config as + # a red herring + env003_run_test c 2 "relative path, both db_config and file" \ + "$home_arg -tmp_dir $fulltmpdir/bogus -data_dir ." \ + $fulltmpdir +} + +proc env003_run_test { major minor msg env_args tmp_path} { + global testdir + global alphabet + global errorCode + + puts "\t\tEnv003.$major.$minor: $msg" + + # Create an environment and small-cached in-memory database to + # use. + set dbenv [eval {berkdb env -create -home $testdir} $env_args \ + {-cachesize {0 40960 1}}] + error_check_good env_open [is_valid_env $dbenv] TRUE + set db [berkdb_open_noerr -env $dbenv -create -btree] + error_check_good db_open [is_valid_db $db] TRUE + + # Fill the database with more than its cache can fit. + # !!! + # This is actually trickier than it sounds. The tempfile + # gets unlinked as soon as it's created, so there's no straightforward + # way to check for its existence. Instead, we make sure + # DB_TMP_DIR points somewhere bogus, and make sure that the temp + # dir. does -not- exist. But to do this, we have to know + # which call to DB->put is going to fail--the temp file is + # created lazily, so the failure only occurs when the cache finally + # overflows. + # The data we've conjured up will fit nicely once, but the second + # call will overflow the cache. Thus we check for success once, + # then failure. + # + set key1 "key1" + set key2 "key2" + set data [repeat $alphabet 1000] + + # First put should succeed. + error_check_good db_put_1 [$db put $key1 $data] 0 + + # Second one should return ENOENT. + set errorCode NONE + catch {$db put $key2 $data} res + error_check_good db_put_2 [is_substr $errorCode ENOENT] 1 + + error_check_good db_close [$db close] 0 + error_check_good env_close [$dbenv close] 0 +} + +proc env003_make_config { tmpdir } { + global testdir + + set cid [open $testdir/DB_CONFIG w] + puts $cid "set_data_dir ." + puts $cid "set_tmp_dir $tmpdir" + close $cid +} diff --git a/bdb/test/env004.tcl b/bdb/test/env004.tcl new file mode 100644 index 00000000000..82cc8dd25c7 --- /dev/null +++ b/bdb/test/env004.tcl @@ -0,0 +1,103 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: env004.tcl,v 11.14 2000/08/25 14:21:50 sue Exp $ +# +# Env Test 4 +# Test multiple data directories. Do a bunch of different opens +# to make sure that the files are detected in different directories. +proc env004 { } { + source ./include.tcl + + set method "hash" + set omethod [convert_method $method] + set args [convert_args $method ""] + + puts "Env004: Multiple data directory test." + + env_cleanup $testdir + file mkdir $testdir/data1 + file mkdir $testdir/data2 + file mkdir $testdir/data3 + + puts "\tEnv004.a: Multiple data directories in DB_CONFIG file" + + # Create a config file + set cid [open $testdir/DB_CONFIG w] + puts $cid "set_data_dir ." + puts $cid "set_data_dir data1" + puts $cid "set_data_dir data2" + puts $cid "set_data_dir data3" + close $cid + + # Now get pathnames + set curdir [pwd] + cd $testdir + set fulldir [pwd] + cd $curdir + + set e [berkdb env -create -private -home $testdir] + error_check_good dbenv [is_valid_env $e] TRUE + ddir_test $fulldir $method $e $args + error_check_good env_close [$e close] 0 + + puts "\tEnv004.b: Multiple data directories in berkdb env call." + env_cleanup $testdir + file mkdir $testdir/data1 + file mkdir $testdir/data2 + file mkdir $testdir/data3 + + # Now call dbenv with config specified + set e [berkdb env -create -private \ + -data_dir . -data_dir data1 -data_dir data2 \ + -data_dir data3 -home $testdir] + error_check_good dbenv [is_valid_env $e] TRUE + ddir_test $fulldir $method $e $args + error_check_good env_close [$e close] 0 + + env_cleanup $testdir +} + +proc ddir_test { fulldir method e args } { + source ./include.tcl + + set args [convert_args $args] + set omethod [convert_method $method] + + # Now create one file in each directory + set db1 [eval {berkdb_open -create \ + -truncate -mode 0644 $omethod -env $e} $args {data1/datafile1.db}] + error_check_good dbopen1 [is_valid_db $db1] TRUE + + set db2 [eval {berkdb_open -create \ + -truncate -mode 0644 $omethod -env $e} $args {data2/datafile2.db}] + error_check_good dbopen2 [is_valid_db $db2] TRUE + + set db3 [eval {berkdb_open -create \ + -truncate -mode 0644 $omethod -env $e} $args {data3/datafile3.db}] + error_check_good dbopen3 [is_valid_db $db3] TRUE + + # Close the files + error_check_good db_close1 [$db1 close] 0 + error_check_good db_close2 [$db2 close] 0 + error_check_good db_close3 [$db3 close] 0 + + # Now, reopen the files without complete pathnames and make + # sure that we find them. + + set db1 [berkdb_open -env $e $fulldir/data1/datafile1.db] + error_check_good dbopen1 [is_valid_db $db1] TRUE + + set db2 [berkdb_open -env $e $fulldir/data2/datafile2.db] + error_check_good dbopen2 [is_valid_db $db2] TRUE + + set db3 [berkdb_open -env $e $fulldir/data3/datafile3.db] + error_check_good dbopen3 [is_valid_db $db3] TRUE + + # Finally close all the files + error_check_good db_close1 [$db1 close] 0 + error_check_good db_close2 [$db2 close] 0 + error_check_good db_close3 [$db3 close] 0 +} diff --git a/bdb/test/env005.tcl b/bdb/test/env005.tcl new file mode 100644 index 00000000000..4ad9419936f --- /dev/null +++ b/bdb/test/env005.tcl @@ -0,0 +1,53 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: env005.tcl,v 11.8 2000/08/25 14:21:50 sue Exp $ +# +# Env Test 5 +# Test that using subsystems without initializing them correctly +# returns an error. Cannot test mpool, because it is assumed +# in the Tcl code. +proc env005 { } { + source ./include.tcl + + puts "Env005: Uninitialized env subsystems test." + + env_cleanup $testdir + puts "\tEnv005.a: Creating env with no subsystems." + + set e [berkdb env -create -home $testdir] + error_check_good dbenv [is_valid_env $e] TRUE + set db [berkdb_open -create -btree $testdir/env005.db] + error_check_good dbopen [is_valid_db $db] TRUE + + set rlist { + { "lock_detect" "Env005.b0"} + { "lock_get read 1 1" "Env005.b1"} + { "lock_id" "Env005.b2"} + { "lock_stat" "Env005.b3"} + { "log_archive" "Env005.c0"} + { "log_file {1 1}" "Env005.c1"} + { "log_flush" "Env005.c2"} + { "log_get -first" "Env005.c3"} + { "log_put record" "Env005.c4"} + { "log_register $db xxx" "Env005.c5"} + { "log_stat" "Env005.c6"} + { "log_unregister $db" "Env005.c7"} + { "txn" "Env005.d0"} + { "txn_checkpoint" "Env005.d1"} + { "txn_stat" "Env005.d2"} + } + + foreach pair $rlist { + set cmd [lindex $pair 0] + set msg [lindex $pair 1] + puts "\t$msg: $cmd" + set stat [catch {eval $e $cmd} ret] + error_check_good $cmd $stat 1 + error_check_good $cmd.err [is_substr $ret invalid] 1 + } + error_check_good dbclose [$db close] 0 + error_check_good envclose [$e close] 0 +} diff --git a/bdb/test/env006.tcl b/bdb/test/env006.tcl new file mode 100644 index 00000000000..1a39886cafa --- /dev/null +++ b/bdb/test/env006.tcl @@ -0,0 +1,42 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: env006.tcl,v 11.5 2000/10/27 13:23:55 sue Exp $ +# +# Env Test 6 +# DB Utility Check +# Make sure that all the utilities exist and run. +# +proc env006 { } { + source ./include.tcl + + puts "Env006: Run underlying utilities." + + set rlist { + { "db_archive" "Env006.a"} + { "db_checkpoint" "Env006.b"} + { "db_deadlock" "Env006.c"} + { "db_dump" "Env006.d"} + { "db_load" "Env006.e"} + { "db_printlog" "Env006.f"} + { "db_recover" "Env006.g"} + { "db_stat" "Env006.h"} + } + foreach pair $rlist { + set cmd [lindex $pair 0] + set msg [lindex $pair 1] + + puts "\t$msg: $cmd" + + set stat [catch {exec $util_path/$cmd -?} ret] + error_check_good $cmd $stat 1 + + # + # Check for "usage", but only check "sage" so that + # we can handle either Usage or usage. + # + error_check_good $cmd.err [is_substr $ret sage] 1 + } +} diff --git a/bdb/test/env007.tcl b/bdb/test/env007.tcl new file mode 100644 index 00000000000..b8ddea75c91 --- /dev/null +++ b/bdb/test/env007.tcl @@ -0,0 +1,100 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: env007.tcl,v 11.5 2000/08/25 14:21:50 sue Exp $ +# +# Env Test 007 +# Test various config file options. +# 1) Make sure command line option is respected +# 2) Make sure that config file option is respected +# 3) Make sure that if -both- DB_CONFIG and the set_<whatever> +# method is used, only the file is respected. +proc env007 { } { + # env007 is essentially just a small driver that runs + # env007_body twice. First, it supplies a "set" argument + # to use with environment opens, and the second time it sets + # DB_CONFIG instead. + # Note that env007_body itself calls env007_run_test to run + # the body of the actual test. + + source ./include.tcl + + puts "Env007: DB_CONFIG test." + + # + # Test only those options we can easily check via stat + # + set rlist { + { " -txn_max " "set_tx_max" "19" "31" "Env007.a: Txn Max" + "txn_stat" "Max Txns"} + { " -lock_max " "set_lk_max" "19" "31" "Env007.b: Lock Max" + "lock_stat" "Max locks"} + { " -log_buffer " "set_lg_bsize" "65536" "131072" "Env007.c: Log Bsize" + "log_stat" "Log record cache size"} + { " -log_max " "set_lg_max" "8388608" "9437184" "Env007.d: Log Max" + "log_stat" "Maximum log file size"} + } + + set e "berkdb env -create -mode 0644 -home $testdir -log -lock -txn " + foreach item $rlist { + set envarg [lindex $item 0] + set configarg [lindex $item 1] + set envval [lindex $item 2] + set configval [lindex $item 3] + set msg [lindex $item 4] + set statcmd [lindex $item 5] + set statstr [lindex $item 6] + + env_cleanup $testdir + # First verify using just env args + puts "\t$msg Environment argument only" + set env [eval $e $envarg $envval] + error_check_good envopen:0 [is_valid_env $env] TRUE + env007_check $env $statcmd $statstr $envval + error_check_good envclose:0 [$env close] 0 + + env_cleanup $testdir + env007_make_config $configarg $configval + + # verify using just config file + puts "\t$msg Config file only" + set env [eval $e] + error_check_good envopen:1 [is_valid_env $env] TRUE + env007_check $env $statcmd $statstr $configval + error_check_good envclose:1 [$env close] 0 + + # First verify using just env args + puts "\t$msg Environment arg and config file" + set env [eval $e $envarg $envval] + error_check_good envopen:2 [is_valid_env $env] TRUE + env007_check $env $statcmd $statstr $configval + error_check_good envclose:2 [$env close] 0 + } +} + +proc env007_check { env statcmd statstr testval } { + set stat [$env $statcmd] + set checked 0 + foreach statpair $stat { + if {$checked == 1} { + break + } + set statmsg [lindex $statpair 0] + set statval [lindex $statpair 1] + if {[is_substr $statmsg $statstr] != 0} { + set checked 1 + error_check_good $statstr:ck $statval $testval + } + } + error_check_good $statstr:test $checked 1 +} + +proc env007_make_config { carg cval } { + global testdir + + set cid [open $testdir/DB_CONFIG w] + puts $cid "$carg $cval" + close $cid +} diff --git a/bdb/test/env008.tcl b/bdb/test/env008.tcl new file mode 100644 index 00000000000..645f07f63d6 --- /dev/null +++ b/bdb/test/env008.tcl @@ -0,0 +1,73 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: env008.tcl,v 11.2 2000/10/30 19:00:38 sue Exp $ +# +# Test of env and subdirs. +proc env008 { } { + global errorInfo + global errorCode + + source ./include.tcl + + env_cleanup $testdir + + set subdir 1/1 + set subdir1 1/2 + file mkdir $testdir/$subdir $testdir/$subdir1 + set testfile $subdir/env.db + + puts "Env008: Test of environments and subdirectories." + + # Try opening without Create flag should error + puts "\tEnv008.a: Create env and db." + set env [berkdb env -create -mode 0644 -home $testdir -txn] + error_check_good env [is_valid_env $env] TRUE + + puts "\tEnv008.b: Remove db in subdir." + env008_db $env $testfile + error_check_good dbremove:$testfile \ + [berkdb dbremove -env $env $testfile] 0 + + # + # Rather than remaking the db every time for the renames + # just move around the new file name to another new file + # name. + # + puts "\tEnv008.c: Rename db in subdir." + env008_db $env $testfile + set newfile $subdir/new.db + error_check_good dbrename:$testfile/.. \ + [berkdb dbrename -env $env $testfile $newfile] 0 + set testfile $newfile + + puts "\tEnv008.d: Rename db to parent dir." + set newfile $subdir/../new.db + error_check_good dbrename:$testfile/.. \ + [berkdb dbrename -env $env $testfile $newfile] 0 + set testfile $newfile + + puts "\tEnv008.e: Rename db to child dir." + set newfile $subdir/env.db + error_check_good dbrename:$testfile/.. \ + [berkdb dbrename -env $env $testfile $newfile] 0 + set testfile $newfile + + puts "\tEnv008.f: Rename db to another dir." + set newfile $subdir1/env.db + error_check_good dbrename:$testfile/.. \ + [berkdb dbrename -env $env $testfile $newfile] 0 + + error_check_good envclose [$env close] 0 + puts "\tEnv008 complete." +} + +proc env008_db { env testfile } { + set db [berkdb_open -env $env -create -btree $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + set ret [$db put key data] + error_check_good dbput $ret 0 + error_check_good dbclose [$db close] 0 +} diff --git a/bdb/test/hsearch.tcl b/bdb/test/hsearch.tcl new file mode 100644 index 00000000000..0afee7fb2de --- /dev/null +++ b/bdb/test/hsearch.tcl @@ -0,0 +1,51 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: hsearch.tcl,v 11.7 2000/08/25 14:21:50 sue Exp $ +# +# Historic Hsearch interface test. +# Use the first 1000 entries from the dictionary. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Then reopen the file, re-retrieve everything. +# Finally, delete everything. +proc hsearch { { nentries 1000 } } { + source ./include.tcl + + puts "HSEARCH interfaces test: $nentries" + + # Create the database and open the dictionary + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir NULL + + error_check_good hcreate [berkdb hcreate $nentries] 0 + set did [open $dict] + set count 0 + + puts "\tHSEARCH.a: put/get loop" + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + set ret [berkdb hsearch $str $str enter] + error_check_good hsearch:enter $ret 0 + + set d [berkdb hsearch $str 0 find] + error_check_good hsearch:find $d $str + incr count + } + close $did + + puts "\tHSEARCH.b: re-get loop" + set did [open $dict] + # Here is the loop where we retrieve each key + while { [gets $did str] != -1 && $count < $nentries } { + set d [berkdb hsearch $str 0 find] + error_check_good hsearch:find $d $str + incr count + } + close $did + error_check_good hdestroy [berkdb hdestroy] 0 +} diff --git a/bdb/test/include.tcl b/bdb/test/include.tcl new file mode 100644 index 00000000000..e5084d6507c --- /dev/null +++ b/bdb/test/include.tcl @@ -0,0 +1,19 @@ +set tclsh_path @TCL_TCLSH@ +set tcllib .libs/libdb_tcl-@DB_VERSION_MAJOR@.@DB_VERSION_MINOR@.@SOSUFFIX@ +set rpc_server localhost +set rpc_path . +set test_path @srcdir@/../test + +set KILL "@db_cv_path_kill@" + +# DO NOT EDIT BELOW THIS LINE: automatically built by dist/s_tcl. + +global dict +global testdir +global util_path +set testdir ./TESTDIR +set rpc_testdir $rpc_path/TESTDIR + +global is_hp_test +global is_qnx_test +global is_windows_test diff --git a/bdb/test/join.tcl b/bdb/test/join.tcl new file mode 100644 index 00000000000..ebf33b8cdf3 --- /dev/null +++ b/bdb/test/join.tcl @@ -0,0 +1,451 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: join.tcl,v 11.17 2000/08/25 14:21:51 sue Exp $ +# +# We'll test 2-way, 3-way, and 4-way joins and figure that if those work, +# everything else does as well. We'll create test databases called +# join1.db, join2.db, join3.db, and join4.db. The number on the database +# describes the duplication -- duplicates are of the form 0, N, 2N, 3N, ... +# where N is the number of the database. Primary.db is the primary database, +# and null.db is the database that has no matching duplicates. +# +# We should test this on all btrees, all hash, and a combination thereof +# Join test. +proc jointest { {psize 8192} {with_dup_dups 0} {flags 0} } { + global testdir + global rand_init + source ./include.tcl + + env_cleanup $testdir + berkdb srand $rand_init + + # Use one environment for all database opens so we don't + # need oodles of regions. + set env [berkdb env -create -home $testdir] + error_check_good env_open [is_valid_env $env] TRUE + + # With the new offpage duplicate code, we don't support + # duplicate duplicates in sorted dup sets. Thus, if with_dup_dups + # is greater than one, run only with "-dup". + if { $with_dup_dups > 1 } { + set doptarray {"-dup"} + } else { + set doptarray {"-dup -dupsort" "-dup" RANDOMMIX RANDOMMIX } + } + + # NB: these flags are internal only, ok + foreach m "DB_BTREE DB_HASH DB_BOTH" { + # run with two different random mixes. + foreach dopt $doptarray { + set opt [list "-env" $env $dopt] + + puts "Join test: ($m $dopt) psize $psize,\ + $with_dup_dups dup\ + dups, flags $flags." + + build_all $m $psize $opt oa $with_dup_dups + + # null.db is db_built fifth but is referenced by + # zero; set up the option array appropriately. + set oa(0) $oa(5) + + # Build the primary + puts "\tBuilding the primary database $m" + set oflags "-create -truncate -mode 0644 -env $env\ + [conv $m [berkdb random_int 1 2]]" + set db [eval {berkdb_open} $oflags primary.db] + error_check_good dbopen [is_valid_db $db] TRUE + for { set i 0 } { $i < 1000 } { incr i } { + set key [format "%04d" $i] + set ret [$db put $key stub] + error_check_good "primary put" $ret 0 + } + error_check_good "primary close" [$db close] 0 + set did [open $dict] + gets $did str + do_join primary.db "1 0" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "2 0" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "3 0" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "4 0" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "1" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "2" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "3" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "4" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "1 2" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "1 2 3" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "1 2 3 4" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "2 1" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "3 2 1" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "4 3 2 1" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "1 3" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "3 1" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "1 4" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "4 1" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "2 3" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "3 2" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "2 4" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "4 2" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "3 4" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "4 3" $str oa $flags $with_dup_dups + gets $did str + do_join primary.db "2 3 4" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "3 4 1" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "4 2 1" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "0 2 1" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "3 2 0" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "4 3 2 1" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "4 3 0 1" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "3 3 3" $str oa $flags\ + $with_dup_dups + gets $did str + do_join primary.db "2 2 3 3" $str oa $flags\ + $with_dup_dups + gets $did str2 + gets $did str + do_join primary.db "1 2" $str oa $flags\ + $with_dup_dups "3" $str2 + + # You really don't want to run this section + # with $with_dup_dups > 2. + if { $with_dup_dups <= 2 } { + gets $did str2 + gets $did str + do_join primary.db "1 2 3" $str\ + oa $flags $with_dup_dups "3 3 1" $str2 + gets $did str2 + gets $did str + do_join primary.db "4 0 2" $str\ + oa $flags $with_dup_dups "4 3 3" $str2 + gets $did str2 + gets $did str + do_join primary.db "3 2 1" $str\ + oa $flags $with_dup_dups "0 2" $str2 + gets $did str2 + gets $did str + do_join primary.db "2 2 3 3" $str\ + oa $flags $with_dup_dups "1 4 4" $str2 + gets $did str2 + gets $did str + do_join primary.db "2 2 3 3" $str\ + oa $flags $with_dup_dups "0 0 4 4" $str2 + gets $did str2 + gets $did str + do_join primary.db "2 2 3 3" $str2\ + oa $flags $with_dup_dups "2 4 4" $str + gets $did str2 + gets $did str + do_join primary.db "2 2 3 3" $str2\ + oa $flags $with_dup_dups "0 0 4 4" $str + } + close $did + } + } + + error_check_good env_close [$env close] 0 +} + +proc build_all { method psize opt oaname with_dup_dups {nentries 100} } { + global testdir + db_build join1.db $nentries 50 1 [conv $method 1]\ + $psize $opt $oaname $with_dup_dups + db_build join2.db $nentries 25 2 [conv $method 2]\ + $psize $opt $oaname $with_dup_dups + db_build join3.db $nentries 16 3 [conv $method 3]\ + $psize $opt $oaname $with_dup_dups + db_build join4.db $nentries 12 4 [conv $method 4]\ + $psize $opt $oaname $with_dup_dups + db_build null.db $nentries 0 5 [conv $method 5]\ + $psize $opt $oaname $with_dup_dups +} + +proc conv { m i } { + switch -- $m { + DB_HASH { return "-hash"} + "-hash" { return "-hash"} + DB_BTREE { return "-btree"} + "-btree" { return "-btree"} + DB_BOTH { + if { [expr $i % 2] == 0 } { + return "-hash"; + } else { + return "-btree"; + } + } + } +} + +proc random_opts { } { + set j [berkdb random_int 0 1] + if { $j == 0 } { + return " -dup" + } else { + return " -dup -dupsort" + } +} + +proc db_build { name nkeys ndups dup_interval method psize lopt oaname \ + with_dup_dups } { + source ./include.tcl + + # Get array of arg names (from two levels up the call stack) + upvar 2 $oaname oa + + # Search for "RANDOMMIX" in $opt, and if present, replace + # with " -dup" or " -dup -dupsort" at random. + set i [lsearch $lopt RANDOMMIX] + if { $i != -1 } { + set lopt [lreplace $lopt $i $i [random_opts]] + } + + # Save off db_open arguments for this database. + set opt [eval concat $lopt] + set oa($dup_interval) $opt + + # Create the database and open the dictionary + set oflags "-create -truncate -mode 0644 $method\ + -pagesize $psize" + set db [eval {berkdb_open} $oflags $opt $name] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + set count 0 + puts -nonewline "\tBuilding $name: $nkeys keys " + puts -nonewline "with $ndups duplicates at interval of $dup_interval" + if { $with_dup_dups > 0 } { + puts "" + puts "\t\tand $with_dup_dups duplicate duplicates." + } else { + puts "." + } + for { set count 0 } { [gets $did str] != -1 && $count < $nkeys } { + incr count} { + set str $str$name + # We need to make sure that the dups are inserted in a + # random, or near random, order. Do this by generating + # them and putting each in a list, then sorting the list + # at random. + set duplist {} + for { set i 0 } { $i < $ndups } { incr i } { + set data [format "%04d" [expr $i * $dup_interval]] + lappend duplist $data + } + # randomize the list + for { set i 0 } { $i < $ndups } {incr i } { + # set j [berkdb random_int $i [expr $ndups - 1]] + set j [expr ($i % 2) + $i] + if { $j >= $ndups } { set j $i } + set dupi [lindex $duplist $i] + set dupj [lindex $duplist $j] + set duplist [lreplace $duplist $i $i $dupj] + set duplist [lreplace $duplist $j $j $dupi] + } + foreach data $duplist { + if { $with_dup_dups != 0 } { + for { set j 0 }\ + { $j < $with_dup_dups }\ + {incr j} { + set ret [$db put $str $data] + error_check_good put$j $ret 0 + } + } else { + set ret [$db put $str $data] + error_check_good put $ret 0 + } + } + + if { $ndups == 0 } { + set ret [$db put $str NODUP] + error_check_good put $ret 0 + } + } + close $did + error_check_good close:$name [$db close] 0 +} + +proc do_join { primary dbs key oanm flags with_dup_dups {dbs2 ""} {key2 ""} } { + global testdir + source ./include.tcl + + upvar $oanm oa + + puts -nonewline "\tJoining: $dbs on $key" + if { $dbs2 == "" } { + puts "" + } else { + puts " with $dbs2 on $key2" + } + + # Open all the databases + set p [berkdb_open -unknown $testdir/$primary] + error_check_good "primary open" [is_valid_db $p] TRUE + + set dblist "" + set curslist "" + + set ndx [llength $dbs] + + foreach i [concat $dbs $dbs2] { + set opt $oa($i) + set db [eval {berkdb_open -unknown} $opt [n_to_name $i]] + error_check_good "[n_to_name $i] open" [is_valid_db $db] TRUE + set curs [$db cursor] + error_check_good "$db cursor" \ + [is_substr $curs "$db.c"] 1 + lappend dblist $db + lappend curslist $curs + + if { $ndx > 0 } { + set realkey [concat $key[n_to_name $i]] + } else { + set realkey [concat $key2[n_to_name $i]] + } + + set pair [$curs get -set $realkey] + error_check_good cursor_set:$realkey:$pair \ + [llength [lindex $pair 0]] 2 + + incr ndx -1 + } + + set join_curs [eval {$p join} $curslist] + error_check_good join_cursor \ + [is_substr $join_curs "$p.c"] 1 + + # Calculate how many dups we expect. + # We go through the list of indices. If we find a 0, then we + # expect 0 dups. For everything else, we look at pairs of numbers, + # if the are relatively prime, multiply them and figure out how + # many times that goes into 50. If they aren't relatively prime, + # take the number of times the larger goes into 50. + set expected 50 + set last 1 + foreach n [concat $dbs $dbs2] { + if { $n == 0 } { + set expected 0 + break + } + if { $last == $n } { + continue + } + + if { [expr $last % $n] == 0 || [expr $n % $last] == 0 } { + if { $n > $last } { + set last $n + set expected [expr 50 / $last] + } + } else { + set last [expr $n * $last / [gcd $n $last]] + set expected [expr 50 / $last] + } + } + + # If $with_dup_dups is greater than zero, each datum has + # been inserted $with_dup_dups times. So we expect the number + # of dups to go up by a factor of ($with_dup_dups)^(number of databases) + + if { $with_dup_dups > 0 } { + foreach n [concat $dbs $dbs2] { + set expected [expr $expected * $with_dup_dups] + } + } + + set ndups 0 + if { $flags == " -join_item"} { + set l 1 + } else { + set flags "" + set l 2 + } + for { set pair [eval {$join_curs get} $flags] } { \ + [llength [lindex $pair 0]] == $l } { + set pair [eval {$join_curs get} $flags] } { + set k [lindex [lindex $pair 0] 0] + foreach i $dbs { + error_check_bad valid_dup:$i:$dbs $i 0 + set kval [string trimleft $k 0] + if { [string length $kval] == 0 } { + set kval 0 + } + error_check_good valid_dup:$i:$dbs [expr $kval % $i] 0 + } + incr ndups + } + error_check_good number_of_dups:$dbs $ndups $expected + + error_check_good close_primary [$p close] 0 + foreach i $curslist { + error_check_good close_cursor:$i [$i close] 0 + } + foreach i $dblist { + error_check_good close_index:$i [$i close] 0 + } +} + +proc n_to_name { n } { +global testdir + if { $n == 0 } { + return null.db; + } else { + return join$n.db; + } +} + +proc gcd { a b } { + set g 1 + + for { set i 2 } { $i <= $a } { incr i } { + if { [expr $a % $i] == 0 && [expr $b % $i] == 0 } { + set g $i + } + } + return $g +} diff --git a/bdb/test/lock001.tcl b/bdb/test/lock001.tcl new file mode 100644 index 00000000000..d571a987240 --- /dev/null +++ b/bdb/test/lock001.tcl @@ -0,0 +1,170 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: lock001.tcl,v 11.11 2000/08/25 14:21:51 sue Exp $ +# +# Test driver for lock tests. +# General Multi Random +# Options are: +# -dir <directory in which to store mpool> Y Y Y +# -iterations <iterations> Y N Y +# -ldegree <number of locks per iteration> N N Y +# -maxlocks <locks in table> Y Y Y +# -objs <number of objects> N N Y +# -procs <number of processes to run> N N Y +# -reads <read ratio> N N Y +# -seeds <list of seed values for processes> N N Y +# -wait <wait interval after getting locks> N N Y +# -conflicts <conflict matrix; a list of lists> Y Y Y +proc lock_usage {} { + puts stderr "randomlock\n\t-dir <dir>\n\t-iterations <iterations>" + puts stderr "\t-conflicts <conflict matrix>" + puts stderr "\t-ldegree <locks per iteration>\n\t-maxlocks <n>" + puts stderr "\t-objs <objects>\n\t-procs <nprocs>\n\t-reads <%reads>" + puts stderr "\t-seeds <list of seeds>\n\t-wait <max wait interval>" + return +} + +proc locktest { args } { + source ./include.tcl + + # Set defaults + # Adjusted to make exact match of isqrt + #set conflicts { 3 0 0 0 0 0 1 0 1 1} + #set conflicts { 3 0 0 0 0 1 0 1 1} + set conflicts { 0 0 0 0 0 1 0 1 1} + set iterations 1000 + set ldegree 5 + set maxlocks 1000 + set objs 75 + set procs 5 + set reads 65 + set seeds {} + set wait 5 + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -c.* { incr i; set conflicts [linkdex $args $i] } + -d.* { incr i; set testdir [lindex $args $i] } + -i.* { incr i; set iterations [lindex $args $i] } + -l.* { incr i; set ldegree [lindex $args $i] } + -m.* { incr i; set maxlocks [lindex $args $i] } + -o.* { incr i; set objs [lindex $args $i] } + -p.* { incr i; set procs [lindex $args $i] } + -r.* { incr i; set reads [lindex $args $i] } + -s.* { incr i; set seeds [lindex $args $i] } + -w.* { incr i; set wait [lindex $args $i] } + default { + puts -nonewline "FAIL:[timestamp] Usage: " + lock_usage + return + } + } + } + set nmodes [isqrt [llength $conflicts]] + + # Cleanup + env_cleanup $testdir + + # Open the region we'll use for testing. + set eflags "-create -lock -home $testdir -mode 0644 \ + -lock_max $maxlocks -lock_conflict {$nmodes {$conflicts}}" + set env [eval {berkdb env} $eflags] + lock001 $env $iterations $nmodes + reset_env $env + env_cleanup $testdir + + lock002 $maxlocks $conflicts + + lock003 $testdir $iterations \ + $maxlocks $procs $ldegree $objs $reads $wait $conflicts $seeds +} + +# Make sure that the basic lock tests work. Do some simple gets and puts for +# a single locker. +proc lock001 {env iter nmodes} { + source ./include.tcl + + puts "Lock001: test basic lock operations" + set locker 999 + # Get and release each type of lock + puts "Lock001.a: get and release each type of lock" + foreach m {ng write read} { + set obj obj$m + set lockp [$env lock_get $m $locker $obj] + error_check_good lock_get:a [is_blocked $lockp] 0 + error_check_good lock_get:a [is_substr $lockp $env] 1 + set ret [ $lockp put ] + error_check_good lock_put $ret 0 + } + + # Get a bunch of locks for the same locker; these should work + set obj OBJECT + puts "Lock001.b: Get a bunch of locks for the same locker" + foreach m {ng write read} { + set lockp [$env lock_get $m $locker $obj ] + lappend locklist $lockp + error_check_good lock_get:b [is_blocked $lockp] 0 + error_check_good lock_get:b [is_substr $lockp $env] 1 + } + release_list $locklist + + set locklist {} + # Check that reference counted locks work + puts "Lock001.c: reference counted locks." + for {set i 0} { $i < 10 } {incr i} { + set lockp [$env lock_get -nowait write $locker $obj] + error_check_good lock_get:c [is_blocked $lockp] 0 + error_check_good lock_get:c [is_substr $lockp $env] 1 + lappend locklist $lockp + } + release_list $locklist + + # Finally try some failing locks + set locklist {} + foreach i {ng write read} { + set lockp [$env lock_get $i $locker $obj] + lappend locklist $lockp + error_check_good lock_get:d [is_blocked $lockp] 0 + error_check_good lock_get:d [is_substr $lockp $env] 1 + } + + # Change the locker + set locker [incr locker] + set blocklist {} + # Skip NO_LOCK lock. + puts "Lock001.e: Change the locker, acquire read and write." + foreach i {write read} { + catch {$env lock_get -nowait $i $locker $obj} ret + error_check_good lock_get:e [is_substr $ret "not granted"] 1 + #error_check_good lock_get:e [is_substr $lockp $env] 1 + #error_check_good lock_get:e [is_blocked $lockp] 0 + } + # Now release original locks + release_list $locklist + + # Now re-acquire blocking locks + set locklist {} + puts "Lock001.f: Re-acquire blocking locks." + foreach i {write read} { + set lockp [$env lock_get -nowait $i $locker $obj ] + error_check_good lock_get:f [is_substr $lockp $env] 1 + error_check_good lock_get:f [is_blocked $lockp] 0 + lappend locklist $lockp + } + + # Now release new locks + release_list $locklist + + puts "Lock001 Complete." +} + +# Blocked locks appear as lockmgrN.lockM\nBLOCKED +proc is_blocked { l } { + if { [string compare $l BLOCKED ] == 0 } { + return 1 + } else { + return 0 + } +} diff --git a/bdb/test/lock002.tcl b/bdb/test/lock002.tcl new file mode 100644 index 00000000000..b433730b1e6 --- /dev/null +++ b/bdb/test/lock002.tcl @@ -0,0 +1,151 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: lock002.tcl,v 11.10 2000/08/25 14:21:51 sue Exp $ +# +# Exercise basic multi-process aspects of lock. +proc lock002 { {maxlocks 1000} {conflicts {0 0 0 0 0 1 0 1 1} } } { + source ./include.tcl + + puts "Lock002: Basic multi-process lock tests." + + env_cleanup $testdir + + set nmodes [isqrt [llength $conflicts]] + + # Open the lock + mlock_open $maxlocks $nmodes $conflicts + mlock_wait +} + +# Make sure that we can create a region; destroy it, attach to it, +# detach from it, etc. +proc mlock_open { maxl nmodes conflicts } { + source ./include.tcl + + puts "Lock002.a multi-process open/close test" + + # Open/Create region here. Then close it and try to open from + # other test process. + set env_cmd [concat "berkdb env -create -mode 0644 \ + -lock -lock_max $maxl -lock_conflict" \ + [list [list $nmodes $conflicts]] "-home $testdir"] + set local_env [eval $env_cmd] + error_check_good env_open [is_valid_env $local_env] TRUE + + set ret [$local_env close] + error_check_good env_close $ret 0 + + # Open from other test process + set env_cmd "berkdb env -mode 0644 -home $testdir" + + set f1 [open |$tclsh_path r+] + puts $f1 "source $test_path/test.tcl" + + set remote_env [send_cmd $f1 $env_cmd] + error_check_good remote:env_open [is_valid_env $remote_env] TRUE + + # Now make sure that we can reopen the region. + set local_env [eval $env_cmd] + error_check_good env_open [is_valid_env $local_env] TRUE + set ret [$local_env close] + error_check_good env_close $ret 0 + + # Try closing the remote region + set ret [send_cmd $f1 "$remote_env close"] + error_check_good remote:lock_close $ret 0 + + # Try opening for create. Will succeed because region exists. + set env_cmd [concat "berkdb env -create -mode 0644 \ + -lock -lock_max $maxl -lock_conflict" \ + [list [list $nmodes $conflicts]] "-home $testdir"] + set local_env [eval $env_cmd] + error_check_good remote:env_open [is_valid_env $local_env] TRUE + + # close locally + reset_env $local_env + + # Close and exit remote + set ret [send_cmd $f1 "reset_env $remote_env"] + + catch { close $f1 } result +} + +proc mlock_wait { } { + source ./include.tcl + + puts "Lock002.b multi-process get/put wait test" + + # Open region locally + set env_cmd "berkdb env -lock -home $testdir" + set local_env [eval $env_cmd] + error_check_good env_open [is_valid_env $local_env] TRUE + + # Open region remotely + set f1 [open |$tclsh_path r+] + + puts $f1 "source $test_path/test.tcl" + + set remote_env [send_cmd $f1 $env_cmd] + error_check_good remote:env_open [is_valid_env $remote_env] TRUE + + # Get a write lock locally; try for the read lock + # remotely. We hold the locks for several seconds + # so that we can use timestamps to figure out if the + # other process waited. + set locker 1 + set local_lock [$local_env lock_get write $locker object1] + error_check_good lock_get [is_valid_lock $local_lock $local_env] TRUE + + # Now request a lock that we expect to hang; generate + # timestamps so we can tell if it actually hangs. + set locker 2 + set remote_lock [send_timed_cmd $f1 1 \ + "set lock \[$remote_env lock_get write $locker object1\]"] + + # Now sleep before releasing lock + tclsleep 5 + set result [$local_lock put] + error_check_good lock_put $result 0 + + # Now get the result from the other script + set result [rcv_result $f1] + error_check_good lock_get:remote_time [expr $result > 4] 1 + + # Now get the remote lock + set remote_lock [send_cmd $f1 "puts \$lock"] + error_check_good remote:lock_get \ + [is_valid_lock $remote_lock $remote_env] TRUE + + # Now make the other guy wait 5 second and then release his + # lock while we try to get a write lock on it + set start [timestamp -r] + + set ret [send_cmd $f1 "tclsleep 5"] + + set ret [send_cmd $f1 "$remote_lock put"] + + set locker 1 + set local_lock [$local_env lock_get write $locker object1] + error_check_good lock_get:time \ + [expr [expr [timestamp -r] - $start] > 2] 1 + error_check_good lock_get:local \ + [is_valid_lock $local_lock $local_env] TRUE + + # Now check remote's result + set result [rcv_result $f1] + error_check_good lock_put:remote $result 0 + + # Clean up remote + set ret [send_cmd $f1 "reset_env $remote_env"] + + close $f1 + + # Now close up locally + set ret [$local_lock put] + error_check_good lock_put $ret 0 + + reset_env $local_env +} diff --git a/bdb/test/lock003.tcl b/bdb/test/lock003.tcl new file mode 100644 index 00000000000..539b6d0ff66 --- /dev/null +++ b/bdb/test/lock003.tcl @@ -0,0 +1,48 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: lock003.tcl,v 11.16 2000/08/25 14:21:51 sue Exp $ +# +# Exercise multi-process aspects of lock. Generate a bunch of parallel +# testers that try to randomly obtain locks. +proc lock003 { dir {iter 500} {max 1000} {procs 5} {ldegree 5} {objs 75} \ + {reads 65} {wait 1} {conflicts { 3 0 0 0 0 0 1 0 1 1}} {seeds {}} } { + source ./include.tcl + + puts "Lock003: Multi-process random lock test" + + # Clean up after previous runs + env_cleanup $dir + + # Open/create the lock region + set e [berkdb env -create -lock -home $dir] + error_check_good env_open [is_substr $e env] 1 + + set ret [$e close] + error_check_good env_close $ret 0 + + # Now spawn off processes + set pidlist {} + for { set i 0 } {$i < $procs} {incr i} { + if { [llength $seeds] == $procs } { + set s [lindex $seeds $i] + } + puts "$tclsh_path\ + $test_path/wrap.tcl \ + lockscript.tcl $dir/$i.lockout\ + $dir $iter $objs $wait $ldegree $reads &" + set p [exec $tclsh_path $test_path/wrap.tcl \ + lockscript.tcl $testdir/lock003.$i.out \ + $dir $iter $objs $wait $ldegree $reads &] + lappend pidlist $p + } + + puts "Lock003: $procs independent processes now running" + watch_procs 30 10800 + # Remove log files + for { set i 0 } {$i < $procs} {incr i} { + fileremove -f $dir/$i.lockout + } +} diff --git a/bdb/test/lockscript.tcl b/bdb/test/lockscript.tcl new file mode 100644 index 00000000000..bd07d80b54b --- /dev/null +++ b/bdb/test/lockscript.tcl @@ -0,0 +1,88 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: lockscript.tcl,v 11.11 2000/03/24 19:53:39 krinsky Exp $ +# +# Random lock tester. +# Usage: lockscript dir numiters numobjs sleepint degree readratio +# dir: lock directory. +# numiters: Total number of iterations. +# numobjs: Number of objects on which to lock. +# sleepint: Maximum sleep interval. +# degree: Maximum number of locks to acquire at once +# readratio: Percent of locks that should be reads. + +source ./include.tcl +source $test_path/test.tcl + +set usage "lockscript dir numiters numobjs sleepint degree readratio" + +# Verify usage +if { $argc != 6 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + exit +} + +# Initialize arguments +set dir [lindex $argv 0] +set numiters [ lindex $argv 1 ] +set numobjs [ lindex $argv 2 ] +set sleepint [ lindex $argv 3 ] +set degree [ lindex $argv 4 ] +set readratio [ lindex $argv 5 ] +set locker [pid] + +# Initialize random number generator +global rand_init +berkdb srand $rand_init + +puts -nonewline "Beginning execution for $locker: $numiters $numobjs " +puts "$sleepint $degree $readratio" +flush stdout + +set e [berkdb env -create -lock -home $dir] +error_check_good env_open [is_substr $e env] 1 + +for { set iter 0 } { $iter < $numiters } { incr iter } { + set nlocks [berkdb random_int 1 $degree] + # We will always lock objects in ascending order to avoid + # deadlocks. + set lastobj 1 + set locklist {} + for { set lnum 0 } { $lnum < $nlocks } { incr lnum } { + # Pick lock parameters + set obj [berkdb random_int $lastobj $numobjs] + set lastobj [expr $obj + 1] + set x [berkdb random_int 1 100 ] + if { $x <= $readratio } { + set rw read + } else { + set rw write + } + puts "[timestamp] $locker $lnum: $rw $obj" + + # Do get; add to list + set lockp [$e lock_get $rw $locker $obj] + lappend locklist $lockp + if {$lastobj > $numobjs} { + break + } + } + # Pick sleep interval + tclsleep [berkdb random_int 1 $sleepint] + + # Now release locks + puts "[timestamp] $locker released locks" + release_list $locklist + flush stdout +} + +set ret [$e close] +error_check_good env_close $ret 0 + +puts "[timestamp] $locker Complete" +flush stdout + +exit diff --git a/bdb/test/log.tcl b/bdb/test/log.tcl new file mode 100644 index 00000000000..c3802d0f971 --- /dev/null +++ b/bdb/test/log.tcl @@ -0,0 +1,337 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: log.tcl,v 11.17 2000/11/30 20:09:19 dda Exp $ +# +# Options are: +# -dir <directory in which to store memp> +# -maxfilesize <maxsize of log file> +# -iterations <iterations> +# -stat +proc log_usage {} { + puts "log -dir <directory> -iterations <number of ops> \ + -maxfilesize <max size of log files> -stat" +} +proc logtest { args } { + source ./include.tcl + global rand_init + + # Set defaults + set iterations 1000 + set maxfile [expr 1024 * 128] + set dostat 0 + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -d.* { incr i; set testdir [lindex $args $i] } + -i.* { incr i; set iterations [lindex $args $i] } + -m.* { incr i; set maxfile [lindex $args $i] } + -s.* { set dostat 1 } + default { + puts -nonewline "FAIL:[timestamp] Usage: " + log_usage + return + } + } + } + set multi_log [expr 3 * $iterations] + + # Clean out old log if it existed + puts "Unlinking log: error message OK" + env_cleanup $testdir + + # Now run the various functionality tests + berkdb srand $rand_init + + log001 $testdir $maxfile $iterations + log001 $testdir $maxfile $multi_log + log002 $testdir $maxfile + log003 $testdir $maxfile + log004 $testdir +} + +proc log001 { dir max nrecs } { + source ./include.tcl + + puts "Log001: Basic put/get test" + + env_cleanup $dir + + set env [berkdb env -log -create -home $dir \ + -mode 0644 -log_max $max] + error_check_bad log_env:$dir $env NULL + error_check_good log:$dir [is_substr $env "env"] 1 + + # We will write records to the log and make sure we can + # read them back correctly. We'll use a standard pattern + # repeated some number of times for each record. + + set lsn_list {} + set rec_list {} + puts "Log001.a: Writing $nrecs log records" + for { set i 0 } { $i < $nrecs } { incr i } { + set rec "" + for { set j 0 } { $j < [expr $i % 10 + 1] } {incr j} { + set rec $rec$i:logrec:$i + } + set lsn [$env log_put $rec] + error_check_bad log_put [is_substr $lsn log_cmd] 1 + lappend lsn_list $lsn + lappend rec_list $rec + } + puts "Log001.b: Retrieving log records sequentially (forward)" + set i 0 + for { set grec [$env log_get -first] } { [llength $grec] != 0 } { + set grec [$env log_get -next]} { + error_check_good log_get:seq [lindex $grec 1] \ + [lindex $rec_list $i] + incr i + } + + puts "Log001.c: Retrieving log records sequentially (backward)" + set i [llength $rec_list] + for { set grec [$env log_get -last] } { [llength $grec] != 0 } { + set grec [$env log_get -prev] } { + incr i -1 + error_check_good \ + log_get:seq [lindex $grec 1] [lindex $rec_list $i] + } + + puts "Log001.d: Retrieving log records sequentially by LSN" + set i 0 + foreach lsn $lsn_list { + set grec [$env log_get -set $lsn] + error_check_good \ + log_get:seq [lindex $grec 1] [lindex $rec_list $i] + incr i + } + + puts "Log001.e: Retrieving log records randomly by LSN" + set m [expr [llength $lsn_list] - 1] + for { set i 0 } { $i < $nrecs } { incr i } { + set recno [berkdb random_int 0 $m ] + set lsn [lindex $lsn_list $recno] + set grec [$env log_get -set $lsn] + error_check_good \ + log_get:seq [lindex $grec 1] [lindex $rec_list $recno] + } + + # Close and unlink the file + error_check_good env:close:$env [$env close] 0 + error_check_good envremove:$dir [berkdb envremove -home $dir] 0 + + puts "Log001 Complete" +} + +proc log002 { dir {max 32768} } { + source ./include.tcl + + puts "Log002: Multiple log test w/trunc, file, compare functionality" + + env_cleanup $dir + + set env [berkdb env -create -home $dir -mode 0644 -log -log_max $max] + error_check_bad log_env:$dir $env NULL + error_check_good log:$dir [is_substr $env "env"] 1 + + # We'll record every hundred'th record for later use + set info_list {} + + set i 0 + puts "Log002.a: Writing log records" + + for {set s 0} { $s < [expr 3 * $max] } { incr s $len } { + set rec [random_data 120 0 0] + set len [string length $rec] + set lsn [$env log_put $rec] + + if { [expr $i % 100 ] == 0 } { + lappend info_list [list $lsn $rec] + } + incr i + } + + puts "Log002.b: Checking log_compare" + set last {0 0} + foreach p $info_list { + set l [lindex $p 0] + if { [llength $last] != 0 } { + error_check_good \ + log_compare [$env log_compare $l $last] 1 + error_check_good \ + log_compare [$env log_compare $last $l] -1 + error_check_good \ + log_compare [$env log_compare $l $l] 0 + } + set last $l + } + + puts "Log002.c: Checking log_file" + set flist [glob $dir/log*] + foreach p $info_list { + + set lsn [lindex $p 0] + set f [$env log_file $lsn] + + # Change all backslash separators on Windows to forward slash + # separators, which is what the rest of the test suite expects. + regsub -all {\\} $f {/} f + + error_check_bad log_file:$f [lsearch $flist $f] -1 + } + + puts "Log002.d: Verifying records" + for {set i [expr [llength $info_list] - 1] } { $i >= 0 } { incr i -1} { + set p [lindex $info_list $i] + set grec [$env log_get -set [lindex $p 0]] + error_check_good log_get:$env [lindex $grec 1] [lindex $p 1] + } + + # Close and unlink the file + error_check_good env:close:$env [$env close] 0 + error_check_good envremove:$dir [berkdb envremove -home $dir] 0 + + puts "Log002 Complete" +} + +proc log003 { dir {max 32768} } { + source ./include.tcl + + puts "Log003: Verify log_flush behavior" + + env_cleanup $dir + set short_rec "abcdefghijklmnopqrstuvwxyz" + set long_rec [repeat $short_rec 200] + set very_long_rec [repeat $long_rec 4] + + foreach rec "$short_rec $long_rec $very_long_rec" { + puts "Log003.a: Verify flush on [string length $rec] byte rec" + + set env [berkdb env -log -home $dir \ + -create -mode 0644 -log_max $max] + error_check_bad log_env:$dir $env NULL + error_check_good log:$dir [is_substr $env "env"] 1 + + set lsn [$env log_put $rec] + error_check_bad log_put [lindex $lsn 0] "ERROR:" + set ret [$env log_flush $lsn] + error_check_good log_flush $ret 0 + + # Now, we want to crash the region and recheck. Closing the + # log does not flush any records, so we'll use a close to + # do the "crash" + set ret [$env close] + error_check_good log_env:close $ret 0 + + # Now, remove the log region + #set ret [berkdb envremove -home $dir] + #error_check_good env:remove $ret 0 + + # Re-open the log and try to read the record. + set env [berkdb env -create -home $dir \ + -log -mode 0644 -log_max $max] + error_check_bad log_env:$dir $env NULL + error_check_good log:$dir [is_substr $env "env"] 1 + + set gotrec [$env log_get -first] + error_check_good lp_get [lindex $gotrec 1] $rec + + # Close and unlink the file + error_check_good env:close:$env [$env close] 0 + error_check_good envremove:$dir [berkdb envremove -home $dir] 0 + log_cleanup $dir + } + + foreach rec "$short_rec $long_rec $very_long_rec" { + puts "Log003.b: \ + Verify flush on non-last record [string length $rec]" + set env [berkdb env \ + -create -log -home $dir -mode 0644 -log_max $max] + error_check_bad log_env:$dir $env NULL + error_check_good log:$dir [is_substr $env "env"] 1 + + # Put 10 random records + for { set i 0 } { $i < 10 } { incr i} { + set r [random_data 450 0 0] + set lsn [$env log_put $r] + error_check_bad log_put [lindex $lsn 0] "ERROR:" + } + + # Put the record we are interested in + set save_lsn [$env log_put $rec] + error_check_bad log_put [lindex $save_lsn 0] "ERROR:" + + # Put 10 more random records + for { set i 0 } { $i < 10 } { incr i} { + set r [random_data 450 0 0] + set lsn [$env log_put $r] + error_check_bad log_put [lindex $lsn 0] "ERROR:" + } + + # Now check the flush + set ret [$env log_flush $save_lsn] + error_check_good log_flush $ret 0 + + # Now, we want to crash the region and recheck. Closing the + # log does not flush any records, so we'll use a close to + # do the "crash" + + # + # Now, close and remove the log region + error_check_good env:close:$env [$env close] 0 + set ret [berkdb envremove -home $dir] + error_check_good env:remove $ret 0 + + # Re-open the log and try to read the record. + set env [berkdb env \ + -home $dir -create -log -mode 0644 -log_max $max] + error_check_bad log_env:$dir $env NULL + error_check_good log:$dir [is_substr $env "env"] 1 + + set gotrec [$env log_get -set $save_lsn] + error_check_good lp_get [lindex $gotrec 1] $rec + + # Close and unlink the file + error_check_good env:close:$env [$env close] 0 + error_check_good envremove:$dir [berkdb envremove -home $dir] 0 + log_cleanup $dir + } + + puts "Log003 Complete" +} + +# Make sure that if we do PREVs on a log, but the beginning of the +# log has been truncated, we do the right thing. +proc log004 { dir } { + source ./include.tcl + + puts "Log004: Prev on log when beginning of log has been truncated." + # Use archive test to populate log + env_cleanup $dir + puts "Log004.a: Call archive to populate log." + archive + + # Delete all log files under 100 + puts "Log004.b: Delete all log files under 100." + set ret [catch { glob $dir/log.00000000* } result] + if { $ret == 0 } { + eval fileremove -f $result + } + + # Now open the log and get the first record and try a prev + puts "Log004.c: Open truncated log, attempt to access missing portion." + set myenv [berkdb env -create -log -home $dir] + error_check_good log_open [is_substr $myenv "env"] 1 + + set ret [$myenv log_get -first] + error_check_bad log_get [llength $ret] 0 + + # This should give DB_NOTFOUND which is a ret of length 0 + catch {$myenv log_get -prev} ret + error_check_good log_get_prev [string length $ret] 0 + + puts "Log004.d: Close log and environment." + error_check_good log_close [$myenv close] 0 + puts "Log004 complete." +} diff --git a/bdb/test/logtrack.list b/bdb/test/logtrack.list new file mode 100644 index 00000000000..ba7f34a6d13 --- /dev/null +++ b/bdb/test/logtrack.list @@ -0,0 +1,68 @@ +PREFIX crdel +BEGIN fileopen 141 +BEGIN metasub 142 +BEGIN metapage 143 +DEPRECATED old_delete 144 +BEGIN rename 145 +BEGIN delete 146 +PREFIX db +BEGIN addrem 41 +DEPRECATED split 42 +BEGIN big 43 +BEGIN ovref 44 +BEGIN relink 45 +DEPRECATED addpage 46 +BEGIN debug 47 +BEGIN noop 48 +PREFIX bam +BEGIN pg_alloc 51 +DEPRECATED pg_alloc1 60 +BEGIN pg_free 52 +DEPRECATED pg_free1 61 +DEPRECATED split1 53 +BEGIN split 62 +DEPRECATED rsplit1 54 +BEGIN rsplit 63 +BEGIN adj 55 +BEGIN cadjust 56 +BEGIN cdel 57 +BEGIN repl 58 +BEGIN root 59 +BEGIN curadj 64 +BEGIN rcuradj 65 +PREFIX ham +BEGIN insdel 21 +BEGIN newpage 22 +DEPRECATED splitmeta 23 +BEGIN splitdata 24 +BEGIN replace 25 +DEPRECATED newpgno 26 +DEPRECATED ovfl 27 +BEGIN copypage 28 +BEGIN metagroup 29 +DEPRECATED groupalloc1 30 +DEPRECATED groupalloc2 31 +BEGIN groupalloc 32 +BEGIN curadj 33 +BEGIN chgpg 34 +PREFIX log +DEPRECATED register1 1 +BEGIN register 2 +PREFIX qam +BEGIN inc 76 +BEGIN incfirst 77 +BEGIN mvptr 78 +BEGIN del 79 +BEGIN add 80 +BEGIN delete 81 +BEGIN rename 82 +BEGIN delext 83 +PREFIX txn +DEPRECATED old_regop 6 +BEGIN regop 10 +DEPRECATED old_ckp 7 +BEGIN ckp 11 +DEPRECATED xa_regop_old 8 +BEGIN xa_regop 13 +DEPRECATED child_old 9 +BEGIN child 12 diff --git a/bdb/test/logtrack.tcl b/bdb/test/logtrack.tcl new file mode 100644 index 00000000000..cea4912e627 --- /dev/null +++ b/bdb/test/logtrack.tcl @@ -0,0 +1,130 @@ +# See the file LICENSE for redistribution information +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: logtrack.tcl,v 11.6 2000/10/27 15:30:39 krinsky Exp $ +# +# logtrack.tcl: A collection of routines, formerly implemented in Perl +# as log.pl, to track which log record types the test suite hits. + +set ltsname "logtrack_seen.db" +set ltlist $test_path/logtrack.list +set tmpname "logtrack_tmp" + +proc logtrack_clean { } { + global ltsname + + file delete -force $ltsname + + return +} + +proc logtrack_init { } { + global ltsname + + logtrack_clean + + # Create an empty tracking database. + [berkdb_open -create -truncate -btree $ltsname] close + + return +} + +# Dump the logs for directory dirname and record which log +# records were seen. +proc logtrack_read { dirname } { + global ltsname tmpname util_path + + set seendb [berkdb_open $ltsname] + error_check_good seendb_open [is_valid_db $seendb] TRUE + + file delete -force $tmpname + set ret [catch {exec $util_path/db_printlog -N \ + -h "$dirname" > $tmpname} res] + error_check_good printlog $ret 0 + error_check_good tmpfile_exists [file exists $tmpname] 1 + + set f [open $tmpname r] + while { [gets $f record] >= 0 } { + regexp {\[[^\]]*\]\[[^\]]*\]([^\:]*)\:} $record whl name + error_check_good seendb_put [$seendb put $name ""] 0 + } + close $f + file delete -force $tmpname + + error_check_good seendb_close [$seendb close] 0 +} + +# Print the log record types that were seen but should not have been +# seen and the log record types that were not seen but should have been seen. +proc logtrack_summary { } { + global ltsname ltlist testdir + + set seendb [berkdb_open $ltsname] + error_check_good seendb_open [is_valid_db $seendb] TRUE + set existdb [berkdb_open -create -btree] + error_check_good existdb_open [is_valid_db $existdb] TRUE + set deprecdb [berkdb_open -create -btree] + error_check_good deprecdb_open [is_valid_db $deprecdb] TRUE + + error_check_good ltlist_exists [file exists $ltlist] 1 + set f [open $ltlist r] + set pref "" + while { [gets $f line] >= 0 } { + # Get the keyword, the first thing on the line: + # BEGIN/DEPRECATED/PREFIX + set keyword [lindex $line 0] + + if { [string compare $keyword PREFIX] == 0 } { + # New prefix. + set pref [lindex $line 1] + } elseif { [string compare $keyword BEGIN] == 0 } { + # A log type we care about; put it on our list. + + # Skip noop and debug. + if { [string compare [lindex $line 1] noop] == 0 } { + continue + } + if { [string compare [lindex $line 1] debug] == 0 } { + continue + } + + error_check_good exist_put [$existdb put \ + ${pref}_[lindex $line 1] ""] 0 + } elseif { [string compare $keyword DEPRECATED] == 0 } { + error_check_good deprec_put [$deprecdb put \ + ${pref}_[lindex $line 1] ""] 0 + } + } + + error_check_good exist_curs \ + [is_valid_cursor [set ec [$existdb cursor]] $existdb] TRUE + while { [llength [set dbt [$ec get -next]]] != 0 } { + set rec [lindex [lindex $dbt 0] 0] + if { [$seendb count $rec] == 0 } { + puts "FAIL: log record type $rec not seen" + } + } + error_check_good exist_curs_close [$ec close] 0 + + error_check_good seen_curs \ + [is_valid_cursor [set sc [$existdb cursor]] $existdb] TRUE + while { [llength [set dbt [$sc get -next]]] != 0 } { + set rec [lindex [lindex $dbt 0] 0] + if { [$existdb count $rec] == 0 } { + if { [$deprecdb count $rec] == 0 } { + puts "FAIL: unknown log record type $rec seen" + } else { + puts "FAIL: deprecated log record type $rec seen" + } + } + } + error_check_good seen_curs_close [$sc close] 0 + + error_check_good seendb_close [$seendb close] 0 + error_check_good existdb_close [$existdb close] 0 + error_check_good deprecdb_close [$deprecdb close] 0 + + logtrack_clean +} diff --git a/bdb/test/mdbscript.tcl b/bdb/test/mdbscript.tcl new file mode 100644 index 00000000000..368aad371b2 --- /dev/null +++ b/bdb/test/mdbscript.tcl @@ -0,0 +1,381 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: mdbscript.tcl,v 11.23 2000/10/09 02:26:11 krinsky Exp $ +# +# Process script for the multi-process db tester. + +source ./include.tcl +source $test_path/test.tcl +source $test_path/testutils.tcl + +global dbenv +global klock +global l_keys +global procid +global alphabet + +# In Tcl, when there are multiple catch handlers, *all* handlers +# are called, so we have to resort to this hack. +# +global exception_handled + +set exception_handled 0 + +set datastr $alphabet$alphabet + +# Usage: mdbscript dir file nentries iter procid procs seed +# dir: DBHOME directory +# file: db file on which to operate +# nentries: number of entries taken from dictionary +# iter: number of operations to run +# procid: this processes' id number +# procs: total number of processes running +set usage "mdbscript method dir file nentries iter procid procs" + +# Verify usage +if { $argc != 7 } { + puts "FAIL:[timestamp] test042: Usage: $usage" + exit +} + +# Initialize arguments +set method [lindex $argv 0] +set dir [lindex $argv 1] +set file [lindex $argv 2] +set nentries [ lindex $argv 3 ] +set iter [ lindex $argv 4 ] +set procid [ lindex $argv 5 ] +set procs [ lindex $argv 6 ] + +set pflags "" +set gflags "" +set txn "" + +set renum [is_rrecno $method] +set omethod [convert_method $method] + +if { [is_record_based $method] == 1 } { + append gflags " -recno" +} + +# Initialize seed +global rand_init + +# We want repeatable results, but we also want each instance of mdbscript +# to do something different. So we add the procid to the fixed seed. +# (Note that this is a serial number given by the caller, not a pid.) +berkdb srand [expr $rand_init + $procid] + +puts "Beginning execution for [pid] $method" +puts "$dir db_home" +puts "$file database" +puts "$nentries data elements" +puts "$iter iterations" +puts "$procid process id" +puts "$procs processes" + +set klock NOLOCK +flush stdout + +set dbenv [berkdb env -create -cdb -home $dir] +#set dbenv [berkdb env -create -cdb -log -home $dir] +error_check_good dbenv [is_valid_env $dbenv] TRUE + +set db [berkdb_open -env $dbenv -create -mode 0644 $omethod $file] +error_check_good dbopen [is_valid_db $db] TRUE + +# Init globals (no data) +set nkeys [db_init $db 0] +puts "Initial number of keys: $nkeys" +error_check_good db_init $nkeys $nentries +tclsleep 5 + +proc get_lock { k } { + global dbenv + global procid + global klock + global DB_LOCK_WRITE + global DB_LOCK_NOWAIT + global errorInfo + global exception_handled + # Make sure that the key isn't in the middle of + # a delete operation + if {[catch {$dbenv lock_get -nowait write $procid $k} klock] != 0 } { + set exception_handled 1 + + error_check_good \ + get_lock [is_substr $errorInfo "DB_LOCK_NOTGRANTED"] 1 + puts "Warning: key $k locked" + set klock NOLOCK + return 1 + } else { + error_check_good get_lock [is_valid_lock $klock $dbenv] TRUE + } + return 0 +} + +# On each iteration we're going to randomly pick a key. +# 1. We'll either get it (verifying that its contents are reasonable). +# 2. Put it (using an overwrite to make the data be datastr:ID). +# 3. Get it and do a put through the cursor, tacking our ID on to +# 4. Get it, read forward some random number of keys. +# 5. Get it, read forward some random number of keys and do a put (replace). +# 6. Get it, read forward some random number of keys and do a del. And then +# do a put of the key. +set gets 0 +set getput 0 +set overwrite 0 +set seqread 0 +set seqput 0 +set seqdel 0 +set dlen [string length $datastr] + +for { set i 0 } { $i < $iter } { incr i } { + set op [berkdb random_int 0 5] + puts "iteration $i operation $op" + flush stdout + if {[catch { + switch $op { + 0 { + incr gets + set k [rand_key $method $nkeys $renum $procs] + if {[is_record_based $method] == 1} { + set key $k + } else { + set key [lindex $l_keys $k] + } + + if { [get_lock $key] == 1 } { + incr i -1 + continue; + } + + set rec [eval {$db get} $txn $gflags {$key}] + error_check_bad "$db get $key" [llength $rec] 0 + set partial [string range \ + [lindex [lindex $rec 0] 1] 0 [expr $dlen - 1]] + error_check_good \ + "$db get $key" $partial [pad_data $method $datastr] + } + 1 { + incr overwrite + set k [rand_key $method $nkeys $renum $procs] + if {[is_record_based $method] == 1} { + set key $k + } else { + set key [lindex $l_keys $k] + } + + set data $datastr:$procid + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $data]}] + error_check_good "$db put $key" $ret 0 + } + 2 { + incr getput + set dbc [$db cursor -update] + error_check_good "$db cursor" \ + [is_valid_cursor $dbc $db] TRUE + set close_cursor 1 + set k [rand_key $method $nkeys $renum $procs] + if {[is_record_based $method] == 1} { + set key $k + } else { + set key [lindex $l_keys $k] + } + + if { [get_lock $key] == 1 } { + incr i -1 + error_check_good "$dbc close" \ + [$dbc close] 0 + set close_cursor 0 + continue; + } + + set ret [$dbc get -set $key] + error_check_good \ + "$dbc get $key" [llength [lindex $ret 0]] 2 + set rec [lindex [lindex $ret 0] 1] + set partial [string range $rec 0 [expr $dlen - 1]] + error_check_good \ + "$dbc get $key" $partial [pad_data $method $datastr] + append rec ":$procid" + set ret [$dbc put \ + -current [chop_data $method $rec]] + error_check_good "$dbc put $key" $ret 0 + error_check_good "$dbc close" [$dbc close] 0 + set close_cursor 0 + } + 3 - + 4 - + 5 { + if { $op == 3 } { + set flags "" + } else { + set flags -update + } + set dbc [eval {$db cursor} $flags] + error_check_good "$db cursor" \ + [is_valid_cursor $dbc $db] TRUE + set close_cursor 1 + set k [rand_key $method $nkeys $renum $procs] + if {[is_record_based $method] == 1} { + set key $k + } else { + set key [lindex $l_keys $k] + } + + if { [get_lock $key] == 1 } { + incr i -1 + error_check_good "$dbc close" \ + [$dbc close] 0 + set close_cursor 0 + continue; + } + + set ret [$dbc get -set $key] + error_check_good \ + "$dbc get $key" [llength [lindex $ret 0]] 2 + + # Now read a few keys sequentially + set nloop [berkdb random_int 0 10] + if { [berkdb random_int 0 1] == 0 } { + set flags -next + } else { + set flags -prev + } + while { $nloop > 0 } { + set lastret $ret + set ret [eval {$dbc get} $flags] + # Might read beginning/end of file + if { [llength $ret] == 0} { + set ret $lastret + break + } + incr nloop -1 + } + switch $op { + 3 { + incr seqread + } + 4 { + incr seqput + set rec [lindex [lindex $ret 0] 1] + set partial [string range $rec 0 \ + [expr $dlen - 1]] + error_check_good "$dbc get $key" \ + $partial [pad_data $method $datastr] + append rec ":$procid" + set ret [$dbc put -current \ + [chop_data $method $rec]] + error_check_good \ + "$dbc put $key" $ret 0 + } + 5 { + incr seqdel + set k [lindex [lindex $ret 0] 0] + # We need to lock the item we're + # deleting so that someone else can't + # try to do a get while we're + # deleting + error_check_good "$klock put" \ + [$klock put] 0 + set klock NOLOCK + set cur [$dbc get -current] + error_check_bad get_current \ + [llength $cur] 0 + set key [lindex [lindex $cur 0] 0] + if { [get_lock $key] == 1 } { + incr i -1 + error_check_good "$dbc close" \ + [$dbc close] 0 + set close_cursor 0 + continue + } + set ret [$dbc del] + error_check_good "$dbc del" $ret 0 + set rec $datastr + append rec ":$procid" + if { $renum == 1 } { + set ret [$dbc put -before \ + [chop_data $method $rec]] + error_check_good \ + "$dbc put $k" $ret $k + } elseif { \ + [is_record_based $method] == 1 } { + error_check_good "$dbc close" \ + [$dbc close] 0 + set close_cursor 0 + set ret [$db put $k \ + [chop_data $method $rec]] + error_check_good \ + "$db put $k" $ret 0 + } else { + set ret [$dbc put -keylast $k \ + [chop_data $method $rec]] + error_check_good \ + "$dbc put $k" $ret 0 + } + } + } + if { $close_cursor == 1 } { + error_check_good \ + "$dbc close" [$dbc close] 0 + set close_cursor 0 + } + } + } + } res] != 0} { + global errorInfo; + global exception_handled; + + puts $errorInfo + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + + flush stdout + if { [string compare $klock NOLOCK] != 0 } { + catch {$klock put} + } + if {$close_cursor == 1} { + catch {$dbc close} + set close_cursor 0 + } + + if {[string first FAIL $theError] == 0 && \ + $exception_handled != 1} { + error "FAIL:[timestamp] test042: key $k: $theError" + } + set exception_handled 0 + } else { + flush stdout + if { [string compare $klock NOLOCK] != 0 } { + error_check_good "$klock put" [$klock put] 0 + set klock NOLOCK + } + } +} + +if {[catch {$db close} ret] != 0 } { + error_check_good close [is_substr $errorInfo "DB_INCOMPLETE"] 1 + puts "Warning: sync incomplete on close ([pid])" +} else { + error_check_good close $ret 0 +} +$dbenv close + +exit + +puts "[timestamp] [pid] Complete" +puts "Successful ops: " +puts "\t$gets gets" +puts "\t$overwrite overwrites" +puts "\t$getput getputs" +puts "\t$seqread seqread" +puts "\t$seqput seqput" +puts "\t$seqdel seqdel" +flush stdout diff --git a/bdb/test/mpool.tcl b/bdb/test/mpool.tcl new file mode 100644 index 00000000000..b2eb2252037 --- /dev/null +++ b/bdb/test/mpool.tcl @@ -0,0 +1,420 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: mpool.tcl,v 11.34 2001/01/18 04:58:07 krinsky Exp $ +# +# Options are: +# -cachesize {gbytes bytes ncache} +# -nfiles <files> +# -iterations <iterations> +# -pagesize <page size in bytes> +# -dir <directory in which to store memp> +# -stat +proc memp_usage {} { + puts "memp -cachesize {gbytes bytes ncache}" + puts "\t-nfiles <files>" + puts "\t-iterations <iterations>" + puts "\t-pagesize <page size in bytes>" + puts "\t-dir <memp directory>" + puts "\t-mem {private system}" + return +} + +proc mpool { args } { + source ./include.tcl + global errorCode + + puts "mpool {$args} running" + # Set defaults + set cachearg " -cachesize {0 200000 3}" + set nfiles 5 + set iterations 500 + set pagesize "512 1024 2048 4096 8192" + set npages 100 + set procs 4 + set seeds "" + set shm_key 1 + set dostat 0 + set flags "" + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -c.* { + incr i + set cachesize [lindex $args $i] + set cachearg " -cachesize $cachesize" + } + -d.* { incr i; set testdir [lindex $args $i] } + -i.* { incr i; set iterations [lindex $args $i] } + -me.* { + incr i + if { [string \ + compare [lindex $args $i] private] == 0 } { + set flags -private + } elseif { [string \ + compare [lindex $args $i] system] == 0 } { + # + # We need to use a shm id. Use one + # that is the same each time so that + # we do not grow segments infinitely. + set flags "-system_mem -shm_key $shm_key" + } else { + puts -nonewline \ + "FAIL:[timestamp] Usage: " + memp_usage + return + } + } + -nf.* { incr i; set nfiles [lindex $args $i] } + -np.* { incr i; set npages [lindex $args $i] } + -pa.* { incr i; set pagesize [lindex $args $i] } + -pr.* { incr i; set procs [lindex $args $i] } + -se.* { incr i; set seeds [lindex $args $i] } + -st.* { set dostat 1 } + default { + puts -nonewline "FAIL:[timestamp] Usage: " + memp_usage + return + } + } + } + + # Clean out old directory + env_cleanup $testdir + + # Open the memp with region init specified + set ret [catch {eval {berkdb env -create -mode 0644}\ + $cachearg {-region_init -home $testdir} $flags} res] + if { $ret == 0 } { + set env $res + } else { + # If the env open failed, it may be because we're on a platform + # such as HP-UX 10 that won't support mutexes in shmget memory. + # Or QNX, which doesn't support system memory at all. + # Verify that the return value was EINVAL or EOPNOTSUPP + # and bail gracefully. + error_check_good is_shm_test [is_substr $flags -system_mem] 1 + error_check_good returned_error [expr \ + [is_substr $errorCode EINVAL] || \ + [is_substr $errorCode EOPNOTSUPP]] 1 + puts "Warning:\ + platform does not support mutexes in shmget memory." + puts "Skipping shared memory mpool test." + return + } + error_check_good env_open [is_substr $env env] 1 + + reset_env $env + env_cleanup $testdir + + # Now open without region init + set env [eval {berkdb env -create -mode 0644}\ + $cachearg {-home $testdir} $flags] + error_check_good evn_open [is_substr $env env] 1 + + memp001 $env \ + $testdir $nfiles $iterations [lindex $pagesize 0] $dostat $flags + reset_env $env + set ret [berkdb envremove -home $testdir] + error_check_good env_remove $ret 0 + env_cleanup $testdir + + memp002 $testdir \ + $procs $pagesize $iterations $npages $seeds $dostat $flags + set ret [berkdb envremove -home $testdir] + error_check_good env_remove $ret 0 + env_cleanup $testdir + + memp003 $testdir $iterations $flags + set ret [berkdb envremove -home $testdir] + error_check_good env_remove $ret 0 + + env_cleanup $testdir +} + +proc memp001 {env dir n iter psize dostat flags} { + source ./include.tcl + global rand_init + + puts "Memp001: {$flags} random update $iter iterations on $n files." + + # Open N memp files + for {set i 1} {$i <= $n} {incr i} { + set fname "data_file.$i" + file_create $dir/$fname 50 $psize + + set mpools($i) \ + [$env mpool -create -pagesize $psize -mode 0644 $fname] + error_check_good mp_open [is_substr $mpools($i) $env.mp] 1 + } + + # Now, loop, picking files at random + berkdb srand $rand_init + for {set i 0} {$i < $iter} {incr i} { + set mpool $mpools([berkdb random_int 1 $n]) + set p1 [get_range $mpool 10] + set p2 [get_range $mpool 10] + set p3 [get_range $mpool 10] + set p1 [replace $mpool $p1] + set p3 [replace $mpool $p3] + set p4 [get_range $mpool 20] + set p4 [replace $mpool $p4] + set p5 [get_range $mpool 10] + set p6 [get_range $mpool 20] + set p7 [get_range $mpool 10] + set p8 [get_range $mpool 20] + set p5 [replace $mpool $p5] + set p6 [replace $mpool $p6] + set p9 [get_range $mpool 40] + set p9 [replace $mpool $p9] + set p10 [get_range $mpool 40] + set p7 [replace $mpool $p7] + set p8 [replace $mpool $p8] + set p9 [replace $mpool $p9] + set p10 [replace $mpool $p10] + } + + if { $dostat == 1 } { + puts [$env mpool_stat] + for {set i 1} {$i <= $n} {incr i} { + error_check_good mp_sync [$mpools($i) fsync] 0 + } + } + + # Close N memp files + for {set i 1} {$i <= $n} {incr i} { + error_check_good memp_close:$mpools($i) [$mpools($i) close] 0 + fileremove -f $dir/data_file.$i + } +} + +proc file_create { fname nblocks blocksize } { + set fid [open $fname w] + for {set i 0} {$i < $nblocks} {incr i} { + seek $fid [expr $i * $blocksize] start + puts -nonewline $fid $i + } + seek $fid [expr $nblocks * $blocksize - 1] + + # We don't end the file with a newline, because some platforms (like + # Windows) emit CR/NL. There does not appear to be a BINARY open flag + # that prevents this. + puts -nonewline $fid "Z" + close $fid + + # Make sure it worked + if { [file size $fname] != $nblocks * $blocksize } { + error "FAIL: file_create could not create correct file size" + } +} + +proc get_range { mpool max } { + set pno [berkdb random_int 0 $max] + set p [$mpool get $pno] + error_check_good page [is_valid_page $p $mpool] TRUE + set got [$p pgnum] + if { $got != $pno } { + puts "Get_range: Page mismatch page |$pno| val |$got|" + } + set ret [$p init "Page is pinned by [pid]"] + error_check_good page_init $ret 0 + + return $p +} + +proc replace { mpool p } { + set pgno [$p pgnum] + + set ret [$p init "Page is unpinned by [pid]"] + error_check_good page_init $ret 0 + + set ret [$p put -dirty] + error_check_good page_put $ret 0 + + set p2 [$mpool get $pgno] + error_check_good page [is_valid_page $p2 $mpool] TRUE + + return $p2 +} + +proc memp002 { dir procs psizes iterations npages seeds dostat flags } { + source ./include.tcl + + puts "Memp002: {$flags} Multiprocess mpool tester" + + if { [is_substr $flags -private] != 0 } { + puts "Memp002 skipping\ + multiple processes not supported by private memory" + return + } + set iter [expr $iterations / $procs] + + # Clean up old stuff and create new. + env_cleanup $dir + + for { set i 0 } { $i < [llength $psizes] } { incr i } { + fileremove -f $dir/file$i + } + set e [eval {berkdb env -create -lock -home $dir} $flags] + error_check_good dbenv [is_valid_widget $e env] TRUE + + set pidlist {} + for { set i 0 } { $i < $procs } {incr i} { + if { [llength $seeds] == $procs } { + set seed [lindex $seeds $i] + } else { + set seed -1 + } + + puts "$tclsh_path\ + $test_path/mpoolscript.tcl $dir $i $procs \ + $iter $psizes $npages 3 $flags > \ + $dir/memp002.$i.out &" + set p [exec $tclsh_path $test_path/wrap.tcl \ + mpoolscript.tcl $dir/memp002.$i.out $dir $i $procs \ + $iter $psizes $npages 3 $flags &] + lappend pidlist $p + } + puts "Memp002: $procs independent processes now running" + watch_procs + + reset_env $e +} + +# Test reader-only/writer process combinations; we use the access methods +# for testing. +proc memp003 { dir {nentries 10000} flags } { + global alphabet + source ./include.tcl + + puts "Memp003: {$flags} Reader/Writer tests" + + if { [is_substr $flags -private] != 0 } { + puts "Memp003 skipping\ + multiple processes not supported by private memory" + return + } + + env_cleanup $dir + set psize 1024 + set testfile mpool.db + set t1 $dir/t1 + + # Create an environment that the two processes can share + set c [list 0 [expr $psize * 10] 3] + set dbenv [eval {berkdb env \ + -create -lock -home $dir -cachesize $c} $flags] + error_check_good dbenv [is_valid_env $dbenv] TRUE + + # First open and create the file. + + set db [berkdb_open -env $dbenv -create -truncate \ + -mode 0644 -pagesize $psize -btree $testfile] + error_check_good dbopen/RW [is_valid_db $db] TRUE + + set did [open $dict] + set txn "" + set count 0 + + puts "\tMemp003.a: create database" + set keys "" + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + lappend keys $str + + set ret [eval {$db put} $txn {$str $str}] + error_check_good put $ret 0 + + set ret [eval {$db get} $txn {$str}] + error_check_good get $ret [list [list $str $str]] + + incr count + } + close $did + error_check_good close [$db close] 0 + + # Now open the file for read-only + set db [berkdb_open -env $dbenv -rdonly $testfile] + error_check_good dbopen/RO [is_substr $db db] 1 + + puts "\tMemp003.b: verify a few keys" + # Read and verify a couple of keys; saving them to check later + set testset "" + for { set i 0 } { $i < 10 } { incr i } { + set ndx [berkdb random_int 0 [expr $nentries - 1]] + set key [lindex $keys $ndx] + if { [lsearch $testset $key] != -1 } { + incr i -1 + continue; + } + + # The remote process stuff is unhappy with + # zero-length keys; make sure we don't pick one. + if { [llength $key] == 0 } { + incr i -1 + continue + } + + lappend testset $key + + set ret [eval {$db get} $txn {$key}] + error_check_good get/RO $ret [list [list $key $key]] + } + + puts "\tMemp003.c: retrieve and modify keys in remote process" + # Now open remote process where we will open the file RW + set f1 [open |$tclsh_path r+] + puts $f1 "source $test_path/test.tcl" + puts $f1 "flush stdout" + flush $f1 + + set c [concat "{" [list 0 [expr $psize * 10] 3] "}" ] + set remote_env [send_cmd $f1 \ + "berkdb env -create -lock -home $dir -cachesize $c $flags"] + error_check_good remote_dbenv [is_valid_env $remote_env] TRUE + + set remote_db [send_cmd $f1 "berkdb_open -env $remote_env $testfile"] + error_check_good remote_dbopen [is_valid_db $remote_db] TRUE + + foreach k $testset { + # Get the key + set ret [send_cmd $f1 "$remote_db get $k"] + error_check_good remote_get $ret [list [list $k $k]] + + # Now replace the key + set ret [send_cmd $f1 "$remote_db put $k $k$k"] + error_check_good remote_put $ret 0 + } + + puts "\tMemp003.d: verify changes in local process" + foreach k $testset { + set ret [eval {$db get} $txn {$key}] + error_check_good get_verify/RO $ret [list [list $key $key$key]] + } + + puts "\tMemp003.e: Fill up the cache with dirty buffers" + foreach k $testset { + # Now rewrite the keys with BIG data + set data [replicate $alphabet 32] + set ret [send_cmd $f1 "$remote_db put $k $data"] + error_check_good remote_put $ret 0 + } + + puts "\tMemp003.f: Get more pages for the read-only file" + dump_file $db $txn $t1 nop + + puts "\tMemp003.g: Sync from the read-only file" + error_check_good db_sync [$db sync] 0 + error_check_good db_close [$db close] 0 + + set ret [send_cmd $f1 "$remote_db close"] + error_check_good remote_get $ret 0 + + # Close the environment both remotely and locally. + set ret [send_cmd $f1 "$remote_env close"] + error_check_good remote:env_close $ret 0 + close $f1 + + reset_env $dbenv +} diff --git a/bdb/test/mpoolscript.tcl b/bdb/test/mpoolscript.tcl new file mode 100644 index 00000000000..8695254c257 --- /dev/null +++ b/bdb/test/mpoolscript.tcl @@ -0,0 +1,170 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: mpoolscript.tcl,v 11.12 2000/05/05 15:23:47 sue Exp $ +# +# Random multiple process mpool tester. +# Usage: mpoolscript dir id numiters numfiles numpages sleepint +# dir: lock directory. +# id: Unique identifier for this process. +# maxprocs: Number of procs in this test. +# numiters: Total number of iterations. +# pgsizes: Pagesizes for the different files. Length of this item indicates +# how many files to use. +# numpages: Number of pages per file. +# sleepint: Maximum sleep interval. +# flags: Flags for env open + +source ./include.tcl +source $test_path/test.tcl +source $test_path/testutils.tcl + +set usage \ + "mpoolscript dir id maxprocs numiters pgsizes numpages sleepint flags" + +# Verify usage +if { $argc != 8 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + puts $argc + exit +} + +# Initialize arguments +set dir [lindex $argv 0] +set id [lindex $argv 1] +set maxprocs [lindex $argv 2] +set numiters [ lindex $argv 3 ] +set pgsizes [ lindex $argv 4 ] +set numpages [ lindex $argv 5 ] +set sleepint [ lindex $argv 6 ] +set flags [ lindex $argv 7] + +# Initialize seed +global rand_init +berkdb srand $rand_init + +# Give time for all processes to start up. +tclsleep 10 + +puts -nonewline "Beginning execution for $id: $maxprocs $dir $numiters" +puts " $pgsizes $numpages $sleepint" +flush stdout + +# Figure out how small/large to make the cache +set max 0 +foreach i $pgsizes { + if { $i > $max } { + set max $i + } +} + +set cache [list 0 [expr $maxprocs * ([lindex $pgsizes 0] + $max)] 1] +set env_cmd {berkdb env -lock -cachesize $cache -home $dir} +set e [eval $env_cmd $flags] +error_check_good env_open [is_valid_env $e] TRUE + +# Now open files +set mpools {} +set nfiles 0 +foreach psize $pgsizes { + set mp [$e mpool -create -mode 0644 -pagesize $psize file$nfiles] + error_check_good memp_fopen:$nfiles [is_valid_mpool $mp $e] TRUE + lappend mpools $mp + incr nfiles +} + +puts "Establishing long-term pin on file 0 page $id for process $id" + +# Set up the long-pin page +set lock [$e lock_get write $id 0:$id] +error_check_good lock_get [is_valid_lock $lock $e] TRUE + +set mp [lindex $mpools 0] +set master_page [$mp get -create $id] +error_check_good mp_get:$master_page [is_valid_page $master_page $mp] TRUE + +set r [$master_page init MASTER$id] +error_check_good page_init $r 0 + +# Release the lock but keep the page pinned +set r [$lock put] +error_check_good lock_put $r 0 + +# Main loop. On each iteration, we'll check every page in each of +# of the files. On any file, if we see the appropriate tag in the +# field, we'll rewrite the page, else we won't. Keep track of +# how many pages we actually process. +set pages 0 +for { set iter 0 } { $iter < $numiters } { incr iter } { + puts "[timestamp]: iteration $iter, $pages pages set so far" + flush stdout + for { set fnum 1 } { $fnum < $nfiles } { incr fnum } { + if { [expr $fnum % 2 ] == 0 } { + set pred [expr ($id + $maxprocs - 1) % $maxprocs] + } else { + set pred [expr ($id + $maxprocs + 1) % $maxprocs] + } + + set mpf [lindex $mpools $fnum] + for { set p 0 } { $p < $numpages } { incr p } { + set lock [$e lock_get write $id $fnum:$p] + error_check_good lock_get:$fnum:$p \ + [is_valid_lock $lock $e] TRUE + + # Now, get the page + set pp [$mpf get -create $p] + error_check_good page_get:$fnum:$p \ + [is_valid_page $pp $mpf] TRUE + + if { [$pp is_setto $pred] == 0 || [$pp is_setto 0] == 0 } { + # Set page to self. + set r [$pp init $id] + error_check_good page_init:$fnum:$p $r 0 + incr pages + set r [$pp put -dirty] + error_check_good page_put:$fnum:$p $r 0 + } else { + error_check_good page_put:$fnum:$p [$pp put] 0 + } + error_check_good lock_put:$fnum:$p [$lock put] 0 + } + } + tclsleep [berkdb random_int 1 $sleepint] +} + +# Now verify your master page, release its pin, then verify everyone else's +puts "$id: End of run verification of master page" +set r [$master_page is_setto MASTER$id] +error_check_good page_check $r 1 +set r [$master_page put -dirty] +error_check_good page_put $r 0 + +set i [expr ($id + 1) % $maxprocs] +set mpf [lindex $mpools 0] + +while { $i != $id } { + set p [$mpf get -create $i] + error_check_good mp_get [is_valid_page $p $mpf] TRUE + + if { [$p is_setto MASTER$i] != 1 } { + puts "Warning: Master page $i not set." + } + error_check_good page_put:$p [$p put] 0 + + set i [expr ($i + 1) % $maxprocs] +} + +# Close files +foreach i $mpools { + set r [$i close] + error_check_good mpf_close $r 0 +} + +# Close environment system +set r [$e close] +error_check_good env_close $r 0 + +puts "[timestamp] $id Complete" +flush stdout diff --git a/bdb/test/mutex.tcl b/bdb/test/mutex.tcl new file mode 100644 index 00000000000..5300fb0c4a3 --- /dev/null +++ b/bdb/test/mutex.tcl @@ -0,0 +1,225 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: mutex.tcl,v 11.18 2000/09/01 19:24:59 krinsky Exp $ +# +# Exercise mutex functionality. +# Options are: +# -dir <directory in which to store mpool> +# -iter <iterations> +# -mdegree <number of mutexes per iteration> +# -nmutex <number of mutexes> +# -procs <number of processes to run> +# -wait <wait interval after getting locks> +proc mutex_usage {} { + puts stderr "mutex\n\t-dir <dir>\n\t-iter <iterations>" + puts stderr "\t-mdegree <locks per iteration>\n\t-nmutex <n>" + puts stderr "\t-procs <nprocs>" + puts stderr "\n\t-wait <max wait interval>" + return +} + +proc mutex { args } { + source ./include.tcl + + set dir db + set iter 500 + set mdegree 3 + set nmutex 20 + set procs 5 + set wait 2 + + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -d.* { incr i; set testdir [lindex $args $i] } + -i.* { incr i; set iter [lindex $args $i] } + -m.* { incr i; set mdegree [lindex $args $i] } + -n.* { incr i; set nmutex [lindex $args $i] } + -p.* { incr i; set procs [lindex $args $i] } + -w.* { incr i; set wait [lindex $args $i] } + default { + puts -nonewline "FAIL:[timestamp] Usage: " + mutex_usage + return + } + } + } + + if { [file exists $testdir/$dir] != 1 } { + file mkdir $testdir/$dir + } elseif { [file isdirectory $testdir/$dir ] != 1 } { + error "$testdir/$dir is not a directory" + } + + # Basic sanity tests + mutex001 $testdir $nmutex + + # Basic synchronization tests + mutex002 $testdir $nmutex + + # Multiprocess tests + mutex003 $testdir $iter $nmutex $procs $mdegree $wait +} + +proc mutex001 { dir nlocks } { + source ./include.tcl + + puts "Mutex001: Basic functionality" + env_cleanup $dir + + # Test open w/out create; should fail + error_check_bad \ + env_open [catch {berkdb env -lock -home $dir} env] 0 + + # Now open for real + set env [berkdb env -create -mode 0644 -lock -home $dir] + error_check_good env_open [is_valid_env $env] TRUE + + set m [$env mutex 0644 $nlocks] + error_check_good mutex_init [is_valid_mutex $m $env] TRUE + + # Get, set each mutex; sleep, then get Release + for { set i 0 } { $i < $nlocks } { incr i } { + set r [$m get $i ] + error_check_good mutex_get $r 0 + + set r [$m setval $i $i] + error_check_good mutex_setval $r 0 + } + tclsleep 5 + for { set i 0 } { $i < $nlocks } { incr i } { + set r [$m getval $i] + error_check_good mutex_getval $r $i + + set r [$m release $i ] + error_check_good mutex_get $r 0 + } + + error_check_good mutex_close [$m close] 0 + error_check_good env_close [$env close] 0 + puts "Mutex001: completed successfully." +} + +# Test basic synchronization +proc mutex002 { dir nlocks } { + source ./include.tcl + + puts "Mutex002: Basic synchronization" + env_cleanup $dir + + # Fork off child before we open any files. + set f1 [open |$tclsh_path r+] + puts $f1 "source $test_path/test.tcl" + flush $f1 + + # Open the environment and the mutex locally + set local_env [berkdb env -create -mode 0644 -lock -home $dir] + error_check_good env_open [is_valid_env $local_env] TRUE + + set local_mutex [$local_env mutex 0644 $nlocks] + error_check_good \ + mutex_init [is_valid_mutex $local_mutex $local_env] TRUE + + # Open the environment and the mutex remotely + set remote_env [send_cmd $f1 "berkdb env -lock -home $dir"] + error_check_good remote:env_open [is_valid_env $remote_env] TRUE + + set remote_mutex [send_cmd $f1 "$remote_env mutex 0644 $nlocks"] + error_check_good \ + mutex_init [is_valid_mutex $remote_mutex $remote_env] TRUE + + # Do a get here, then set the value to be pid. + # On the remote side fire off a get and getval. + set r [$local_mutex get 1] + error_check_good lock_get $r 0 + + set r [$local_mutex setval 1 [pid]] + error_check_good lock_get $r 0 + + # Now have the remote side request the lock and check its + # value. Then wait 5 seconds, release the mutex and see + # what the remote side returned. + send_timed_cmd $f1 1 "$remote_mutex get 1" + send_timed_cmd $f1 1 "set ret \[$remote_mutex getval 1\]" + + # Now sleep before resetting and releasing lock + tclsleep 5 + set newv [expr [pid] - 1] + set r [$local_mutex setval 1 $newv] + error_check_good mutex_setval $r 0 + + set r [$local_mutex release 1] + error_check_good mutex_release $r 0 + + # Now get the result from the other script + # Timestamp + set result [rcv_result $f1] + error_check_good lock_get:remote_time [expr $result > 4] 1 + + # Timestamp + set result [rcv_result $f1] + + # Mutex value + set result [send_cmd $f1 "puts \$ret"] + error_check_good lock_get:remote_getval $result $newv + + # Close down the remote + set ret [send_cmd $f1 "$remote_mutex close" 5] + # Not sure why we need this, but we do... an extra blank line + # someone gets output somewhere + gets $f1 ret + error_check_good remote:mutex_close $ret 0 + + set ret [send_cmd $f1 "$remote_env close"] + error_check_good remote:env_close $ret 0 + + catch { close $f1 } result + + set ret [$local_mutex close] + error_check_good local:mutex_close $ret 0 + + set ret [$local_env close] + error_check_good local:env_close $ret 0 + + puts "Mutex002: completed successfully." +} + +# Generate a bunch of parallel +# testers that try to randomly obtain locks. +proc mutex003 { dir iter nmutex procs mdegree wait } { + source ./include.tcl + + puts "Mutex003: Multi-process random mutex test ($procs processes)" + + env_cleanup $dir + + # Now open the region we'll use for multiprocess testing. + set env [berkdb env -create -mode 0644 -lock -home $dir] + error_check_good env_open [is_valid_env $env] TRUE + + set mutex [$env mutex 0644 $nmutex] + error_check_good mutex_init [is_valid_mutex $mutex $env] TRUE + + error_check_good mutex_close [$mutex close] 0 + + # Now spawn off processes + set proclist {} + for { set i 0 } {$i < $procs} {incr i} { + puts "$tclsh_path\ + $test_path/mutexscript.tcl $dir\ + $iter $nmutex $wait $mdegree > $testdir/$i.mutexout &" + set p [exec $tclsh_path $test_path/wrap.tcl \ + mutexscript.tcl $testdir/$i.mutexout $dir\ + $iter $nmutex $wait $mdegree &] + lappend proclist $p + } + puts "Mutex003: $procs independent processes now running" + watch_procs + error_check_good env_close [$env close] 0 + # Remove output files + for { set i 0 } {$i < $procs} {incr i} { + fileremove -f $dir/$i.mutexout + } +} diff --git a/bdb/test/mutexscript.tcl b/bdb/test/mutexscript.tcl new file mode 100644 index 00000000000..9a49e471186 --- /dev/null +++ b/bdb/test/mutexscript.tcl @@ -0,0 +1,91 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: mutexscript.tcl,v 11.12 2000/11/21 22:14:56 dda Exp $ +# +# Random mutex tester. +# Usage: mutexscript dir numiters mlocks sleepint degree +# dir: dir in which all the mutexes live. +# numiters: Total number of iterations. +# nmutex: Total number of mutexes. +# sleepint: Maximum sleep interval. +# degree: Maximum number of locks to acquire at once + +source ./include.tcl +source $test_path/test.tcl +source $test_path/testutils.tcl + +set usage "mutexscript dir numiters nmutex sleepint degree" + +# Verify usage +if { $argc != 5 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + exit +} + +# Initialize arguments +set dir [lindex $argv 0] +set numiters [ lindex $argv 1 ] +set nmutex [ lindex $argv 2 ] +set sleepint [ lindex $argv 3 ] +set degree [ lindex $argv 4 ] +set locker [pid] +set mypid [sanitized_pid] + +# Initialize seed +global rand_init +berkdb srand $rand_init + +puts -nonewline "Mutexscript: Beginning execution for $locker:" +puts " $numiters $nmutex $sleepint $degree" +flush stdout + +# Open the environment and the mutex +set e [berkdb env -create -mode 0644 -lock -home $dir] +error_check_good evn_open [is_valid_env $e] TRUE + +set mutex [$e mutex 0644 $nmutex] +error_check_good mutex_init [is_valid_mutex $mutex $e] TRUE + +# Sleep for awhile to make sure that everyone has gotten in +tclsleep 5 + +for { set iter 0 } { $iter < $numiters } { incr iter } { + set nlocks [berkdb random_int 1 $degree] + # We will always lock objects in ascending order to avoid + # deadlocks. + set lastobj 1 + set mlist {} + for { set lnum 0 } { $lnum < $nlocks } { incr lnum } { + # Pick lock parameters + set obj [berkdb random_int $lastobj [expr $nmutex - 1]] + set lastobj [expr $obj + 1] + puts "[timestamp] $locker $lnum: $obj" + + # Do get, set its val to own pid, and then add to list + error_check_good mutex_get:$obj [$mutex get $obj] 0 + error_check_good mutex_setval:$obj [$mutex setval $obj $mypid] 0 + lappend mlist $obj + if {$lastobj >= $nmutex} { + break + } + } + + # Pick sleep interval + tclsleep [ berkdb random_int 1 $sleepint ] + + # Now release locks + foreach i $mlist { + error_check_good mutex_getval:$i [$mutex getval $i] $mypid + error_check_good mutex_setval:$i \ + [$mutex setval $i [expr 0 - $mypid]] 0 + error_check_good mutex_release:$i [$mutex release $i] 0 + } + puts "[timestamp] $locker released mutexes" + flush stdout +} + +puts "[timestamp] $locker Complete" +flush stdout diff --git a/bdb/test/ndbm.tcl b/bdb/test/ndbm.tcl new file mode 100644 index 00000000000..a6286de0266 --- /dev/null +++ b/bdb/test/ndbm.tcl @@ -0,0 +1,141 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: ndbm.tcl,v 11.13 2000/08/25 14:21:51 sue Exp $ +# +# Historic NDBM interface test. +# Use the first 1000 entries from the dictionary. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Then reopen the file, re-retrieve everything. +# Finally, delete everything. +proc ndbm { { nentries 1000 } } { + source ./include.tcl + + puts "NDBM interfaces test: $nentries" + + # Create the database and open the dictionary + set testfile $testdir/ndbmtest + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir NULL + + set db [berkdb ndbm_open -create -truncate -mode 0644 $testfile] + error_check_good ndbm_open [is_substr $db ndbm] 1 + set did [open $dict] + + error_check_good rdonly_false [$db rdonly] 0 + + set flags 0 + set txn 0 + set count 0 + set skippednullkey 0 + + puts "\tNDBM.a: put/get loop" + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + # NDBM can't handle zero-length keys + if { [string length $str] == 0 } { + set skippednullkey 1 + continue + } + + set ret [$db store $str $str insert] + error_check_good ndbm_store $ret 0 + + set d [$db fetch $str] + error_check_good ndbm_fetch $d $str + incr count + } + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tNDBM.b: dump file" + set oid [open $t1 w] + for { set key [$db firstkey] } { $key != -1 } { + set key [$db nextkey] } { + puts $oid $key + set d [$db fetch $key] + error_check_good ndbm_refetch $d $key + } + + # If we had to skip a zero-length key, juggle things to cover up + # this fact in the dump. + if { $skippednullkey == 1 } { + puts $oid "" + incr nentries 1 + } + close $oid + + # Now compare the keys to see if they match the dictionary (or ints) + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + + error_check_good NDBM:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tNDBM.c: pagf/dirf test" + set fd [$db pagfno] + error_check_bad pagf $fd -1 + set fd [$db dirfno] + error_check_bad dirf $fd -1 + + puts "\tNDBM.d: close, open, and dump file" + + # Now, reopen the file and run the last test again. + error_check_good ndbm_close [$db close] 0 + set db [berkdb ndbm_open -rdonly $testfile] + error_check_good ndbm_open2 [is_substr $db ndbm] 1 + set oid [open $t1 w] + + error_check_good rdonly_true [$db rdonly] "rdonly:not owner" + + for { set key [$db firstkey] } { $key != -1 } { + set key [$db nextkey] } { + puts $oid $key + set d [$db fetch $key] + error_check_good ndbm_refetch2 $d $key + } + if { $skippednullkey == 1 } { + puts $oid "" + } + close $oid + + # Now compare the keys to see if they match the dictionary (or ints) + filesort $t1 $t3 + + error_check_good NDBM:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and delete each entry + puts "\tNDBM.e: sequential scan and delete" + + error_check_good ndbm_close [$db close] 0 + set db [berkdb ndbm_open $testfile] + error_check_good ndbm_open3 [is_substr $db ndbm] 1 + set oid [open $t1 w] + + for { set key [$db firstkey] } { $key != -1 } { + set key [$db nextkey] } { + puts $oid $key + set ret [$db delete $key] + error_check_good ndbm_delete $ret 0 + } + if { $skippednullkey == 1 } { + puts $oid "" + } + close $oid + + # Now compare the keys to see if they match the dictionary (or ints) + filesort $t1 $t3 + + error_check_good NDBM:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + error_check_good ndbm_close [$db close] 0 +} diff --git a/bdb/test/recd001.tcl b/bdb/test/recd001.tcl new file mode 100644 index 00000000000..bbf5159011b --- /dev/null +++ b/bdb/test/recd001.tcl @@ -0,0 +1,180 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd001.tcl,v 11.28 2000/12/07 19:13:46 sue Exp $ +# +# Recovery Test 1. +# These are the most basic recovery tests. We do individual recovery +# tests for each operation in the access method interface. First we +# create a file and capture the state of the database (i.e., we copy +# it. Then we run a transaction containing a single operation. In +# one test, we abort the transaction and compare the outcome to the +# original copy of the file. In the second test, we restore the +# original copy of the database and then run recovery and compare +# this against the actual database. +proc recd001 { method {select 0} args} { + global fixed_len + source ./include.tcl + + set orig_fixed_len $fixed_len + set opts [convert_args $method $args] + set omethod [convert_method $method] + + puts "Recd001: $method operation/transaction tests" + + # Create the database and environment. + env_cleanup $testdir + + # The recovery tests were originally written to + # do a command, abort, do it again, commit, and then + # repeat the sequence with another command. Each command + # tends to require that the previous command succeeded and + # left the database a certain way. To avoid cluttering up the + # op_recover interface as well as the test code, we create two + # databases; one does abort and then commit for each op, the + # other does prepare, prepare-abort, and prepare-commit for each + # op. If all goes well, this allows each command to depend + # exactly one successful iteration of the previous command. + set testfile recd001.db + set testfile2 recd001-2.db + + set flags "-create -txn -home $testdir" + + puts "\tRecd001.a.0: creating environment" + set env_cmd "berkdb env $flags" + set dbenv [eval $env_cmd] + error_check_good dbenv [is_valid_env $dbenv] TRUE + + # + # We need to create a database to get the pagesize (either + # the default or whatever might have been specified). + # Then remove it so we can compute fixed_len and create the + # real database. + set oflags "-create $omethod -mode 0644 \ + -env $dbenv $opts $testfile" + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + set stat [$db stat] + # + # Compute the fixed_len based on the pagesize being used. + # We want the fixed_len to be 1/4 the pagesize. + # + set pg [get_pagesize $stat] + error_check_bad get_pagesize $pg -1 + set fixed_len [expr $pg / 4] + error_check_good db_close [$db close] 0 + error_check_good dbremove [berkdb dbremove -env $dbenv $testfile] 0 + + # Convert the args again because fixed_len is now real. + # Create the databases and close the environment. + # cannot specify db truncate in txn protected env!!! + set opts [convert_args $method ""] + set omethod [convert_method $method] + set oflags "-create $omethod -mode 0644 \ + -env $dbenv $opts $testfile" + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + error_check_good db_close [$db close] 0 + + set oflags "-create $omethod -mode 0644 \ + -env $dbenv $opts $testfile2" + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + error_check_good db_close [$db close] 0 + + error_check_good env_close [$dbenv close] 0 + + puts "\tRecd001.a.1: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile + + # List of recovery tests: {CMD MSG} pairs. + set rlist { + { {DB put -txn TXNID $key $data} "Recd001.b: put"} + { {DB del -txn TXNID $key} "Recd001.c: delete"} + { {DB put -txn TXNID $bigkey $data} "Recd001.d: big key put"} + { {DB del -txn TXNID $bigkey} "Recd001.e: big key delete"} + { {DB put -txn TXNID $key $bigdata} "Recd001.f: big data put"} + { {DB del -txn TXNID $key} "Recd001.g: big data delete"} + { {DB put -txn TXNID $key $data} "Recd001.h: put (change state)"} + { {DB put -txn TXNID $key $newdata} "Recd001.i: overwrite"} + { {DB put -txn TXNID -partial {$off $len} $key $partial_grow} + "Recd001.j: partial put growing"} + { {DB put -txn TXNID $key $newdata} "Recd001.k: overwrite (fix)"} + { {DB put -txn TXNID -partial {$off $len} $key $partial_shrink} + "Recd001.l: partial put shrinking"} + { {DB put -txn TXNID -append $data} "Recd001.m: put -append"} + { {DB get -txn TXNID -consume} "Recd001.n: db get -consume"} + } + + # These are all the data values that we're going to need to read + # through the operation table and run the recovery tests. + + if { [is_record_based $method] == 1 } { + set key 1 + } else { + set key recd001_key + } + set data recd001_data + set newdata NEWrecd001_dataNEW + set off 3 + set len 12 + set partial_grow replacement_record_grow + set partial_shrink xxx + if { [is_fixed_length $method] == 1 } { + set len [string length $partial_grow] + set partial_shrink $partial_grow + } + set bigdata [replicate $key $fixed_len] + if { [is_record_based $method] == 1 } { + set bigkey $fixed_len + } else { + set bigkey [replicate $key $fixed_len] + } + + foreach pair $rlist { + set cmd [subst [lindex $pair 0]] + set msg [lindex $pair 1] + if { $select != 0 } { + set tag [lindex $msg 0] + set tail [expr [string length $tag] - 2] + set tag [string range $tag $tail $tail] + if { [lsearch $select $tag] == -1 } { + continue + } + } + + if { [is_queue $method] != 1 } { + if { [string first append $cmd] != -1 } { + continue + } + if { [string first consume $cmd] != -1 } { + continue + } + } + +# if { [is_fixed_length $method] == 1 } { +# if { [string first partial $cmd] != -1 } { +# continue +# } +# } + op_recover abort $testdir $env_cmd $testfile $cmd $msg + op_recover commit $testdir $env_cmd $testfile $cmd $msg + op_recover prepare $testdir $env_cmd $testfile2 $cmd $msg + op_recover prepare-abort $testdir $env_cmd $testfile2 $cmd $msg + op_recover prepare-commit $testdir $env_cmd $testfile2 $cmd $msg + } + set fixed_len $orig_fixed_len + + puts "\tRecd001.o: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} diff --git a/bdb/test/recd002.tcl b/bdb/test/recd002.tcl new file mode 100644 index 00000000000..ffcec6527e8 --- /dev/null +++ b/bdb/test/recd002.tcl @@ -0,0 +1,96 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd002.tcl,v 11.22 2000/12/11 17:24:54 sue Exp $ +# +# Recovery Test #2. Verify that splits can be recovered. +proc recd002 { method {select 0} args} { + source ./include.tcl + global rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Recd002: skipping for specific pagesizes" + return + } + berkdb srand $rand_init + + # Queues don't do splits, so we don't really need the small page + # size and the small page size is smaller than the record, so it's + # a problem. + if { [string compare $omethod "-queue"] == 0 } { + set pagesize 4096 + } else { + set pagesize 512 + } + puts "Recd002: $method split recovery tests" + + env_cleanup $testdir + set testfile recd002.db + set testfile2 recd002-2.db + set eflags \ + "-create -txn -lock_max 2000 -home $testdir" + + puts "\tRecd002.a: creating environment" + set env_cmd "berkdb env $eflags" + set dbenv [eval $env_cmd] + error_check_bad dbenv $dbenv NULL + + # Create the databases. We will use a small page size so that splits + # happen fairly quickly. + set oflags "-create $args $omethod -mode 0644 -env $dbenv\ + -pagesize $pagesize $testfile" + set db [eval {berkdb_open} $oflags] + error_check_bad db_open $db NULL + error_check_good db_open [is_substr $db db] 1 + error_check_good db_close [$db close] 0 + set oflags "-create $args $omethod -mode 0644 -env $dbenv\ + -pagesize $pagesize $testfile2" + set db [eval {berkdb_open} $oflags] + error_check_bad db_open $db NULL + error_check_good db_open [is_substr $db db] 1 + error_check_good db_close [$db close] 0 + reset_env $dbenv + + # List of recovery tests: {CMD MSG} pairs + set slist { + { {populate DB $omethod TXNID $n 0 0} "Recd002.b: splits"} + { {unpopulate DB TXNID $r} "Recd002.c: Remove keys"} + } + + # If pages are 512 bytes, then adding 512 key/data pairs + # should be more than sufficient. + set n 512 + set r [expr $n / 2 ] + foreach pair $slist { + set cmd [subst [lindex $pair 0]] + set msg [lindex $pair 1] + if { $select != 0 } { + set tag [lindex $msg 0] + set tail [expr [string length $tag] - 2] + set tag [string range $tag $tail $tail] + if { [lsearch $select $tag] == -1 } { + continue + } + } + op_recover abort $testdir $env_cmd $testfile $cmd $msg + op_recover commit $testdir $env_cmd $testfile $cmd $msg + op_recover prepare $testdir $env_cmd $testfile2 $cmd $msg + op_recover prepare-abort $testdir $env_cmd $testfile2 \ + $cmd $msg + op_recover prepare-commit $testdir $env_cmd $testfile2 \ + $cmd $msg + } + + puts "\tRecd002.d: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} diff --git a/bdb/test/recd003.tcl b/bdb/test/recd003.tcl new file mode 100644 index 00000000000..af7097c8909 --- /dev/null +++ b/bdb/test/recd003.tcl @@ -0,0 +1,111 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd003.tcl,v 11.22 2000/12/07 19:13:46 sue Exp $ +# +# Recovery Test 3. +# Test all the duplicate log messages and recovery operations. We make +# sure that we exercise all possible recovery actions: redo, undo, undo +# but no fix necessary and redo but no fix necessary. +proc recd003 { method {select 0} args } { + source ./include.tcl + global rand_init + + set largs [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts "Recd003 skipping for method $method" + return + } + puts "Recd003: $method duplicate recovery tests" + + berkdb srand $rand_init + + env_cleanup $testdir + # See comment in recd001.tcl for why there are two database files... + set testfile recd003.db + set testfile2 recd003-2.db + set eflags "-create -txn -home $testdir" + + puts "\tRecd003.a: creating environment" + set env_cmd "berkdb env $eflags" + set dbenv [eval $env_cmd] + error_check_bad dbenv $dbenv NULL + + # Create the databases. + set oflags \ + "-create $largs -mode 0644 $omethod -dup -env $dbenv $testfile" + set db [eval {berkdb_open} $oflags] + error_check_bad db_open $db NULL + error_check_good db_open [is_substr $db db] 1 + error_check_good db_close [$db close] 0 + set oflags \ + "-create $largs -mode 0644 $omethod -dup -env $dbenv $testfile2" + set db [eval {berkdb_open} $oflags] + error_check_bad db_open $db NULL + error_check_good db_open [is_substr $db db] 1 + error_check_good db_close [$db close] 0 + reset_env $dbenv + + # These are all the data values that we're going to need to read + # through the operation table and run the recovery tests. + set n 10 + set dupn 2000 + set bign 500 + + # List of recovery tests: {CMD MSG} pairs + set dlist { + { {populate DB $omethod TXNID $n 1 0} + "Recd003.b: add dups"} + { {DB del -txn TXNID duplicate_key} + "Recd003.c: remove dups all at once"} + { {populate DB $omethod TXNID $n 1 0} + "Recd003.d: add dups (change state)"} + { {unpopulate DB TXNID 0} + "Recd003.e: remove dups 1 at a time"} + { {populate DB $omethod TXNID $dupn 1 0} + "Recd003.f: dup split"} + { {DB del -txn TXNID duplicate_key} + "Recd003.g: remove dups (change state)"} + { {populate DB $omethod TXNID $n 1 1} + "Recd003.h: add big dup"} + { {DB del -txn TXNID duplicate_key} + "Recd003.i: remove big dup all at once"} + { {populate DB $omethod TXNID $n 1 1} + "Recd003.j: add big dup (change state)"} + { {unpopulate DB TXNID 0} + "Recd003.k: remove big dup 1 at a time"} + { {populate DB $omethod TXNID $bign 1 1} + "Recd003.l: split big dup"} + } + + foreach pair $dlist { + set cmd [subst [lindex $pair 0]] + set msg [lindex $pair 1] + if { $select != 0 } { + set tag [lindex $msg 0] + set tail [expr [string length $tag] - 2] + set tag [string range $tag $tail $tail] + if { [lsearch $select $tag] == -1 } { + continue + } + } + op_recover abort $testdir $env_cmd $testfile $cmd $msg + op_recover commit $testdir $env_cmd $testfile $cmd $msg + op_recover prepare $testdir $env_cmd $testfile2 $cmd $msg + op_recover prepare-abort $testdir $env_cmd $testfile2 \ + $cmd $msg + op_recover prepare-commit $testdir $env_cmd $testfile2 \ + $cmd $msg + } + + puts "\tRecd003.m: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} diff --git a/bdb/test/recd004.tcl b/bdb/test/recd004.tcl new file mode 100644 index 00000000000..012dd80f6e5 --- /dev/null +++ b/bdb/test/recd004.tcl @@ -0,0 +1,90 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd004.tcl,v 11.21 2000/12/11 17:24:55 sue Exp $ +# +# Recovery Test #4. +# Verify that we work correctly when big keys get elevated. +proc recd004 { method {select 0} args} { + source ./include.tcl + global rand_init + + set opts [convert_args $method $args] + set omethod [convert_method $method] + + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Recd004: skipping for specific pagesizes" + return + } + if { [is_record_based $method] == 1 } { + puts "Recd004 skipping for method $method" + return + } + puts "Recd004: $method big-key on internal page recovery tests" + + berkdb srand $rand_init + + env_cleanup $testdir + set testfile recd004.db + set testfile2 recd004-2.db + set eflags "-create -txn -home $testdir" + puts "\tRecd004.a: creating environment" + set env_cmd "berkdb env $eflags" + set dbenv [eval $env_cmd] + error_check_bad dbenv $dbenv NULL + + # Create the databases. We will use a small page size so that we + # elevate quickly + set oflags "-create -mode 0644 \ + $omethod -env $dbenv $opts -pagesize 512 $testfile" + set db [eval {berkdb_open} $oflags] + error_check_bad db_open $db NULL + error_check_good db_open [is_substr $db db] 1 + error_check_good db_close [$db close] 0 + set oflags "-create -mode 0644 \ + $omethod -env $dbenv $opts -pagesize 512 $testfile2" + set db [eval {berkdb_open} $oflags] + error_check_bad db_open $db NULL + error_check_good db_open [is_substr $db db] 1 + error_check_good db_close [$db close] 0 + reset_env $dbenv + + # List of recovery tests: {CMD MSG} pairs + set slist { + { {big_populate DB TXNID $n} "Recd004.b: big key elevation"} + { {unpopulate DB TXNID 0} "Recd004.c: Remove keys"} + } + + # If pages are 512 bytes, then adding 512 key/data pairs + # should be more than sufficient. + set n 512 + foreach pair $slist { + set cmd [subst [lindex $pair 0]] + set msg [lindex $pair 1] + if { $select != 0 } { + set tag [lindex $msg 0] + set tail [expr [string length $tag] - 2] + set tag [string range $tag $tail $tail] + if { [lsearch $select $tag] == -1 } { + continue + } + } + op_recover abort $testdir $env_cmd $testfile $cmd $msg + op_recover commit $testdir $env_cmd $testfile $cmd $msg + op_recover prepare $testdir $env_cmd $testfile2 $cmd $msg + op_recover prepare-abort $testdir $env_cmd $testfile2 \ + $cmd $msg + op_recover prepare-commit $testdir $env_cmd $testfile2 \ + $cmd $msg + } + + puts "\tRecd004.d: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} diff --git a/bdb/test/recd005.tcl b/bdb/test/recd005.tcl new file mode 100644 index 00000000000..06a346f4484 --- /dev/null +++ b/bdb/test/recd005.tcl @@ -0,0 +1,231 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd005.tcl,v 11.27 2000/12/15 21:41:38 ubell Exp $ +# +# Recovery Test 5. +# Make sure that we can do catastrophic recovery even if we open +# files using the same log file id. +proc recd005 { method args} { + source ./include.tcl + global rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Recd005: $method catastropic recovery" + + berkdb srand $rand_init + + set testfile1 recd005.1.db + set testfile2 recd005.2.db + set eflags \ + "-create -txn -lock_max 2000 -lock_max_objects 2000 -home $testdir" + + set tnum 0 + foreach sizes "{1000 10} {10 1000}" { + foreach ops "{abort abort} {abort commit} {commit abort} \ + {commit commit}" { + env_cleanup $testdir + incr tnum + + set s1 [lindex $sizes 0] + set s2 [lindex $sizes 1] + set op1 [lindex $ops 0] + set op2 [lindex $ops 1] + puts "\tRecd005.$tnum: $s1 $s2 $op1 $op2" + + puts "\tRecd005.$tnum.a: creating environment" + set env_cmd "berkdb env $eflags" + set dbenv [eval $env_cmd] + error_check_bad dbenv $dbenv NULL + + # Create the two databases. + set oflags \ + "-create -mode 0644 -env $dbenv $args $omethod" + set db1 [eval {berkdb_open} $oflags $testfile1] + error_check_bad db_open $db1 NULL + error_check_good db_open [is_substr $db1 db] 1 + error_check_good db_close [$db1 close] 0 + + set db2 [eval {berkdb_open} $oflags $testfile2] + error_check_bad db_open $db2 NULL + error_check_good db_open [is_substr $db2 db] 1 + error_check_good db_close [$db2 close] 0 + $dbenv close + + set dbenv [eval $env_cmd] + puts "\tRecd005.$tnum.b: Populating databases" + do_one_file \ + $testdir $method $dbenv $env_cmd $testfile1 $s1 $op1 + do_one_file \ + $testdir $method $dbenv $env_cmd $testfile2 $s2 $op2 + + puts "\tRecd005.$tnum.c: Verifying initial population" + check_file $testdir $env_cmd $testfile1 $op1 + check_file $testdir $env_cmd $testfile2 $op2 + + # Now, close the environment (so that recovery will work + # on NT which won't allow delete of an open file). + reset_env $dbenv + + berkdb debug_check + puts -nonewline \ + "\tRecd005.$tnum.d: About to run recovery ... " + flush stdout + + set stat [catch \ + {exec $util_path/db_recover -h $testdir -c} \ + result] + if { $stat == 1 } { + error "Recovery error: $result." + } + puts "complete" + + # Substitute a file that will need recovery and try + # running recovery again. + if { $op1 == "abort" } { + file copy -force $testdir/$testfile1.afterop \ + $testdir/$testfile1 + move_file_extent $testdir $testfile1 \ + afterop copy + } else { + file copy -force $testdir/$testfile1.init \ + $testdir/$testfile1 + move_file_extent $testdir $testfile1 init copy + } + if { $op2 == "abort" } { + file copy -force $testdir/$testfile2.afterop \ + $testdir/$testfile2 + move_file_extent $testdir $testfile2 \ + afterop copy + } else { + file copy -force $testdir/$testfile2.init \ + $testdir/$testfile2 + move_file_extent $testdir $testfile2 init copy + } + + berkdb debug_check + puts -nonewline "\tRecd005.$tnum.e:\ + About to run recovery on pre-op database ... " + flush stdout + + set stat \ + [catch {exec $util_path/db_recover \ + -h $testdir -c} result] + if { $stat == 1 } { + error "Recovery error: $result." + } + puts "complete" + + set dbenv [eval $env_cmd] + check_file $testdir $env_cmd $testfile1 $op1 + check_file $testdir $env_cmd $testfile2 $op2 + reset_env $dbenv + + puts "\tRecd005.$tnum.f:\ + Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch \ + {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile + } + } +} + +proc do_one_file { dir method env env_cmd filename num op } { + source ./include.tcl + + set init_file $dir/$filename.t1 + set afterop_file $dir/$filename.t2 + set final_file $dir/$filename.t3 + + # Save the initial file and open the environment and the first file + file copy -force $dir/$filename $dir/$filename.init + copy_extent_file $dir $filename init + set oflags "-unknown -env $env" + set db [eval {berkdb_open} $oflags $filename] + + # Dump out file contents for initial case + set tflags "" + open_and_dump_file $filename $env $tflags $init_file nop \ + dump_file_direction "-first" "-next" + + set txn [$env txn] + error_check_bad txn_begin $txn NULL + error_check_good txn_begin [is_substr $txn $env] 1 + + # Now fill in the db and the txnid in the command + populate $db $method $txn $num 0 0 + + # Sync the file so that we can capture a snapshot to test + # recovery. + error_check_good sync:$db [$db sync] 0 + file copy -force $dir/$filename $dir/$filename.afterop + copy_extent_file $dir $filename afterop + open_and_dump_file $testdir/$filename.afterop NULL $tflags \ + $afterop_file nop dump_file_direction "-first" "-next" + error_check_good txn_$op:$txn [$txn $op] 0 + + if { $op == "commit" } { + puts "\t\tFile $filename executed and committed." + } else { + puts "\t\tFile $filename executed and aborted." + } + + # Dump out file and save a copy. + error_check_good sync:$db [$db sync] 0 + open_and_dump_file $testdir/$filename NULL $tflags $final_file nop \ + dump_file_direction "-first" "-next" + file copy -force $dir/$filename $dir/$filename.final + copy_extent_file $dir $filename final + + # If this is an abort, it should match the original file. + # If this was a commit, then this file should match the + # afterop file. + if { $op == "abort" } { + filesort $init_file $init_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(initial,post-$op):diff($init_file,$final_file) \ + [filecmp $init_file.sort $final_file.sort] 0 + } else { + filesort $afterop_file $afterop_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(post-$op,pre-commit):diff($afterop_file,$final_file) \ + [filecmp $afterop_file.sort $final_file.sort] 0 + } + + error_check_good close:$db [$db close] 0 +} + +proc check_file { dir env_cmd filename op } { + source ./include.tcl + + set init_file $dir/$filename.t1 + set afterop_file $dir/$filename.t2 + set final_file $dir/$filename.t3 + + set tflags "" + open_and_dump_file $testdir/$filename NULL $tflags $final_file nop \ + dump_file_direction "-first" "-next" + if { $op == "abort" } { + filesort $init_file $init_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(initial,post-$op):diff($init_file,$final_file) \ + [filecmp $init_file.sort $final_file.sort] 0 + } else { + filesort $afterop_file $afterop_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(pre-commit,post-$op):diff($afterop_file,$final_file) \ + [filecmp $afterop_file.sort $final_file.sort] 0 + } + +} diff --git a/bdb/test/recd006.tcl b/bdb/test/recd006.tcl new file mode 100644 index 00000000000..14f01cc0b8f --- /dev/null +++ b/bdb/test/recd006.tcl @@ -0,0 +1,262 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd006.tcl,v 11.21 2000/12/07 19:13:46 sue Exp $ +# +# Recovery Test 6. +# Test nested transactions. +proc recd006 { method {select 0} args} { + global kvals + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts "Recd006 skipping for method $method" + return + } + puts "Recd006: $method nested transactions" + + # Create the database and environment. + env_cleanup $testdir + + set dbfile recd006.db + set testfile $testdir/$dbfile + + puts "\tRecd006.a: create database" + set oflags "-create $args $omethod $testfile" + set db [eval {berkdb_open} $oflags] + error_check_good dbopen [is_valid_db $db] TRUE + + # Make sure that we have enough entries to span a couple of + # different pages. + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < 1000 } { + if { [string compare $omethod "-recno"] == 0 } { + set key [expr $count + 1] + } else { + set key $str + } + + set ret [$db put -nooverwrite $key $str] + error_check_good put $ret 0 + + incr count + } + close $did + + # Variables used below: + # p1: a pair of keys that are likely to be on the same page. + # p2: a pair of keys that are likely to be on the same page, + # but on a page different than those in p1. + set dbc [$db cursor] + error_check_good dbc [is_substr $dbc $db] 1 + + set ret [$dbc get -first] + error_check_bad dbc_get:DB_FIRST [llength $ret] 0 + set p1 [lindex [lindex $ret 0] 0] + set kvals($p1) [lindex [lindex $ret 0] 1] + + set ret [$dbc get -next] + error_check_bad dbc_get:DB_NEXT [llength $ret] 0 + lappend p1 [lindex [lindex $ret 0] 0] + set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1] + + set ret [$dbc get -last] + error_check_bad dbc_get:DB_LAST [llength $ret] 0 + set p2 [lindex [lindex $ret 0] 0] + set kvals($p2) [lindex [lindex $ret 0] 1] + + set ret [$dbc get -prev] + error_check_bad dbc_get:DB_PREV [llength $ret] 0 + lappend p2 [lindex [lindex $ret 0] 0] + set kvals([lindex [lindex $ret 0] 0]) [lindex [lindex $ret 0] 1] + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + # Now create the full transaction environment. + set eflags "-create -txn -home $testdir" + + puts "\tRecd006.b: creating environment" + set env_cmd "berkdb env $eflags" + set dbenv [eval $env_cmd] + error_check_bad dbenv $dbenv NULL + + # Reset the environment. + reset_env $dbenv + + set p1 [list $p1] + set p2 [list $p2] + + # List of recovery tests: {CMD MSG} pairs + set rlist { + { {nesttest DB TXNID ENV 1 $p1 $p2 commit commit} + "Recd006.c: children (commit commit)"} + { {nesttest DB TXNID ENV 0 $p1 $p2 commit commit} + "Recd006.d: children (commit commit)"} + { {nesttest DB TXNID ENV 1 $p1 $p2 commit abort} + "Recd006.e: children (commit abort)"} + { {nesttest DB TXNID ENV 0 $p1 $p2 commit abort} + "Recd006.f: children (commit abort)"} + { {nesttest DB TXNID ENV 1 $p1 $p2 abort abort} + "Recd006.g: children (abort abort)"} + { {nesttest DB TXNID ENV 0 $p1 $p2 abort abort} + "Recd006.h: children (abort abort)"} + { {nesttest DB TXNID ENV 1 $p1 $p2 abort commit} + "Recd006.i: children (abort commit)"} + { {nesttest DB TXNID ENV 0 $p1 $p2 abort commit} + "Recd006.j: children (abort commit)"} + } + + foreach pair $rlist { + set cmd [subst [lindex $pair 0]] + set msg [lindex $pair 1] + if { $select != 0 } { + set tag [lindex $msg 0] + set tail [expr [string length $tag] - 2] + set tag [string range $tag $tail $tail] + if { [lsearch $select $tag] == -1 } { + continue + } + } + op_recover abort $testdir $env_cmd $dbfile $cmd $msg + op_recover commit $testdir $env_cmd $dbfile $cmd $msg + } + + puts "\tRecd006.k: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} + +# Do the nested transaction test. +# We want to make sure that children inherit properly from their +# parents and that locks are properly handed back to parents +# and that the right thing happens on commit/abort. +# In particular: +# Write lock on parent, properly acquired by child. +# Committed operation on child gives lock to parent so that +# other child can also get the lock. +# Aborted op by child releases lock so other child can get it. +# Correct database state if child commits +# Correct database state if child aborts +proc nesttest { db parent env do p1 p2 child1 child2} { + global kvals + source ./include.tcl + + if { $do == 1 } { + set func toupper + } else { + set func tolower + } + + # Do an RMW on the parent to get a write lock. + set p10 [lindex $p1 0] + set p11 [lindex $p1 1] + set p20 [lindex $p2 0] + set p21 [lindex $p2 1] + + set ret [$db get -rmw -txn $parent $p10] + set res $ret + set Dret [lindex [lindex $ret 0] 1] + if { [string compare $Dret $kvals($p10)] == 0 || + [string compare $Dret [string toupper $kvals($p10)]] == 0 } { + set val 0 + } else { + set val $Dret + } + error_check_good get_parent_RMW $val 0 + + # OK, do child 1 + set kid1 [$env txn -parent $parent] + error_check_good kid1 [is_valid_widget $kid1 $env.txn] TRUE + + # Reading write-locked parent object should be OK + #puts "\tRead write-locked parent object for kid1." + set ret [$db get -txn $kid1 $p10] + error_check_good kid1_get10 $ret $res + + # Now update this child + set data [lindex [lindex [string $func $ret] 0] 1] + set ret [$db put -txn $kid1 $p10 $data] + error_check_good kid1_put10 $ret 0 + + #puts "\tKid1 successful put." + + # Now start child2 + #puts "\tBegin txn for kid2." + set kid2 [$env txn -parent $parent] + error_check_good kid2 [is_valid_widget $kid2 $env.txn] TRUE + + # Getting anything in the p1 set should deadlock, so let's + # work on the p2 set. + set data [string $func $kvals($p20)] + #puts "\tPut data for kid2." + set ret [$db put -txn $kid2 $p20 $data] + error_check_good kid2_put20 $ret 0 + + #puts "\tKid2 data put successful." + + # Now let's do the right thing to kid1 + puts -nonewline "\tKid1 $child1..." + if { [string compare $child1 "commit"] == 0 } { + error_check_good kid1_commit [$kid1 commit] 0 + } else { + error_check_good kid1_abort [$kid1 abort] 0 + } + puts "complete" + + # In either case, child2 should now be able to get the + # lock, either because it is inherited by the parent + # (commit) or because it was released (abort). + set data [string $func $kvals($p11)] + set ret [$db put -txn $kid2 $p11 $data] + error_check_good kid2_put11 $ret 0 + + # Now let's do the right thing to kid2 + puts -nonewline "\tKid2 $child2..." + if { [string compare $child2 "commit"] == 0 } { + error_check_good kid2_commit [$kid2 commit] 0 + } else { + error_check_good kid2_abort [$kid2 abort] 0 + } + puts "complete" + + # Now, let parent check that the right things happened. + # First get all four values + set p10_check [lindex [lindex [$db get -txn $parent $p10] 0] 0] + set p11_check [lindex [lindex [$db get -txn $parent $p11] 0] 0] + set p20_check [lindex [lindex [$db get -txn $parent $p20] 0] 0] + set p21_check [lindex [lindex [$db get -txn $parent $p21] 0] 0] + + if { [string compare $child1 "commit"] == 0 } { + error_check_good parent_kid1 $p10_check \ + [string tolower [string $func $kvals($p10)]] + } else { + error_check_good \ + parent_kid1 $p10_check [string tolower $kvals($p10)] + } + if { [string compare $child2 "commit"] == 0 } { + error_check_good parent_kid2 $p11_check \ + [string tolower [string $func $kvals($p11)]] + error_check_good parent_kid2 $p20_check \ + [string tolower [string $func $kvals($p20)]] + } else { + error_check_good parent_kid2 $p11_check $kvals($p11) + error_check_good parent_kid2 $p20_check $kvals($p20) + } + + # Now do a write on the parent for 21 whose lock it should + # either have or should be available. + set ret [$db put -txn $parent $p21 [string $func $kvals($p21)]] + error_check_good parent_put21 $ret 0 + + return 0 +} diff --git a/bdb/test/recd007.tcl b/bdb/test/recd007.tcl new file mode 100644 index 00000000000..d077ae19f2c --- /dev/null +++ b/bdb/test/recd007.tcl @@ -0,0 +1,723 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd007.tcl,v 11.38 2000/12/20 21:39:23 krinsky Exp $ +# +# Recovery Test 7. +# This is a recovery test for create/delete of databases. We have +# hooks in the database so that we can abort the process at various +# points and make sure that the transaction doesn't commit. We +# then need to recover and make sure the file is correctly existing +# or not, as the case may be. +proc recd007 { method args} { + global fixed_len + source ./include.tcl + + set orig_fixed_len $fixed_len + set opts [convert_args $method $args] + set omethod [convert_method $method] + + puts "Recd007: $method operation/transaction tests" + + # Create the database and environment. + env_cleanup $testdir + + set testfile recd007.db + set flags "-create -txn -home $testdir" + + puts "\tRecd007.a: creating environment" + set env_cmd "berkdb env $flags" + + set env [eval $env_cmd] + # + # We need to create a database to get the pagesize (either + # the default or whatever might have been specified). + # Then remove it so we can compute fixed_len and create the + # real database. + set oflags "-create $omethod -mode 0644 -env $env $opts $testfile" + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + set stat [$db stat] + # + # Compute the fixed_len based on the pagesize being used. + # We want the fixed_len to be 1/4 the pagesize. + # + set pg [get_pagesize $stat] + error_check_bad get_pagesize $pg -1 + set fixed_len [expr $pg / 4] + error_check_good db_close [$db close] 0 + error_check_good dbremove [berkdb dbremove -env $env $testfile] 0 + error_check_good envclose [$env close] 0 + + # Convert the args again because fixed_len is now real. + set opts [convert_args $method ""] + + # + # List of recovery tests: {HOOKS MSG} pairs + # Where each HOOK is a list of {COPY ABORT} + # + set rlist { + { {"none" "preopen"} "Recd007.b0: none/preopen"} + { {"none" "postopen"} "Recd007.b1: none/postopen"} + { {"none" "postlogmeta"} "Recd007.b2: none/postlogmeta"} + { {"none" "postlog"} "Recd007.b3: none/postlog"} + { {"none" "postsync"} "Recd007.b4: none/postsync"} + { {"postopen" "none"} "Recd007.c0: postopen/none"} + { {"postlogmeta" "none"} "Recd007.c1: postlogmeta/none"} + { {"postlog" "none"} "Recd007.c2: postlog/none"} + { {"postsync" "none"} "Recd007.c3: postsync/none"} + { {"postopen" "postopen"} "Recd007.d: postopen/postopen"} + { {"postopen" "postlogmeta"} "Recd007.e: postopen/postlogmeta"} + { {"postopen" "postlog"} "Recd007.f: postopen/postlog"} + { {"postlog" "postlog"} "Recd007.g: postlog/postlog"} + { {"postlogmeta" "postlogmeta"} "Recd007.h: postlogmeta/postlogmeta"} + { {"postlogmeta" "postlog"} "Recd007.i: postlogmeta/postlog"} + { {"postlog" "postsync"} "Recd007.j: postlog/postsync"} + { {"postsync" "postsync"} "Recd007.k: postsync/postsync"} + } + + # These are all the data values that we're going to need to read + # through the operation table and run the recovery tests. + + foreach pair $rlist { + set cmd [lindex $pair 0] + set msg [lindex $pair 1] + file_recover_create $testdir $env_cmd $omethod \ + $opts $testfile $cmd $msg + } + + set rlist { + { {"none" "prerename"} "Recd007.l0: none/prerename"} + { {"none" "postrename"} "Recd007.l1: none/postrename"} + { {"prerename" "none"} "Recd007.m0: prerename/none"} + { {"postrename" "none"} "Recd007.m1: postrename/none"} + { {"prerename" "prerename"} "Recd007.n: prerename/prerename"} + { {"prerename" "postrename"} "Recd007.o: prerename/postrename"} + { {"postrename" "postrename"} "Recd007.p: postrename/postrename"} + } + foreach op { dbremove dbrename } { + foreach pair $rlist { + set cmd [lindex $pair 0] + set msg [lindex $pair 1] + file_recover_delete $testdir $env_cmd $omethod \ + $opts $testfile $cmd $msg $op + } + } + + if { $is_windows_test != 1 } { + do_file_recover_delmk $testdir $env_cmd $omethod $opts $testfile + } + + puts "\tRecd007.r: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} + +proc file_recover_create { dir env_cmd method opts dbfile cmd msg } { + # + # We run this test on each of these scenarios: + # 1. Creating just a database + # 2. Creating a database with a subdb + # 3. Creating a 2nd subdb in a database + puts "\t$msg create with a database" + do_file_recover_create $dir $env_cmd $method $opts $dbfile \ + 0 $cmd $msg + if { [is_queue $method] == 1 } { + puts "\tSkipping subdatabase tests for method $method" + return + } + puts "\t$msg create with a database and subdb" + do_file_recover_create $dir $env_cmd $method $opts $dbfile \ + 1 $cmd $msg + puts "\t$msg create with a database and 2nd subdb" + do_file_recover_create $dir $env_cmd $method $opts $dbfile \ + 2 $cmd $msg + +} + +proc do_file_recover_create { dir env_cmd method opts dbfile sub cmd msg } { + global log_log_record_types + source ./include.tcl + + # Keep track of the log types we've seen + if { $log_log_record_types == 1} { + logtrack_read $dir + } + + env_cleanup $dir + # Open the environment and set the copy/abort locations + set env [eval $env_cmd] + set copy [lindex $cmd 0] + set abort [lindex $cmd 1] + error_check_good copy_location [is_valid_create_loc $copy] 1 + error_check_good abort_location [is_valid_create_loc $abort] 1 + + if {([string first "logmeta" $copy] != -1 || \ + [string first "logmeta" $abort] != -1) && \ + [is_btree $method] == 0 } { + puts "\tSkipping for method $method" + $env test copy none + $env test abort none + error_check_good env_close [$env close] 0 + return + } + + # + # Basically non-existence is our initial state. When we + # abort, it is also our final state. + # + switch $sub { + 0 { + set oflags "-create $method -mode 0644 \ + -env $env $opts $dbfile" + } + 1 { + set oflags "-create $method -mode 0644 \ + -env $env $opts $dbfile sub0" + } + 2 { + # + # If we are aborting here, then we need to + # create a first subdb, then create a second + # + set oflags "-create $method -mode 0644 \ + -env $env $opts $dbfile sub0" + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + error_check_good db_close [$db close] 0 + set init_file $dir/$dbfile.init + catch { file copy -force $dir/$dbfile $init_file } res + set oflags "-create $method -mode 0644 \ + -env $env $opts $dbfile sub1" + } + default { + puts "\tBad value $sub for sub" + return + } + } + # + # Set our locations to copy and abort + # + set ret [eval $env test copy $copy] + error_check_good test_copy $ret 0 + set ret [eval $env test abort $abort] + error_check_good test_abort $ret 0 + + puts "\t\tExecuting command" + set ret [catch {eval {berkdb_open} $oflags} db] + + # Sync the mpool so any changes to the file that are + # in mpool get written to the disk file before the + # diff. + puts "\t\tSyncing" + $env mpool_sync "0 0" + + # + # If we don't abort, then we expect success. + # If we abort, we expect no file created. + # + if {[string first "none" $abort] == -1} { + # + # Operation was aborted, verify it does + # not exist. + # + puts "\t\tCommand executed and aborted." + error_check_bad db_open ret 0 + + # + # Check that the file does not exist. Final state. + # + if { $sub != 2 } { + error_check_good db_open:exists \ + [file exists $dir/$dbfile] 0 + } else { + error_check_good \ + diff(init,postcreate):diff($init_file,$dir/$dbfile)\ + [dbdump_diff $init_file $dir/$dbfile] 0 + } + } else { + # + # Operation was committed, verify it exists. + # + puts "\t\tCommand executed and committed." + error_check_good db_open [is_valid_db $db] TRUE + error_check_good db_close [$db close] 0 + + # + # Check that the file exists. + # + error_check_good db_open [file exists $dir/$dbfile] 1 + set init_file $dir/$dbfile.init + catch { file copy -force $dir/$dbfile $init_file } res + + if { [is_queue $method] == 1 } { + copy_extent_file $dir $dbfile init + } + } + error_check_good env_close [$env close] 0 + + # + # Run recovery here. Should be a no-op. Verify that + # the file still doesn't exist or change (depending on sub) + # when we are done. + # + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + if { $sub != 2 && [string first "none" $abort] == -1} { + # + # Operation was aborted, verify it still does + # not exist. Only done with file creations. + # + error_check_good after_recover1 [file exists $dir/$dbfile] 0 + } else { + # + # Operation was committed or just a subdb was aborted. + # Verify it did not change. + # + error_check_good \ + diff(initial,post-recover1):diff($init_file,$dir/$dbfile) \ + [dbdump_diff $init_file $dir/$dbfile] 0 + # + # Need a new copy to get the right LSN into the file. + # + catch { file copy -force $dir/$dbfile $init_file } res + + if { [is_queue $method] == 1 } { + copy_extent_file $dir $dbfile init + } + } + + # + # If we didn't make a copy, then we are done. + # + if {[string first "none" $copy] != -1} { + return + } + + # + # Now move the .afterop file to $dbfile. Run recovery again. + # + file copy -force $dir/$dbfile.afterop $dir/$dbfile + + if { [is_queue $method] == 1 } { + move_file_extent $dir $dbfile afterop copy + } + + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + if { $sub != 2 && [string first "none" $abort] == -1} { + # + # Operation was aborted, verify it still does + # not exist. Only done with file creations. + # + error_check_good after_recover2 [file exists $dir/$dbfile] 0 + } else { + # + # Operation was committed or just a subdb was aborted. + # Verify it did not change. + # + error_check_good \ + diff(initial,post-recover2):diff($init_file,$dir/$dbfile) \ + [dbdump_diff $init_file $dir/$dbfile] 0 + } + +} + +proc file_recover_delete { dir env_cmd method opts dbfile cmd msg op } { + # + # We run this test on each of these scenarios: + # 1. Deleting/Renaming just a database + # 2. Deleting/Renaming a database with a subdb + # 3. Deleting/Renaming a 2nd subdb in a database + puts "\t$msg $op with a database" + do_file_recover_delete $dir $env_cmd $method $opts $dbfile \ + 0 $cmd $msg $op + if { [is_queue $method] == 1 } { + puts "\tSkipping subdatabase tests for method $method" + return + } + puts "\t$msg $op with a database and subdb" + do_file_recover_delete $dir $env_cmd $method $opts $dbfile \ + 1 $cmd $msg $op + puts "\t$msg $op with a database and 2nd subdb" + do_file_recover_delete $dir $env_cmd $method $opts $dbfile \ + 2 $cmd $msg $op + +} + +proc do_file_recover_delete { dir env_cmd method opts dbfile sub cmd msg op } { + global log_log_record_types + source ./include.tcl + + # Keep track of the log types we've seen + if { $log_log_record_types == 1} { + logtrack_read $dir + } + + env_cleanup $dir + # Open the environment and set the copy/abort locations + set env [eval $env_cmd] + set copy [lindex $cmd 0] + set abort [lindex $cmd 1] + error_check_good copy_location [is_valid_delete_loc $copy] 1 + error_check_good abort_location [is_valid_delete_loc $abort] 1 + + if { [is_record_based $method] == 1 } { + set key 1 + } else { + set key recd007_key + } + set data1 recd007_data + set data2 NEWrecd007_data2 + + # + # Depending on what sort of subdb we want, if any, our + # args to the open call will be different (and if we + # want a 2nd subdb, we create the first here. + # + switch $sub { + 0 { + set oflags "-create $method -mode 0644 \ + -env $env $opts $dbfile" + } + 1 { + set oflags "-create $method -mode 0644 \ + -env $env $opts $dbfile sub0" + } + 2 { + # + # If we are aborting here, then we need to + # create a first subdb, then create a second + # + set oflags "-create $method -mode 0644 \ + -env $env $opts $dbfile sub0" + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + set txn [$env txn] + set ret [$db put -txn $txn $key $data2] + error_check_good db_put $ret 0 + error_check_good commit [$txn commit] 0 + error_check_good db_close [$db close] 0 + set oflags "-create $method -mode 0644 \ + -env $env $opts $dbfile sub1" + } + default { + puts "\tBad value $sub for sub" + return + } + } + + # + # Set our locations to copy and abort + # + set ret [eval $env test copy $copy] + error_check_good test_copy $ret 0 + set ret [eval $env test abort $abort] + error_check_good test_abort $ret 0 + + # + # Open our db, add some data, close and copy as our + # init file. + # + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + set txn [$env txn] + set ret [$db put -txn $txn $key $data1] + error_check_good db_put $ret 0 + error_check_good commit [$txn commit] 0 + error_check_good db_close [$db close] 0 + + set init_file $dir/$dbfile.init + catch { file copy -force $dir/$dbfile $init_file } res + + if { [is_queue $method] == 1} { + copy_extent_file $dir $dbfile init + } + + # + # If we don't abort, then we expect success. + # If we abort, we expect no file removed. + # + if { [string compare $op dbremove] == 0 } { + set ret [catch { berkdb $op -env $env $dbfile } remret] + } else { + set ret [catch { berkdb $op -env $env $dbfile $dbfile.new } \ + remret] + } + if {[string first "none" $abort] == -1} { + # + # Operation was aborted, verify it did not change. + # + puts "\t\tCommand executed and aborted." + error_check_good $op $ret 1 + + # + # Check that the file exists. Final state. + # Compare against initial file. + # + error_check_good post$op.1 [file exists $dir/$dbfile] 1 + error_check_good \ + diff(init,post$op.2):diff($init_file,$dir/$dbfile)\ + [dbdump_diff $init_file $dir/$dbfile] 0 + } else { + # + # Operation was committed, verify it does + # not exist. + # + puts "\t\tCommand executed and committed." + error_check_good $op $ret 0 + # + # Check that the file does not exist or correct + # file exists. + # + error_check_good $op [file exists $dir/$dbfile] 0 + if { [string compare $op dbrename] == 0 } { + error_check_good $op [file exists $dir/$dbfile.new] 1 + } + } + error_check_good env_close [$env close] 0 + catch { file copy -force $dir/$dbfile $init_file } res + + if { [is_queue $method] == 1} { + copy_extent_file $dir $dbfile init + } + + # + # Run recovery here. Should be a no-op. Verify that + # the file still doesn't exist or change (depending on abort) + # when we are done. + # + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + if { [string first "none" $abort] != -1} { + # + # Operation was committed, verify it still does + # not exist. + # + error_check_good after_recover1 [file exists $dir/$dbfile] 0 + } else { + # + # Operation was aborted, verify it did not change. + # + error_check_good \ + diff(initial,post-recover1):diff($init_file,$dir/$dbfile) \ + [dbdump_diff $init_file $dir/$dbfile] 0 + } + + # + # If we didn't make a copy, then we are done. + # + if {[string first "none" $copy] != -1} { + return + } + + # + # Now move the .afterop file to $dbfile. Run recovery again. + # + set filecopy [glob $dir/*.afterop] + set afterop [lindex $filecopy 0] + file rename -force $afterop $dir/$dbfile + set afterop [string range $afterop \ + [expr [string last "/" $afterop] + 1] \ + [string last "." $afterop]] + move_file_extent $dir $dbfile afterop rename + + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + + if { [string first "none" $abort] != -1} { + # + # Operation was committed, verify it still does + # not exist. + # + error_check_good after_recover2 [file exists $dir/$dbfile] 0 + } else { + # + # Operation was aborted, verify it did not change. + # + error_check_good \ + diff(initial,post-recover2):diff($init_file,$dir/$dbfile) \ + [dbdump_diff $init_file $dir/$dbfile] 0 + } + +} + +# +# This function tests a specific case of recovering after a db removal. +# This is for SR #2538. Basically we want to test that: +# - Make an env. +# - Make/close a db. +# - Remove the db. +# - Create another db of same name. +# - Sync db but leave open. +# - Run recovery. +# - Verify no recovery errors and that new db is there. +proc do_file_recover_delmk { dir env_cmd method opts dbfile } { + global log_log_record_types + source ./include.tcl + + # Keep track of the log types we've seen + if { $log_log_record_types == 1} { + logtrack_read $dir + } + + puts "\tRecd007.q: Delete and recreate a database" + env_cleanup $dir + # Open the environment and set the copy/abort locations + set env [eval $env_cmd] + + if { [is_record_based $method] == 1 } { + set key 1 + } else { + set key recd007_key + } + set data1 recd007_data + set data2 NEWrecd007_data2 + + set oflags "-create $method -mode 0644 -env $env $opts $dbfile" + + # + # Open our db, add some data, close and copy as our + # init file. + # + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + set txn [$env txn] + set ret [$db put -txn $txn $key $data1] + error_check_good db_put $ret 0 + error_check_good commit [$txn commit] 0 + error_check_good db_close [$db close] 0 + + set ret [catch { berkdb dbremove -env $env $dbfile } remret] + # + # Operation was committed, verify it does + # not exist. + # + puts "\t\tCommand executed and committed." + error_check_good dbremove $ret 0 + error_check_good dbremove.1 [file exists $dir/$dbfile] 0 + + # + # Now create a new db with the same name. + # + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + set txn [$env txn] + set ret [$db put -txn $txn $key $data1] + error_check_good db_put $ret 0 + error_check_good commit [$txn commit] 0 + error_check_good db_sync [$db sync] 0 + + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + error_check_good db_recover $stat 0 + error_check_good db_recover.1 [file exists $dir/$dbfile] 1 + # + # Since we ran recovery on the open db/env, we need to + # catch these calls. Basically they are there to clean + # up the Tcl widgets. + # + set stat [catch {$db close} ret] + set stat [catch {$env close} ret] + +} +proc is_valid_create_loc { loc } { + switch $loc { + none - + preopen - + postopen - + postlogmeta - + postlog - + postsync + { return 1 } + default + { return 0 } + } +} + +proc is_valid_delete_loc { loc } { + switch $loc { + none - + prerename - + postrename - + postremcall + { return 1 } + default + { return 0 } + } +} + +# Do a logical diff on the db dump files. We expect that either +# the files are identical, or if they differ, that it is exactly +# just a free/invalid page. +# Return 1 if they are different, 0 if logically the same (or identical). +# +proc dbdump_diff { initfile dbfile } { + source ./include.tcl + + set initdump $initfile.dump + set dbdump $dbfile.dump + + set stat [catch {exec $util_path/db_dump -dar -f $initdump \ + $initfile} ret] + error_check_good dbdump.init $stat 0 + + # Do a dump without the freelist which should eliminate any + # recovery differences. + set stat [catch {exec $util_path/db_dump -dar -f $dbdump $dbfile} \ + ret] + error_check_good dbdump.db $stat 0 + + set stat [filecmp $dbdump $initdump] + + if {$stat == 0} { + return 0 + } + puts "diff: $dbdump $initdump gives:\n$ret" + return 1 +} diff --git a/bdb/test/recd008.tcl b/bdb/test/recd008.tcl new file mode 100644 index 00000000000..b75605b0475 --- /dev/null +++ b/bdb/test/recd008.tcl @@ -0,0 +1,227 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd008.tcl,v 1.22 2000/12/07 19:13:46 sue Exp $ +# +# Recovery Test 8. +# Test deeply nested transactions and many-child transactions. +proc recd008 { method {breadth 4} {depth 4} args} { + global kvals + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 } { + puts "Recd008 skipping for method $method" + return + } + puts "Recd008: $method $breadth X $depth deeply nested transactions" + + # Create the database and environment. + env_cleanup $testdir + + set dbfile recd008.db + + puts "\tRecd008.a: create database" + set db [eval {berkdb_open -create} $args $omethod $testdir/$dbfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Make sure that we have enough entries to span a couple of + # different pages. + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < 1000 } { + if { [string compare $omethod "-recno"] == 0 } { + set key [expr $count + 1] + } else { + set key $str + } + if { $count == 500} { + set p1 $key + set kvals($p1) $str + } + set ret [$db put $key $str] + error_check_good put $ret 0 + + incr count + } + close $did + error_check_good db_close [$db close] 0 + + set txn_max [expr int([expr pow($breadth,$depth)])] + if { $txn_max < 20 } { + set txn_max 20 + } + puts "\tRecd008.b: create environment for $txn_max transactions" + + set eflags "-mode 0644 -create -txn_max $txn_max \ + -txn -home $testdir" + set env_cmd "berkdb env $eflags" + set dbenv [eval $env_cmd] + error_check_good env_open [is_valid_env $dbenv] TRUE + + reset_env $dbenv + + set rlist { + { {recd008_parent abort ENV DB $p1 TXNID 1 1 $breadth $depth} + "Recd008.c: child abort parent" } + { {recd008_parent commit ENV DB $p1 TXNID 1 1 $breadth $depth} + "Recd008.d: child commit parent" } + } + foreach pair $rlist { + set cmd [subst [lindex $pair 0]] + set msg [lindex $pair 1] + op_recover abort $testdir $env_cmd $dbfile $cmd $msg + recd008_setkval $dbfile $p1 + op_recover commit $testdir $env_cmd $dbfile $cmd $msg + recd008_setkval $dbfile $p1 + } + + puts "\tRecd008.e: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} + +proc recd008_setkval { dbfile p1 } { + global kvals + source ./include.tcl + + set db [berkdb_open $testdir/$dbfile] + error_check_good dbopen [is_valid_db $db] TRUE + set ret [$db get $p1] + set kvals($p1) [lindex [lindex $ret 0] 1] +} + +# This is a lot like the op_recover procedure. We cannot use that +# because it was not meant to be called recursively. This proc +# knows about depth/breadth and file naming so that recursive calls +# don't overwrite various initial and afterop files, etc. +# +# The basic flow of this is: +# (Initial file) +# Parent begin transaction (in op_recover) +# Parent starts children +# Recursively call recd008_recover +# (children modify p1) +# Parent modifies p1 +# (Afterop file) +# Parent commit/abort (in op_recover) +# (Final file) +# Recovery test (in op_recover) +proc recd008_parent { op env db p1key parent b0 d0 breadth depth } { + global kvals + source ./include.tcl + + # + # Save copy of original data + # Acquire lock on data + # + set olddata $kvals($p1key) + set ret [$db get -rmw -txn $parent $p1key] + set Dret [lindex [lindex $ret 0] 1] + error_check_good get_parent_RMW $Dret $olddata + + # + # Parent spawns off children + # + set ret [recd008_txn $op $env $db $p1key $parent \ + $b0 $d0 $breadth $depth] + + puts "Child runs complete. Parent modifies data." + + # + # Parent modifies p1 + # + set newdata $olddata.parent + set ret [$db put -txn $parent $p1key $newdata] + error_check_good db_put $ret 0 + + # + # Save value in kvals for later comparison + # + switch $op { + "commit" { + set kvals($p1key) $newdata + } + "abort" { + set kvals($p1key) $olddata + } + } + return 0 +} + +proc recd008_txn { op env db p1key parent b0 d0 breadth depth } { + global log_log_record_types + global kvals + source ./include.tcl + + for {set d 1} {$d < $d0} {incr d} { + puts -nonewline "\t" + } + puts "Recd008_txn: $op parent:$parent $breadth $depth ($b0 $d0)" + + # Save the initial file and open the environment and the file + for {set b $b0} {$b <= $breadth} {incr b} { + # + # Begin child transaction + # + set t [$env txn -parent $parent] + error_check_bad txn_begin $t NULL + error_check_good txn_begin [is_valid_txn $t $env] TRUE + set startd [expr $d0 + 1] + set child $b:$startd:$t + set olddata $kvals($p1key) + set newdata $olddata.$child + set ret [$db get -rmw -txn $t $p1key] + set Dret [lindex [lindex $ret 0] 1] + error_check_good get_parent_RMW $Dret $olddata + + # + # Recursively call to set up nested transactions/children + # + for {set d $startd} {$d <= $depth} {incr d} { + set ret [recd008_txn commit $env $db $p1key $t \ + $b $d $breadth $depth] + set ret [recd008_txn abort $env $db $p1key $t \ + $b $d $breadth $depth] + } + # + # Modifies p1. + # + set ret [$db put -txn $t $p1key $newdata] + error_check_good db_put $ret 0 + + # + # Commit or abort + # + for {set d 1} {$d < $startd} {incr d} { + puts -nonewline "\t" + } + puts "Executing txn_$op:$t" + error_check_good txn_$op:$t [$t $op] 0 + for {set d 1} {$d < $startd} {incr d} { + puts -nonewline "\t" + } + set ret [$db get -rmw -txn $parent $p1key] + set Dret [lindex [lindex $ret 0] 1] + switch $op { + "commit" { + puts "Command executed and committed." + error_check_good get_parent_RMW $Dret $newdata + set kvals($p1key) $newdata + } + "abort" { + puts "Command executed and aborted." + error_check_good get_parent_RMW $Dret $olddata + set kvals($p1key) $olddata + } + } + } + return 0 +} diff --git a/bdb/test/recd009.tcl b/bdb/test/recd009.tcl new file mode 100644 index 00000000000..2b49437346c --- /dev/null +++ b/bdb/test/recd009.tcl @@ -0,0 +1,181 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd009.tcl,v 1.13 2000/12/07 19:13:46 sue Exp $ +# +# Recovery Test 9. +# Test stability of record numbers across splits +# and reverse splits and across recovery. +proc recd009 { method {select 0} args} { + global fixed_len + source ./include.tcl + + if { [is_rbtree $method] != 1 && [is_rrecno $method] != 1} { + puts "Recd009 skipping for method $method." + return + } + + set opts [convert_args $method $args] + set method [convert_method $method] + + puts "\tRecd009: Test record numbers across splits and recovery" + + set testfile recd009.db + env_cleanup $testdir + set mkeys 1000 + set nkeys 5 + set data "data" + + puts "\tRecd009.a: Create $method environment and database." + set flags "-create -txn -home $testdir" + + set env_cmd "berkdb env $flags" + set dbenv [eval $env_cmd] + error_check_good dbenv [is_valid_env $dbenv] TRUE + + set oflags "-env $dbenv -create -mode 0644 $opts $method" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Fill page with small key/data pairs. Keep at leaf. + puts "\tRecd009.b: Fill page with $nkeys small key/data pairs." + for { set i 1 } { $i <= $nkeys } { incr i } { + if { [is_recno $method] == 1 } { + set key $i + } else { + set key key000$i + } + set ret [$db put $key $data$i] + error_check_good dbput $ret 0 + } + error_check_good db_close [$db close] 0 + error_check_good env_close [$dbenv close] 0 + + set newnkeys [expr $nkeys + 1] + # List of recovery tests: {CMD MSG} pairs. + set rlist { + { {recd009_split DB TXNID 1 $method $newnkeys $mkeys} + "Recd009.c: split"} + { {recd009_split DB TXNID 0 $method $newnkeys $mkeys} + "Recd009.d: reverse split"} + } + + foreach pair $rlist { + set cmd [subst [lindex $pair 0]] + set msg [lindex $pair 1] + if { $select != 0 } { + set tag [lindex $msg 0] + set tail [expr [string length $tag] - 2] + set tag [string range $tag $tail $tail] + if { [lsearch $select $tag] == -1 } { + continue + } + } + set reverse [string first "reverse" $msg] + if { $reverse == -1 } { + set abortkeys $nkeys + set commitkeys $mkeys + set abortpg 0 + set commitpg 1 + } else { + set abortkeys $mkeys + set commitkeys $nkeys + set abortpg 1 + set commitpg 0 + } + op_recover abort $testdir $env_cmd $testfile $cmd $msg + recd009_recnocheck $testdir $testfile $opts $abortkeys $abortpg + op_recover commit $testdir $env_cmd $testfile $cmd $msg + recd009_recnocheck $testdir $testfile $opts \ + $commitkeys $commitpg + } + puts "\tRecd009.e: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} + +# +# This procedure verifies that the database has only numkeys number +# of keys and that they are in order. +# +proc recd009_recnocheck { tdir testfile opts numkeys numpg} { + source ./include.tcl + + set db [eval {berkdb_open} $opts $tdir/$testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + puts "\tRecd009_recnocheck: Verify page count of $numpg on split." + set stat [$db stat] + error_check_bad stat:check-split [is_substr $stat \ + "{{Internal pages} 0}"] $numpg + + set type [$db get_type] + set dbc [$db cursor] + error_check_good dbcursor [is_valid_cursor $dbc $db] TRUE + set i 1 + puts "\tRecd009_recnocheck: Checking $numkeys record numbers." + for {set d [$dbc get -first]} { [llength $d] != 0 } { + set d [$dbc get -next]} { + if { [is_btree $type] } { + set thisi [$dbc get -get_recno] + } else { + set thisi [lindex [lindex $d 0] 0] + } + error_check_good recno_check $i $thisi + error_check_good record_count [expr $i <= $numkeys] 1 + incr i + } + error_check_good curs_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} + +proc recd009_split { db txn split method nkeys mkeys } { + global errorCode + source ./include.tcl + + set data "data" + + set isrecno [is_recno $method] + # if mkeys is above 1000, need to adjust below for lexical order + if { $split == 1 } { + puts "\tRecd009_split: Add $mkeys pairs to force split." + for {set i $nkeys} { $i <= $mkeys } { incr i } { + if { $isrecno == 1 } { + set key $i + } else { + if { $i >= 100 } { + set key key0$i + } elseif { $i >= 10 } { + set key key00$i + } else { + set key key000$i + } + } + set ret [$db put -txn $txn $key $data$i] + error_check_good dbput:more $ret 0 + } + } else { + puts "\tRecd009_split: Delete added keys to force reverse split." + # Since rrecno renumbers, we delete downward. + for {set i $mkeys} { $i >= $nkeys } { set i [expr $i - 1] } { + if { $isrecno == 1 } { + set key $i + } else { + if { $i >= 100 } { + set key key0$i + } elseif { $i >= 10 } { + set key key00$i + } else { + set key key000$i + } + } + error_check_good db_del:$i [$db del -txn $txn $key] 0 + } + } + return 0 +} diff --git a/bdb/test/recd010.tcl b/bdb/test/recd010.tcl new file mode 100644 index 00000000000..4fd1aefbb60 --- /dev/null +++ b/bdb/test/recd010.tcl @@ -0,0 +1,235 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd010.tcl,v 1.14 2000/12/11 17:24:55 sue Exp $ +# +# Recovery Test 10. +# Test stability of btree duplicates across btree off-page dup splits +# and reverse splits and across recovery. +proc recd010 { method {select 0} args} { + global fixed_len + global kvals + global kvals_dups + source ./include.tcl + + if { [is_dbtree $method] != 1 && [is_ddbtree $method] != 1} { + puts "Recd010 skipping for method $method." + return + } + + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Recd010: skipping for specific pagesizes" + return + } + + set opts [convert_args $method $args] + set method [convert_method $method] + + puts "\tRecd010 ($opts): Test duplicates across splits and recovery" + + set testfile recd010.db + env_cleanup $testdir + # + # Set pagesize small to generate lots of off-page dups + # + set page 512 + set mkeys 1000 + set firstkeys 5 + set data "data" + set key "recd010_key" + + puts "\tRecd010.a: Create $method environment and database." + set flags "-create -txn -home $testdir" + + set env_cmd "berkdb env $flags" + set dbenv [eval $env_cmd] + error_check_good dbenv [is_valid_env $dbenv] TRUE + + set oflags "-env $dbenv -create -mode 0644 $opts $method" + set db [eval {berkdb_open} -pagesize $page $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Fill page with small key/data pairs. Keep at leaf. + puts "\tRecd010.b: Fill page with $firstkeys small dups." + for { set i 1 } { $i <= $firstkeys } { incr i } { + set ret [$db put $key $data$i] + error_check_good dbput $ret 0 + } + set kvals 1 + set kvals_dups $firstkeys + error_check_good db_close [$db close] 0 + error_check_good env_close [$dbenv close] 0 + + # List of recovery tests: {CMD MSG} pairs. + if { $mkeys < 100 } { + puts "Recd010 mkeys of $mkeys too small" + return + } + set rlist { + { {recd010_split DB TXNID 1 $method 2 $mkeys} + "Recd010.c: btree split 2 large dups"} + { {recd010_split DB TXNID 0 $method 2 $mkeys} + "Recd010.d: btree reverse split 2 large dups"} + { {recd010_split DB TXNID 1 $method 10 $mkeys} + "Recd010.e: btree split 10 dups"} + { {recd010_split DB TXNID 0 $method 10 $mkeys} + "Recd010.f: btree reverse split 10 dups"} + { {recd010_split DB TXNID 1 $method 100 $mkeys} + "Recd010.g: btree split 100 dups"} + { {recd010_split DB TXNID 0 $method 100 $mkeys} + "Recd010.h: btree reverse split 100 dups"} + } + + foreach pair $rlist { + set cmd [subst [lindex $pair 0]] + set msg [lindex $pair 1] + if { $select != 0 } { + set tag [lindex $msg 0] + set tail [expr [string length $tag] - 2] + set tag [string range $tag $tail $tail] + if { [lsearch $select $tag] == -1 } { + continue + } + } + set reverse [string first "reverse" $msg] + op_recover abort $testdir $env_cmd $testfile $cmd $msg + recd010_check $testdir $testfile $opts abort $reverse $firstkeys + op_recover commit $testdir $env_cmd $testfile $cmd $msg + recd010_check $testdir $testfile $opts commit $reverse $firstkeys + } + puts "\tRecd010.e: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} + +# +# This procedure verifies that the database has only numkeys number +# of keys and that they are in order. +# +proc recd010_check { tdir testfile opts op reverse origdups } { + global kvals + global kvals_dups + source ./include.tcl + + set db [eval {berkdb_open} $opts $tdir/$testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set data "data" + + if { $reverse == -1 } { + puts "\tRecd010_check: Verify split after $op" + } else { + puts "\tRecd010_check: Verify reverse split after $op" + } + + set stat [$db stat] + if { [expr ([string compare $op "abort"] == 0 && $reverse == -1) || \ + ([string compare $op "commit"] == 0 && $reverse != -1)]} { + set numkeys 0 + set allkeys [expr $numkeys + 1] + set numdups $origdups + # + # If we abort the adding of dups, or commit + # the removal of dups, either way check that + # we are back at the beginning. Check that: + # - We have 0 internal pages. + # - We have only 1 key (the original we primed the db + # with at the beginning of the test). + # - We have only the original number of dups we primed + # the db with at the beginning of the test. + # + error_check_good stat:orig0 [is_substr $stat \ + "{{Internal pages} 0}"] 1 + error_check_good stat:orig1 [is_substr $stat \ + "{{Number of keys} 1}"] 1 + error_check_good stat:orig2 [is_substr $stat \ + "{{Number of records} $origdups}"] 1 + } else { + set numkeys $kvals + set allkeys [expr $numkeys + 1] + set numdups $kvals_dups + # + # If we abort the removal of dups, or commit the + # addition of dups, check that: + # - We have > 0 internal pages. + # - We have the number of keys. + # + error_check_bad stat:new0 [is_substr $stat \ + "{{Internal pages} 0}"] 1 + error_check_good stat:new1 [is_substr $stat \ + "{{Number of keys} $allkeys}"] 1 + } + + set dbc [$db cursor] + error_check_good dbcursor [is_valid_cursor $dbc $db] TRUE + puts "\tRecd010_check: Checking key and duplicate values" + set key "recd010_key" + # + # Check dups are there as they should be. + # + for {set ki 0} {$ki < $numkeys} {incr ki} { + set datacnt 0 + for {set d [$dbc get -set $key$ki]} { [llength $d] != 0 } { + set d [$dbc get -nextdup]} { + set thisdata [lindex [lindex $d 0] 1] + error_check_good dup_check $thisdata $data$datacnt + incr datacnt + } + error_check_good dup_count $datacnt $numdups + } + # + # Check that the number of expected keys (allkeys) are + # all of the ones that exist in the database. + # + set dupkeys 0 + set lastkey "" + for {set d [$dbc get -first]} { [llength $d] != 0 } { + set d [$dbc get -next]} { + set thiskey [lindex [lindex $d 0] 0] + if { [string compare $lastkey $thiskey] != 0 } { + incr dupkeys + } + set lastkey $thiskey + } + error_check_good key_check $allkeys $dupkeys + error_check_good curs_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} + +proc recd010_split { db txn split method nkeys mkeys } { + global errorCode + global kvals + global kvals_dups + source ./include.tcl + + set data "data" + set key "recd010_key" + + set numdups [expr $mkeys / $nkeys] + + set kvals $nkeys + set kvals_dups $numdups + if { $split == 1 } { + puts \ +"\tRecd010_split: Add $nkeys keys, with $numdups duplicates each to force split." + for {set k 0} { $k < $nkeys } { incr k } { + for {set i 0} { $i < $numdups } { incr i } { + set ret [$db put -txn $txn $key$k $data$i] + error_check_good dbput:more $ret 0 + } + } + } else { + puts \ +"\tRecd010_split: Delete $nkeys keys to force reverse split." + for {set k 0} { $k < $nkeys } { incr k } { + error_check_good db_del:$k [$db del -txn $txn $key$k] 0 + } + } + return 0 +} diff --git a/bdb/test/recd011.tcl b/bdb/test/recd011.tcl new file mode 100644 index 00000000000..a6fc269741b --- /dev/null +++ b/bdb/test/recd011.tcl @@ -0,0 +1,115 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd011.tcl,v 11.13 2000/12/06 17:09:54 sue Exp $ +# +# Recovery Test 11. +# Test recovery to a specific timestamp. +proc recd011 { method {niter 200} {ckpt_freq 15} {sleep_time 1} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + set tnum 11 + + puts "Recd0$tnum ($args): Test recovery to a specific timestamp." + + set testfile recd0$tnum.db + env_cleanup $testdir + + set i 0 + if { [is_record_based $method] == 1 } { + set key 1 + } else { + set key KEY + } + + puts "\tRecd0$tnum.a: Create environment and database." + set flags "-create -txn -home $testdir" + + set env_cmd "berkdb env $flags" + set dbenv [eval $env_cmd] + error_check_good dbenv [is_valid_env $dbenv] TRUE + + set oflags "-env $dbenv -create -mode 0644 $args $omethod" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Main loop: every second or so, increment the db in a txn. + puts "\t\tInitial Checkpoint" + error_check_good "Initial Checkpoint" [$dbenv txn_checkpoint] 0 + + puts "\tRecd0$tnum.b ($niter iterations):\ + Transaction-protected increment loop." + for { set i 0 } { $i <= $niter } { incr i } { + set data $i + + # Put, in a txn. + set txn [$dbenv txn] + error_check_good txn_begin [is_valid_txn $txn $dbenv] TRUE + error_check_good db_put \ + [$db put -txn $txn $key [chop_data $method $data]] 0 + error_check_good txn_commit [$txn commit] 0 + + set timeof($i) [timestamp -r] + + # If an appropriate period has elapsed, checkpoint. + if { $i % $ckpt_freq == $ckpt_freq - 1 } { + puts "\t\tIteration $i: Checkpointing." + error_check_good ckpt($i) [$dbenv txn_checkpoint] 0 + } + + # sleep for N seconds. + tclsleep $sleep_time + } + error_check_good db_close [$db close] 0 + error_check_good env_close [$dbenv close] 0 + + # Now, loop through and recover to each timestamp, verifying the + # expected increment. + puts "\tRecd0$tnum.c: Recover to each timestamp and check." + for { set i 0 } { $i <= $niter } { incr i } { + + # Run db_recover. + berkdb debug_check + set t [clock format $timeof($i) -format "%y%m%d%H%M.%S"] + set ret [catch {exec $util_path/db_recover -h $testdir -t $t} r] + error_check_good db_recover($i,$t) $ret 0 + + # Now open the db and check the timestamp. + set db [eval {berkdb_open} $testdir/$testfile] + error_check_good db_open($i) [is_valid_db $db] TRUE + + set dbt [$db get $key] + set datum [lindex [lindex $dbt 0] 1] + error_check_good timestamp_recover $datum [pad_data $method $i] + + error_check_good db_close [$db close] 0 + } + + # Finally, recover to a time well before the first timestamp + # and well after the last timestamp. The latter should + # be just like the last timestamp; the former should fail. + puts "\tRecd0$tnum.d: Recover to before the first timestamp." + set t [clock format [expr $timeof(0) - 1000] -format "%y%m%d%H%M.%S"] + set ret [catch {exec $util_path/db_recover -h $testdir -t $t} r] + error_check_bad db_recover(before,$t) $ret 0 + + puts "\tRecd0$tnum.e: Recover to after the last timestamp." + set t [clock format \ + [expr $timeof($niter) + 1000] -format "%y%m%d%H%M.%S"] + set ret [catch {exec $util_path/db_recover -h $testdir -t $t} r] + error_check_good db_recover(after,$t) $ret 0 + + # Now open the db and check the timestamp. + set db [eval {berkdb_open} $testdir/$testfile] + error_check_good db_open(after) [is_valid_db $db] TRUE + + set dbt [$db get $key] + set datum [lindex [lindex $dbt 0] 1] + + error_check_good timestamp_recover $datum [pad_data $method $niter] + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/recd012.tcl b/bdb/test/recd012.tcl new file mode 100644 index 00000000000..19dd7b011d1 --- /dev/null +++ b/bdb/test/recd012.tcl @@ -0,0 +1,423 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd012.tcl,v 11.14 2000/12/11 17:24:55 sue Exp $ +# +# Recovery Test 12. +# Test recovery handling of file opens and closes. +proc recd012 { method {start 0} \ + {niter 49} {noutiter 25} {niniter 100} {ndbs 5} args } { + source ./include.tcl + + set tnum 12 + set pagesize 512 + + if { $is_qnx_test } { + set niter 40 + } + + puts "Recd0$tnum $method ($args): Test recovery file management." + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Recd012: skipping for specific pagesizes" + return + } + + for { set i $start } { $i <= $niter } { incr i } { + + env_cleanup $testdir + + # For repeatability, we pass in the iteration number + # as a parameter and use that in recd012_body to seed + # the random number generator to randomize our operations. + # This lets us re-run a potentially failing iteration + # without having to start from the beginning and work + # our way to it. + # + # The number of databases ranges from 4 to 8 and is + # a function of $niter +# set ndbs [expr ($i % 5) + 4] + + recd012_body \ + $method $ndbs $i $noutiter $niniter $pagesize $tnum $args + } +} + +proc recd012_body { method {ndbs 5} iter noutiter niniter psz tnum {largs ""} } { + global alphabet rand_init fixed_len recd012_ofkey recd012_ofckptkey + source ./include.tcl + + set largs [convert_args $method $largs] + set omethod [convert_method $method] + + puts "\tRecd0$tnum $method ($largs): Iteration $iter" + puts "\t\tRecd0$tnum.a: Create environment and $ndbs databases." + + set flags "-create -txn -home $testdir" + set env_cmd "berkdb env $flags" + error_check_good env_remove [berkdb envremove -home $testdir] 0 + set dbenv [eval $env_cmd] + error_check_good dbenv [is_valid_env $dbenv] TRUE + + # Initialize random number generator based on $iter. + berkdb srand [expr $iter + $rand_init] + + # Initialize database that keeps track of number of open files (so + # we don't run out of descriptors). + set ofname of.db + set ofdb [berkdb_open -env $dbenv\ + -create -dup -mode 0644 -btree -pagesize 512 $ofname] + error_check_good of_open [is_valid_db $ofdb] TRUE + set oftxn [$dbenv txn] + error_check_good of_txn [is_valid_txn $oftxn $dbenv] TRUE + error_check_good of_put [$ofdb put -txn $oftxn $recd012_ofkey 1] 0 + error_check_good of_put2 [$ofdb put -txn $oftxn $recd012_ofckptkey 0] 0 + error_check_good of_put3 [$ofdb put -txn $oftxn $recd012_ofckptkey 0] 0 + error_check_good of_txn_commit [$oftxn commit] 0 + error_check_good of_close [$ofdb close] 0 + + # Create ndbs databases to work in, and a file listing db names to + # pick from. + set f [open TESTDIR/dblist w] + set oflags \ + "-env $dbenv -create -mode 0644 -pagesize $psz $largs $omethod" + for { set i 0 } { $i < $ndbs } { incr i } { + # 50-50 chance of being a subdb, unless we're a queue. + if { [berkdb random_int 0 1] || [is_queue $method] } { + # not a subdb + set dbname recd0$tnum-$i.db + } else { + # subdb + set dbname "recd0$tnum-subdb.db s$i" + } + puts $f $dbname + set db [eval berkdb_open $oflags $dbname] + error_check_good db($i) [is_valid_db $db] TRUE + error_check_good db($i)_close [$db close] 0 + } + close $f + + error_check_good env_close [$dbenv close] 0 + + # Now we get to the meat of things. Our goal is to do some number + # of opens, closes, updates, and shutdowns (simulated here by a + # close of all open handles and a close/reopen of the environment, + # with or without an envremove), matching the regular expression + # + # ((O[OUC]+S)+R+V) + # + # We'll repeat the inner + a random number up to $niniter times, + # and the outer + a random number up to $noutiter times. + # + # In order to simulate shutdowns, we'll perform the opens, closes, + # and updates in a separate process, which we'll exit without closing + # all handles properly. The environment will be left lying around + # before we run recovery 50% of the time. + set out [berkdb random_int 1 $noutiter] + puts "\t\tRecd0$tnum.b: Performing $out recoveries of up to $niniter\ + ops." + for { set i 0 } { $i < $out } { incr i } { + set child [open "|$tclsh_path" w] + + # For performance, don't source everything, + # just what we'll need. + puts $child "load $tcllib" + puts $child "set fixed_len $fixed_len" + puts $child "source ../test/testutils.tcl" + puts $child "source ../test/recd0$tnum.tcl" + + set rnd [expr $iter * 10000 + $i * 100 + $rand_init] + + # Go. + # puts "recd012_dochild {$env_cmd} $rnd $i $niniter\ + # $ndbs $tnum $method $ofname $largs" + puts $child "recd012_dochild {$env_cmd} $rnd $i $niniter\ + $ndbs $tnum $method $ofname $largs" + close $child + + # Run recovery 0-3 times. + set nrecs [berkdb random_int 0 3] + for { set j 0 } { $j < $nrecs } { incr j } { + set ret [catch {exec $util_path/db_recover \ + -h $testdir} res] + if { $ret != 0 } { + puts "FAIL: db_recover returned with nonzero\ + exit status, output as follows:" + file mkdir /tmp/12out + set fd [open /tmp/12out/[pid] w] + puts $fd $res + close $fd + } + error_check_good recover($j) $ret 0 + } + + } + + # Run recovery one final time; it doesn't make sense to + # check integrity if we do not. + set ret [catch {exec $util_path/db_recover -h $testdir} res] + if { $ret != 0 } { + puts "FAIL: db_recover returned with nonzero\ + exit status, output as follows:" + puts $res + } + + # Make sure each datum is the correct filename. + puts "\t\tRecd0$tnum.c: Checking data integrity." + set dbenv [berkdb env -create -private -home $testdir] + error_check_good env_open_integrity [is_valid_env $dbenv] TRUE + set f [open TESTDIR/dblist r] + set i 0 + while { [gets $f dbinfo] > 0 } { + set db [eval berkdb_open -env $dbenv $dbinfo] + error_check_good dbopen($dbinfo) [is_valid_db $db] TRUE + + set dbc [$db cursor] + error_check_good cursor [is_valid_cursor $dbc $db] TRUE + + for { set dbt [$dbc get -first] } { [llength $dbt] > 0 } \ + { set dbt [$dbc get -next] } { + error_check_good integrity [lindex [lindex $dbt 0] 1] \ + [pad_data $method $dbinfo] + } + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + } + close $f + error_check_good env_close_integrity [$dbenv close] 0 + + + # Verify + error_check_good verify [verify_dir $testdir "\t\tRecd0$tnum.d: "] 0 +} + + +proc recd012_dochild { env_cmd rnd outiter niniter ndbs tnum method\ + ofname args } { + global recd012_ofkey + if { [is_record_based $method] } { + set keybase "" + } else { + set keybase .[repeat abcdefghijklmnopqrstuvwxyz 4] + } + + # Initialize our random number generator, repeatably based on an arg. + berkdb srand $rnd + + # Open our env. + set dbenv [eval $env_cmd] + error_check_good env_open [is_valid_env $dbenv] TRUE + + # Find out how many databases appear to be open in the log--we + # don't want recovery to run out of filehandles. + set ofdb [berkdb_open -env $dbenv $ofname] + set oftxn [$dbenv txn] + error_check_good of_txn [is_valid_txn $oftxn $dbenv] TRUE + set dbt [$ofdb get -txn $oftxn $recd012_ofkey] + error_check_good of_get [lindex [lindex $dbt 0] 0] $recd012_ofkey + set nopenfiles [lindex [lindex $dbt 0] 1] + + error_check_good of_commit [$oftxn commit] 0 + + # Read our dbnames + set f [open TESTDIR/dblist r] + set i 0 + while { [gets $f dbname($i)] > 0 } { + incr i + } + close $f + + # We now have $ndbs extant databases. + # Open one of them, just to get us started. + set opendbs {} + set oflags "-env $dbenv $args" + + # Start a transaction, just to get us started. + set curtxn [$dbenv txn] + error_check_good txn [is_valid_txn $curtxn $dbenv] TRUE + + # Inner loop. Do $in iterations of a random open, close, or + # update, where $in is between 1 and $niniter. + set in [berkdb random_int 1 $niniter] + for { set j 0 } { $j < $in } { incr j } { + set op [berkdb random_int 0 2] + switch $op { + 0 { + # Open. + recd012_open + } + 1 { + # Update. Put random-number$keybase as key, + # filename as data, into random database. + set num_open [llength $opendbs] + if { $num_open == 0 } { + # If none are open, do an open first. + + recd012_open + } + set n [berkdb random_int 0 [expr $num_open - 1]] + set pair [lindex $opendbs $n] + set udb [lindex $pair 0] + set uname [lindex $pair 1] + + set key [berkdb random_int 1000 1999]$keybase + set data [chop_data $method $uname] + error_check_good put($uname,$udb,$key,$data) \ + [$udb put -txn $curtxn $key $data] 0 + + # One time in four, commit the transaction. + if { [berkdb random_int 0 3] == 0 && 0 } { + error_check_good txn_recommit \ + [$curtxn commit] 0 + set curtxn [$dbenv txn] + error_check_good txn_reopen \ + [is_valid_txn $curtxn $dbenv] TRUE + } + } + 2 { + # Close. + + if { [llength $opendbs] == 0 } { + # If none are open, open instead of closing. + recd012_open + continue + } + + # Commit curtxn first, lest we self-deadlock. + error_check_good txn_recommit \ + [$curtxn commit] 0 + + # Do it. + set which [berkdb random_int 0 \ + [expr [llength $opendbs] - 1]] + + set db [lindex [lindex $opendbs $which] 0] + error_check_good db_choice [is_valid_db $db] TRUE + global errorCode errorInfo + + error_check_good db_close \ + [[lindex [lindex $opendbs $which] 0] close] 0 + set opendbs [lreplace $opendbs $which $which] + incr nopenfiles -1 + + + # Reopen txn. + set curtxn [$dbenv txn] + error_check_good txn_reopen \ + [is_valid_txn $curtxn $dbenv] TRUE + + } + } + + # One time in two hundred, checkpoint. + if { [berkdb random_int 0 199] == 0 } { + puts "\t\t\tRecd0$tnum:\ + Random checkpoint after operation $outiter.$j." + error_check_good txn_ckpt \ + [$dbenv txn_checkpoint] 0 + set nopenfiles \ + [recd012_nopenfiles_ckpt $dbenv $ofdb $nopenfiles] + } + } + + # We have to commit curtxn. It'd be kind of nice not to, but + # if we start in again without running recovery, we may block + # ourselves. + error_check_good curtxn_commit [$curtxn commit] 0 + + # Put back the new number of open files. + set oftxn [$dbenv txn] + error_check_good of_txn [is_valid_txn $oftxn $dbenv] TRUE + error_check_good of_del [$ofdb del -txn $oftxn $recd012_ofkey] 0 + error_check_good of_put \ + [$ofdb put -txn $oftxn $recd012_ofkey $nopenfiles] 0 + error_check_good of_commit [$oftxn commit] 0 + error_check_good ofdb_close [$ofdb close] 0 +} + +proc recd012_open { } { + # This is basically an inline and has to modify curtxn, + # so use upvars. + upvar curtxn curtxn + upvar ndbs ndbs + upvar dbname dbname + upvar dbenv dbenv + upvar oflags oflags + upvar opendbs opendbs + upvar nopenfiles nopenfiles + + # Return without an open if we've already opened too many files-- + # we don't want to make recovery run out of filehandles. + if { $nopenfiles > 30 } { + #puts "skipping--too many open files" + return -code break + } + + # Commit curtxn first, lest we self-deadlock. + error_check_good txn_recommit \ + [$curtxn commit] 0 + + # Do it. + set which [berkdb random_int 0 [expr $ndbs - 1]] + set db [eval berkdb_open \ + $oflags $dbname($which)] + lappend opendbs [list $db $dbname($which)] + + # Reopen txn. + set curtxn [$dbenv txn] + error_check_good txn_reopen \ + [is_valid_txn $curtxn $dbenv] TRUE + + incr nopenfiles +} + +# Update the database containing the number of files that db_recover has +# to contend with--we want to avoid letting it run out of file descriptors. +# We do this by keeping track of the number of unclosed opens since the +# checkpoint before last. +# $recd012_ofkey stores this current value; the two dups available +# at $recd012_ofckptkey store the number of opens since the last checkpoint +# previous. +# Thus, if the current value is 17 when we do a checkpoint, and the +# stored values are 3 and 8, the new current value (which we return) +# is 14, and the new stored values are 8 and 6. +proc recd012_nopenfiles_ckpt { env db nopenfiles } { + global recd012_ofckptkey + set txn [$env txn] + error_check_good nopenfiles_ckpt_txn [is_valid_txn $txn $env] TRUE + + set dbc [$db cursor -txn $txn] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + # Get the first ckpt value and delete it. + set dbt [$dbc get -set $recd012_ofckptkey] + error_check_good set [llength $dbt] 1 + + set discard [lindex [lindex $dbt 0] 1] + error_check_good del [$dbc del] 0 + + set nopenfiles [expr $nopenfiles - $discard] + + # Get the next ckpt value + set dbt [$dbc get -nextdup] + error_check_good set2 [llength $dbt] 1 + + # Calculate how many opens we've had since this checkpoint before last. + set onlast [lindex [lindex $dbt 0] 1] + set sincelast [expr $nopenfiles - $onlast] + + # Put this new number at the end of the dup set. + error_check_good put [$dbc put -keylast $recd012_ofckptkey $sincelast] 0 + + # We should never deadlock since we're the only one in this db. + error_check_good dbc_close [$dbc close] 0 + error_check_good txn_commit [$txn commit] 0 + + return $nopenfiles +} + +# globals -- it's not worth passing these around, as they're constants +set recd012_ofkey OPENFILES +set recd012_ofckptkey CKPTS diff --git a/bdb/test/recd013.tcl b/bdb/test/recd013.tcl new file mode 100644 index 00000000000..d134d487f1e --- /dev/null +++ b/bdb/test/recd013.tcl @@ -0,0 +1,244 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd013.tcl,v 11.10 2000/12/11 17:24:55 sue Exp $ +# +# Recovery Test 13. +# Smoke test of aborted cursor adjustments. +# +# XXX +# Other tests that cover more specific variants of the same issue +# are in the access method tests for now. This is probably wrong; we +# put this one here because they're closely based on and intertwined +# with other, non-transactional cursor stability tests that are among +# the access method tests, and because we need at least one test to +# fit under recd and keep logtrack from complaining. We'll sort out the mess +# later; the important thing, for now, is that everything that needs to gets +# tested. (This really shouldn't be under recd at all, since it doesn't +# run recovery!) +proc recd013 { method { nitems 100 } args } { + source ./include.tcl + global alphabet log_log_record_types + + set args [convert_args $method $args] + set omethod [convert_method $method] + set tnum 13 + set pgsz 512 + + puts "Recd0$tnum $method ($args): Test of aborted cursor adjustments." + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Recd013: skipping for specific pagesizes" + return + } + + set testfile recd0$tnum.db + env_cleanup $testdir + + set i 0 + if { [is_record_based $method] == 1 } { + set keybase "" + } else { + set keybase "key" + } + + puts "\tRecd0$tnum.a:\ + Create environment, database, and parent transaction." + set flags "-create -txn -home $testdir" + + set env_cmd "berkdb env $flags" + set env [eval $env_cmd] + error_check_good dbenv [is_valid_env $env] TRUE + + set oflags "-env $env -create -mode 0644 -pagesize $pgsz $args $omethod" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Create a database containing $nitems items, numbered with odds. + # We'll then put the even numbers during the body of the test. + set txn [$env txn] + error_check_good init_txn [is_valid_txn $txn $env] TRUE + for { set i 1 } { $i <= 2 * $nitems } { incr i 2 } { + set key $keybase$i + set data [chop_data $method $i$alphabet] + error_check_good init_put($i) [$db put -txn $txn $key $data] 0 + } + error_check_good init_txn_commit [$txn commit] 0 + + # Create an initial txn; set a cursor of that txn to each item. + set txn [$env txn] + error_check_good txn [is_valid_txn $txn $env] TRUE + for { set i 1 } { $i <= 2 * $nitems } { incr i 2 } { + set dbc($i) [$db cursor -txn $txn] + error_check_good dbc_getset($i) [$dbc($i) get -set $keybase$i] \ + [list [list $keybase$i [pad_data $method $i$alphabet]]] + } + + puts "\tRecd0$tnum.b: Put test." + puts "\t\tRecd0$tnum.b.1: Put items." + set ctxn [$env txn -parent $txn] + error_check_good txn [is_valid_txn $ctxn $env] TRUE + for { set i 2 } { $i <= 2 * $nitems } { incr i 2 } { + set key $keybase$i + set data [chop_data $method $i$alphabet] + error_check_good child_put($i) [$db put -txn $ctxn $key $data] 0 + + # If we're a renumbering recno, this is uninteresting. + # Stir things up by putting a few additional records at + # the beginning. + if { [is_rrecno $method] == 1 } { + set curs [$db cursor -txn $ctxn] + error_check_bad llength_get_first \ + [llength [$curs get -first]] 0 + error_check_good cursor [is_valid_cursor $curs $db] TRUE + # expect a recno! + error_check_good rrecno_put($i) \ + [$curs put -before ADDITIONAL.$i] 1 + error_check_good curs_close [$curs close] 0 + } + } + + puts "\t\tRecd0$tnum.b.2: Verify cursor stability after abort." + error_check_good ctxn_abort [$ctxn abort] 0 + + for { set i 1 } { $i <= 2 * $nitems } { incr i 2 } { + error_check_good dbc_get($i) [$dbc($i) get -current] \ + [list [list $keybase$i [pad_data $method $i$alphabet]]] + } + + # Clean up cursors. + for { set i 1 } { $i <= 2 * $nitems } { incr i 2 } { + error_check_good dbc($i)_close [$dbc($i) close] 0 + } + + # Sync and verify. + error_check_good txn_commit [$txn commit] 0 + set txn [$env txn] + error_check_good txn [is_valid_txn $txn $env] TRUE + + error_check_good db_sync [$db sync] 0 + error_check_good db_verify \ + [verify_dir $testdir "\t\tRecd0$tnum.b.3: "] 0 + + # Now put back all the even records, this time in the parent. + # Commit and re-begin the transaction so we can abort and + # get back to a nice full database. + for { set i 2 } { $i <= 2 * $nitems } { incr i 2 } { + set key $keybase$i + set data [chop_data $method $i$alphabet] + error_check_good child_put($i) [$db put -txn $txn $key $data] 0 + } + error_check_good txn_commit [$txn commit] 0 + set txn [$env txn] + error_check_good txn [is_valid_txn $txn $env] TRUE + + # Delete test. Set a cursor to each record. Delete the even ones + # in the parent and check cursor stability. Then open a child + # transaction, and delete the odd ones. Verify that the database + # is empty + puts "\tRecd0$tnum.c: Delete test." + unset dbc + + # Create cursors pointing at each item. + for { set i 1 } { $i <= 2 * $nitems } { incr i } { + set dbc($i) [$db cursor -txn $txn] + error_check_good dbc($i)_create [is_valid_cursor $dbc($i) $db] \ + TRUE + error_check_good dbc_getset($i) [$dbc($i) get -set $keybase$i] \ + [list [list $keybase$i [pad_data $method $i$alphabet]]] + } + + puts "\t\tRecd0$tnum.c.1: Delete even items in parent txn." + if { [is_rrecno $method] != 1 } { + set init 2 + set bound [expr 2 * $nitems] + set step 2 + } else { + # In rrecno, deletes will renumber the items, so we have + # to take that into account when we delete by recno. + set init 2 + set bound [expr $nitems + 1] + set step 1 + } + for { set i $init } { $i <= $bound } { incr i $step } { + error_check_good del($i) [$db del -txn $txn $keybase$i] 0 + } + + # Verify that even items are deleted and odd items are not. + for { set i 1 } { $i <= 2 * $nitems } { incr i 2 } { + if { [is_rrecno $method] != 1 } { + set j $i + } else { + set j [expr ($i - 1) / 2 + 1] + } + error_check_good dbc_get($i) [$dbc($i) get -current] \ + [list [list $keybase$j [pad_data $method $i$alphabet]]] + } + for { set i 2 } { $i <= 2 * $nitems } { incr i 2 } { + error_check_good dbc_get($i) [$dbc($i) get -current] \ + [list [list "" ""]] + } + + puts "\t\tRecd0$tnum.c.2: Delete odd items in child txn." + + set ctxn [$env txn -parent $txn] + + for { set i 1 } { $i <= 2 * $nitems } { incr i 2 } { + if { [is_rrecno $method] != 1 } { + set j $i + } else { + # If this is an rrecno, just delete the first + # item repeatedly--the renumbering will make + # that delete everything. + set j 1 + } + error_check_good del($i) [$db del -txn $ctxn $keybase$j] 0 + } + + # Verify that everyone's deleted. + for { set i 1 } { $i <= 2 * $nitems } { incr i } { + error_check_good get_deleted($i) \ + [llength [$db get -txn $ctxn $keybase$i]] 0 + } + + puts "\t\tRecd0$tnum.c.3: Verify cursor stability after abort." + error_check_good ctxn_abort [$ctxn abort] 0 + + # Verify that even items are deleted and odd items are not. + for { set i 1 } { $i <= 2 * $nitems } { incr i 2 } { + if { [is_rrecno $method] != 1 } { + set j $i + } else { + set j [expr ($i - 1) / 2 + 1] + } + error_check_good dbc_get($i) [$dbc($i) get -current] \ + [list [list $keybase$j [pad_data $method $i$alphabet]]] + } + for { set i 2 } { $i <= 2 * $nitems } { incr i 2 } { + error_check_good dbc_get($i) [$dbc($i) get -current] \ + [list [list "" ""]] + } + + # Clean up cursors. + for { set i 1 } { $i <= 2 * $nitems } { incr i } { + error_check_good dbc($i)_close [$dbc($i) close] 0 + } + + # Sync and verify. + error_check_good db_sync [$db sync] 0 + error_check_good db_verify \ + [verify_dir $testdir "\t\tRecd0$tnum.c.4: "] 0 + + puts "\tRecd0$tnum.d: Clean up." + error_check_good txn_commit [$txn commit] 0 + error_check_good db_close [$db close] 0 + error_check_good env_close [$env close] 0 + error_check_good verify_dir \ + [verify_dir $testdir "\t\tRecd0$tnum.d.1: "] 0 + + if { $log_log_record_types == 1 } { + logtrack_read $testdir + } +} diff --git a/bdb/test/recd014.tcl b/bdb/test/recd014.tcl new file mode 100644 index 00000000000..83b3920de9b --- /dev/null +++ b/bdb/test/recd014.tcl @@ -0,0 +1,467 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: recd014.tcl,v 1.9 2001/01/11 17:16:04 sue Exp $ +# +# Recovery Test 14. +# This is a recovery test for create/delete of queue extents. We have +# hooks in the database so that we can abort the process at various +# points and make sure that the extent file does or does not exist. We +# then need to recover and make sure the file is correctly existing +# or not, as the case may be. +proc recd014 { method args} { + global fixed_len + source ./include.tcl + + if { ![is_queueext $method] == 1 } { + puts "Recd014: Skipping for method $method" + return + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Recd014: skipping for specific pagesizes" + return + } + + set orig_fixed_len $fixed_len + # + # We will use 512-byte pages, to be able to control + # when extents get created/removed. + # + set fixed_len 300 + + set opts [convert_args $method $args] + set omethod [convert_method $method] + # + # We want to set -extent 1 instead of what + # convert_args gave us. + # + set exti [lsearch -exact $opts "-extent"] + incr exti + set opts [lreplace $opts $exti $exti 1] + + puts "Recd014: $method extent creation/deletion tests" + + # Create the database and environment. + env_cleanup $testdir + + set testfile recd014.db + set flags "-create -txn -home $testdir" + + puts "\tRecd014.a: creating environment" + set env_cmd "berkdb env $flags" + + puts "\tRecd014.b: Create test commit" + ext_recover_create $testdir $env_cmd $omethod \ + $opts $testfile commit + puts "\tRecd014.b: Create test abort" + ext_recover_create $testdir $env_cmd $omethod \ + $opts $testfile abort + + puts "\tRecd014.c: Consume test commit" + ext_recover_delete $testdir $env_cmd $omethod \ + $opts $testfile consume commit + puts "\tRecd014.c: Consume test abort" + ext_recover_delete $testdir $env_cmd $omethod \ + $opts $testfile consume abort + + puts "\tRecd014.d: Delete test commit" + ext_recover_delete $testdir $env_cmd $omethod \ + $opts $testfile delete commit + puts "\tRecd014.d: Delete test abort" + ext_recover_delete $testdir $env_cmd $omethod \ + $opts $testfile delete abort + + set fixed_len $orig_fixed_len + puts "\tRecd014.e: Verify db_printlog can read logfile" + set tmpfile $testdir/printlog.out + set stat [catch {exec $util_path/db_printlog -h $testdir \ + > $tmpfile} ret] + error_check_good db_printlog $stat 0 + fileremove $tmpfile +} + +proc ext_recover_create { dir env_cmd method opts dbfile txncmd } { + global log_log_record_types + global fixed_len + global alphabet + source ./include.tcl + + # Keep track of the log types we've seen + if { $log_log_record_types == 1} { + logtrack_read $dir + } + + env_cleanup $dir + # Open the environment and set the copy/abort locations + set env [eval $env_cmd] + + set init_file $dir/$dbfile.init + set noenvflags "-create $method -mode 0644 -pagesize 512 $opts $dbfile" + set oflags "-env $env $noenvflags" + + set t [$env txn] + error_check_good txn_begin [is_valid_txn $t $env] TRUE + + set ret [catch {eval {berkdb_open} $oflags} db] + + # + # The command to execute to create an extent is a put. + # We are just creating the first one, so our extnum is 0. + # + set extnum 0 + set data [chop_data $method [replicate $alphabet 512]] + puts "\t\tExecuting command" + set putrecno [$db put -txn $t -append $data] + error_check_good db_put $putrecno 1 + + # Sync the db so any changes to the file that are + # in mpool get written to the disk file before the + # diff. + puts "\t\tSyncing" + error_check_good db_sync [$db sync] 0 + + catch { file copy -force $dir/$dbfile $dir/$dbfile.afterop } res + copy_extent_file $dir $dbfile afterop + + error_check_good txn_$txncmd:$t [$t $txncmd] 0 + # + # If we don't abort, then we expect success. + # If we abort, we expect no file created. + # + set dbq [make_ext_filename $dir $dbfile $extnum] + error_check_good extput:exists1 [file exists $dbq] 1 + set ret [$db get $putrecno] + if {$txncmd == "abort"} { + # + # Operation was aborted. Verify our entry is not there. + # + puts "\t\tCommand executed and aborted." + error_check_good db_get [llength $ret] 0 + } else { + # + # Operation was committed, verify it exists. + # + puts "\t\tCommand executed and committed." + error_check_good db_get [llength $ret] 1 + catch { file copy -force $dir/$dbfile $init_file } res + copy_extent_file $dir $dbfile init + } + error_check_good db_close [$db close] 0 + error_check_good env_close [$env close] 0 + + # + # Run recovery here. Should be a no-op. Verify that + # the file still does/n't exist when we are done. + # + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery (no-op) ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + # + # Verify it did not change. + # + error_check_good extput:exists2 [file exists $dbq] 1 + ext_create_check $dir $txncmd $init_file $dbfile $noenvflags $putrecno + + # + # Need a new copy to get the right LSN into the file. + # + catch { file copy -force $dir/$dbfile $init_file } res + copy_extent_file $dir $dbfile init + + # + # Undo. + # Now move the .afterop file to $dbfile. Run recovery again. + # + file copy -force $dir/$dbfile.afterop $dir/$dbfile + move_file_extent $dir $dbfile afterop copy + + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery (afterop) ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + ext_create_check $dir $txncmd $init_file $dbfile $noenvflags $putrecno + + # + # To redo, remove the dbfiles. Run recovery again. + # + catch { file rename -force $dir/$dbfile $dir/$dbfile.renamed } res + copy_extent_file $dir $dbfile renamed rename + + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery (init) ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + # + # !!! + # Even though db_recover exits with status 0, it should print out + # a warning because the file didn't exist. Db_recover writes this + # to stderr. Tcl assumes that ANYTHING written to stderr is an + # error, so even though we exit with 0 status, we still get an + # error back from 'catch'. Look for the warning. + # + if { $stat == 1 && [is_substr $result "warning"] == 0 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + + # + # Verify it was redone. However, since we removed the files + # to begin with, recovery with abort will not recreate the + # extent. Recovery with commit will. + # + if {$txncmd == "abort"} { + error_check_good extput:exists3 [file exists $dbq] 0 + } else { + error_check_good extput:exists3 [file exists $dbq] 1 + } +} + +proc ext_create_check { dir txncmd init_file dbfile oflags putrecno } { + if { $txncmd == "commit" } { + # + # Operation was committed. Verify it did not change. + # + error_check_good \ + diff(initial,post-recover2):diff($init_file,$dir/$dbfile) \ + [dbdump_diff $init_file $dir/$dbfile] 0 + } else { + # + # Operation aborted. The file is there, but make + # sure the item is not. + # + set xdb [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $xdb] TRUE + set ret [$xdb get $putrecno] + error_check_good db_get [llength $ret] 0 + error_check_good db_close [$xdb close] 0 + } +} + + +proc ext_recover_delete { dir env_cmd method opts dbfile op txncmd} { + global log_log_record_types + global alphabet + source ./include.tcl + + # Keep track of the log types we've seen + if { $log_log_record_types == 1} { + logtrack_read $dir + } + + env_cleanup $dir + # Open the environment and set the copy/abort locations + set env [eval $env_cmd] + + set oflags "-create $method -mode 0644 -pagesize 512 \ + -env $env $opts $dbfile" + + # + # Open our db, add some data, close and copy as our + # init file. + # + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + + set extnum 0 + set data [chop_data $method [replicate $alphabet 512]] + + set txn [$env txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + set putrecno [$db put -append $data] + error_check_good db_put $putrecno 1 + error_check_good commit [$txn commit] 0 + error_check_good db_close [$db close] 0 + + puts "\t\tExecuting command" + + set init_file $dir/$dbfile.init + catch { file copy -force $dir/$dbfile $init_file } res + copy_extent_file $dir $dbfile init + + # + # If we don't abort, then we expect success. + # If we abort, we expect no file removed until recovery is run. + # + set db [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $db] TRUE + + set t [$env txn] + error_check_good txn_begin [is_valid_txn $t $env] TRUE + + if { [string compare $op "delete"] == 0 } { + set dbcmd "$db del -txn $t $putrecno" + } else { + set dbcmd "$db get -txn $t -consume" + } + set ret [eval $dbcmd] + error_check_good db_sync [$db sync] 0 + + catch { file copy -force $dir/$dbfile $dir/$dbfile.afterop } res + copy_extent_file $dir $dbfile afterop + + error_check_good txn_$txncmd:$t [$t $txncmd] 0 + set dbq [make_ext_filename $dir $dbfile $extnum] + if {$txncmd == "abort"} { + # + # Operation was aborted, verify ext did not change. + # + puts "\t\tCommand executed and aborted." + + # + # Check that the file exists. Final state. + # Since we aborted the txn, we should be able + # to get to our original entry. + # + error_check_good post$op.1 [file exists $dbq] 1 + + set xdb [eval {berkdb_open} $oflags] + error_check_good db_open [is_valid_db $xdb] TRUE + set kd [$xdb get $putrecno] + set key [lindex [lindex $kd 0] 0] + error_check_good dbget_key $key $putrecno + set retdata [lindex [lindex $kd 0] 1] + error_check_good dbget_data $data $retdata + error_check_good db_close [$xdb close] 0 + + error_check_good \ + diff(init,post$op.2):diff($init_file,$dir/$dbfile)\ + [dbdump_diff $init_file $dir/$dbfile] 0 + } else { + # + # Operation was committed, verify it does + # not exist. + # + puts "\t\tCommand executed and committed." + # + # Check file existence. Consume operations remove + # the extent when we move off, which we should have + # done. Delete operations won't remove the extent + # until we run recovery. + # + if { [string compare $op "delete"] == 0 } { + error_check_good ${op}_exists [file exists $dbq] 1 + } else { + error_check_good ${op}_exists [file exists $dbq] 0 + } + } + error_check_good db_close [$db close] 0 + error_check_good env_close [$env close] 0 + + # + # Run recovery here on what we ended up with. Should be a no-op. + # + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery (no-op) ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + if { $txncmd == "abort"} { + # + # Operation was aborted, verify it did not change. + # + error_check_good \ + diff(initial,post-recover1):diff($init_file,$dir/$dbfile) \ + [dbdump_diff $init_file $dir/$dbfile] 0 + } else { + # + # Operation was committed, verify it does + # not exist. Both operations should result + # in no file existing now that we've run recovery. + # + error_check_good after_recover1 [file exists $dbq] 0 + } + + # + # Run recovery here. Re-do the operation. + # Verify that the file doesn't exist + # (if we committed) or change (if we aborted) + # when we are done. + # + catch { file copy -force $dir/$dbfile $init_file } res + copy_extent_file $dir $dbfile init + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery (init) ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + if { $txncmd == "abort"} { + # + # Operation was aborted, verify it did not change. + # + error_check_good \ + diff(initial,post-recover1):diff($init_file,$dir/$dbfile) \ + [dbdump_diff $init_file $dir/$dbfile] 0 + } else { + # + # Operation was committed, verify it does + # not exist. Both operations should result + # in no file existing now that we've run recovery. + # + error_check_good after_recover1 [file exists $dbq] 0 + } + + # + # Now move the .afterop file to $dbfile. Run recovery again. + # + set filecopy [glob $dir/*.afterop] + set afterop [lindex $filecopy 0] + file rename -force $afterop $dir/$dbfile + set afterop [string range $afterop \ + [expr [string last "/" $afterop] + 1] \ + [string last "." $afterop]] + move_file_extent $dir $dbfile afterop rename + + berkdb debug_check + puts -nonewline "\t\tAbout to run recovery (afterop) ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + return + } + puts "complete" + + if { $txncmd == "abort"} { + # + # Operation was aborted, verify it did not change. + # + error_check_good \ + diff(initial,post-recover2):diff($init_file,$dir/$dbfile) \ + [dbdump_diff $init_file $dir/$dbfile] 0 + } else { + # + # Operation was committed, verify it still does + # not exist. + # + error_check_good after_recover2 [file exists $dbq] 0 + } +} diff --git a/bdb/test/rpc001.tcl b/bdb/test/rpc001.tcl new file mode 100644 index 00000000000..331a18cfbf1 --- /dev/null +++ b/bdb/test/rpc001.tcl @@ -0,0 +1,444 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: rpc001.tcl,v 11.23 2001/01/02 20:04:56 sue Exp $ +# +# Test RPC specifics, primarily that unsupported functions return +# errors and such. +# +proc rpc001 { } { + global __debug_on + global __debug_print + global errorInfo + source ./include.tcl + + # + # First test timeouts on server. + # + set ttime 5 + set itime 10 + puts "Rpc001: Server timeouts: resource $ttime sec, idle $itime sec" + if { [string compare $rpc_server "localhost"] == 0 } { + set dpid [exec $util_path/berkeley_db_svc \ + -h $rpc_testdir -t $ttime -I $itime &] + } else { + set dpid [exec rsh $rpc_server $rpc_path/berkeley_db_svc \ + -h $rpc_testdir -t $ttime -I $itime&] + } + puts "\tRpc001.a: Started server, pid $dpid" + + tclsleep 2 + remote_cleanup $rpc_server $rpc_testdir $testdir + puts "\tRpc001.b: Creating environment" + + set testfile "rpc001.db" + set home [file tail $rpc_testdir] + + set env [eval {berkdb env -create -mode 0644 -home $home \ + -server $rpc_server -client_timeout 10000 -txn}] + error_check_good lock_env:open [is_valid_env $env] TRUE + + puts "\tRpc001.c: Opening a database" + # + # NOTE: the type of database doesn't matter, just use btree. + set db [eval {berkdb_open -create -btree -mode 0644} \ + -env $env $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set curs_list {} + set txn_list {} + puts "\tRpc001.d: Basic timeout test" + puts "\tRpc001.d1: Starting a transaction" + set txn [$env txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + lappend txn_list $txn + + puts "\tRpc001.d2: Open a cursor in that transaction" + set dbc [$db cursor -txn $txn] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + lappend curs_list $dbc + + puts "\tRpc001.d3: Duplicate that cursor" + set dbc [$dbc dup] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + lappend curs_list $dbc + + puts "\tRpc001.d4: Starting a nested transaction" + set txn [$env txn -parent $txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + set txn_list [linsert $txn_list 0 $txn] + + puts "\tRpc001.d5: Create a cursor, no transaction" + set dbc [$db cursor] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + lappend curs_list $dbc + + puts "\tRpc001.d6: Timeout cursor and transactions" + set sleeptime [expr $ttime + 2] + tclsleep $sleeptime + + # + # Perform a generic db operations to cause the timeout routine + # to trigger. + # + set stat [catch {$db stat} ret] + error_check_good dbstat $stat 0 + + # + # Check that every handle we opened above is timed out + # + foreach c $curs_list { + set stat [catch {$c close} ret] + error_check_good dbc_close:$c $stat 1 + error_check_good dbc_timeout:$c \ + [is_substr $errorInfo "DB_NOSERVER_ID"] 1 + } + foreach t $txn_list { + set stat [catch {$t commit} ret] + error_check_good txn_commit:$t $stat 1 + error_check_good txn_timeout:$t \ + [is_substr $errorInfo "DB_NOSERVER_ID"] 1 + } + + set txn_list {} + set ntxns 8 + puts "\tRpc001.e: Nested ($ntxns x $ntxns) transaction activity test" + puts "\tRpc001.e1: Starting parent transaction" + set txn [$env txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + set txn_list [linsert $txn_list 0 $txn] + set last_txn $txn + set parent_txn $txn + + # + # First set a breadth of 'ntxns' + # We need 2 from this set for testing later on. Just set them + # up separately first. + # + puts "\tRpc001.e2: Creating $ntxns child transactions" + set child0 [$env txn -parent $parent_txn] + error_check_good txn_begin [is_valid_txn $child0 $env] TRUE + set child1 [$env txn -parent $parent_txn] + error_check_good txn_begin [is_valid_txn $child1 $env] TRUE + + for {set i 2} {$i < $ntxns} {incr i} { + set txn [$env txn -parent $parent_txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + set txn_list [linsert $txn_list 0 $txn] + } + + # + # Now make one 'ntxns' deeply nested. + # Add one more for testing later on separately. + # + puts "\tRpc001.e3: Creating $ntxns nested child transactions" + for {set i 0} {$i < $ntxns} {incr i} { + set txn [$env txn -parent $last_txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + set txn_list [linsert $txn_list 0 $txn] + set last_txn $txn + } + set last_parent $last_txn + set last_txn [$env txn -parent $last_parent] + error_check_good txn_begin [is_valid_txn $last_txn $env] TRUE + + puts "\tRpc001.e4: Open a cursor in deepest transaction" + set dbc [$db cursor -txn $last_txn] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + puts "\tRpc001.e5: Duplicate that cursor" + set dbcdup [$dbc dup] + error_check_good db_cursor [is_valid_cursor $dbcdup $db] TRUE + lappend curs_list $dbcdup + + puts "\tRpc001.f: Timeout then activate duplicate cursor" + tclsleep $sleeptime + set stat [catch {$dbcdup close} ret] + error_check_good dup_close:$dbcdup $stat 0 + error_check_good dup_close:$dbcdup $ret 0 + + # + # Make sure that our parent txn is not timed out. We will + # try to begin another child tnx using the parent. We expect + # that to succeed. Immediately commit that txn. + # + set stat [catch {$env txn -parent $parent_txn} newchild] + error_check_good newchildtxn $stat 0 + error_check_good newcommit [$newchild commit] 0 + + puts "\tRpc001.g: Timeout, then activate cursor" + tclsleep $sleeptime + set stat [catch {$dbc close} ret] + error_check_good dbc_close:$dbc $stat 0 + error_check_good dbc_close:$dbc $ret 0 + + # + # Make sure that our parent txn is not timed out. We will + # try to begin another child tnx using the parent. We expect + # that to succeed. Immediately commit that txn. + # + set stat [catch {$env txn -parent $parent_txn} newchild] + error_check_good newchildtxn $stat 0 + error_check_good newcommit [$newchild commit] 0 + + puts "\tRpc001.h: Timeout, then activate child txn" + tclsleep $sleeptime + set stat [catch {$child0 commit} ret] + error_check_good child_commit $stat 0 + error_check_good child_commit:$child0 $ret 0 + + # + # + # Make sure that our nested txn is not timed out. We will + # try to begin another child tnx using the parent. We expect + # that to succeed. Immediately commit that txn. + # + set stat [catch {$env txn -parent $last_parent} newchild] + error_check_good newchildtxn $stat 0 + error_check_good newcommit [$newchild commit] 0 + + puts "\tRpc001.i: Timeout, then activate nested txn" + tclsleep $sleeptime + set stat [catch {$last_txn commit} ret] + error_check_good lasttxn_commit $stat 0 + error_check_good lasttxn_commit:$child0 $ret 0 + + # + # Make sure that our child txn is not timed out. We should + # be able to commit it. + # + set stat [catch {$child1 commit} ret] + error_check_good child_commit:$child1 $stat 0 + error_check_good child_commit:$child1 $ret 0 + + # + # Clean up. They were inserted in LIFO order, so we should + # just be able to commit them all. + foreach t $txn_list { + set stat [catch {$t commit} ret] + error_check_good txn_commit:$t $stat 0 + error_check_good txn_commit:$t $ret 0 + } + + set stat [catch {$db close} ret] + error_check_good db_close $stat 0 + + rpc_timeoutjoin $env "Rpc001.j" $sleeptime 0 + rpc_timeoutjoin $env "Rpc001.k" $sleeptime 1 + + # + # We need a 2nd env just to do an op to timeout the env. + # + set env1 [eval {berkdb env -create -mode 0644 -home $home \ + -server $rpc_server -client_timeout 10000 -txn}] + error_check_good lock_env:open [is_valid_env $env1] TRUE + + puts "\tRpc001.l: Timeout idle env handle" + set sleeptime [expr $itime + 2] + tclsleep $sleeptime + + set stat [catch {$env1 close} ret] + error_check_good env1_close $stat 0 + + set stat [catch {$env close} ret] + error_check_good env_close $stat 1 + error_check_good env_timeout \ + [is_substr $errorInfo "DB_NOSERVER_ID"] 1 + + exec $KILL $dpid +} + +proc rpc_timeoutjoin {env msg sleeptime use_txn} { + # + # Check join cursors now. + # + puts -nonewline "\t$msg: Test join cursors and timeouts" + if { $use_txn } { + puts " (using txns)" + } else { + puts " (without txns)" + } + # + # Set up a simple set of join databases + # + puts "\t${msg}0: Set up join databases" + set fruit { + {blue blueberry} + {red apple} {red cherry} {red raspberry} + {yellow lemon} {yellow pear} + } + set price { + {expen blueberry} {expen cherry} {expen raspberry} + {inexp apple} {inexp lemon} {inexp pear} + } + set dessert { + {blueberry cobbler} {cherry cobbler} {pear cobbler} + {apple pie} {raspberry pie} {lemon pie} + } + set fdb [eval {berkdb_open -create -btree -mode 0644} \ + -env $env -dup fruit.db] + error_check_good dbopen [is_valid_db $fdb] TRUE + set pdb [eval {berkdb_open -create -btree -mode 0644} \ + -env $env -dup price.db] + error_check_good dbopen [is_valid_db $pdb] TRUE + set ddb [eval {berkdb_open -create -btree -mode 0644} \ + -env $env -dup dessert.db] + error_check_good dbopen [is_valid_db $ddb] TRUE + foreach kd $fruit { + set k [lindex $kd 0] + set d [lindex $kd 1] + set ret [$fdb put $k $d] + error_check_good fruit_put $ret 0 + } + error_check_good sync [$fdb sync] 0 + foreach kd $price { + set k [lindex $kd 0] + set d [lindex $kd 1] + set ret [$pdb put $k $d] + error_check_good price_put $ret 0 + } + error_check_good sync [$pdb sync] 0 + foreach kd $dessert { + set k [lindex $kd 0] + set d [lindex $kd 1] + set ret [$ddb put $k $d] + error_check_good dessert_put $ret 0 + } + error_check_good sync [$ddb sync] 0 + + rpc_join $env $msg $sleeptime $fdb $pdb $ddb $use_txn 0 + rpc_join $env $msg $sleeptime $fdb $pdb $ddb $use_txn 1 + + error_check_good ddb:close [$ddb close] 0 + error_check_good pdb:close [$pdb close] 0 + error_check_good fdb:close [$fdb close] 0 +} + +proc rpc_join {env msg sleep fdb pdb ddb use_txn op} { + global errorInfo + + # + # Start a parent and child transaction. We'll do our join in + # the child transaction just to make sure everything gets timed + # out correctly. + # + set curs_list {} + set txn_list {} + set msgnum [expr $op * 2 + 1] + if { $use_txn } { + puts "\t$msg$msgnum: Set up txns and join cursor" + set txn [$env txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + set txn_list [linsert $txn_list 0 $txn] + set child0 [$env txn -parent $txn] + error_check_good txn_begin [is_valid_txn $child0 $env] TRUE + set txn_list [linsert $txn_list 0 $child0] + set child1 [$env txn -parent $txn] + error_check_good txn_begin [is_valid_txn $child1 $env] TRUE + set txn_list [linsert $txn_list 0 $child1] + set txncmd "-txn $child0" + } else { + puts "\t$msg$msgnum: Set up join cursor" + set txncmd "" + } + + # + # Start a cursor, (using txn child0 in the fruit and price dbs, if + # needed). # Just pick something simple to join on. + # Then call join on the dessert db. + # + set fkey yellow + set pkey inexp + set fdbc [eval $fdb cursor $txncmd] + error_check_good fdb_cursor [is_valid_cursor $fdbc $fdb] TRUE + set ret [$fdbc get -set $fkey] + error_check_bad fget:set [llength $ret] 0 + set k [lindex [lindex $ret 0] 0] + error_check_good fget:set:key $k $fkey + set curs_list [linsert $curs_list 0 $fdbc] + + set pdbc [eval $pdb cursor $txncmd] + error_check_good pdb_cursor [is_valid_cursor $pdbc $pdb] TRUE + set ret [$pdbc get -set $pkey] + error_check_bad pget:set [llength $ret] 0 + set k [lindex [lindex $ret 0] 0] + error_check_good pget:set:key $k $pkey + set curs_list [linsert $curs_list 0 $pdbc] + + set jdbc [$ddb join $fdbc $pdbc] + error_check_good join_cursor [is_valid_cursor $jdbc $ddb] TRUE + set ret [$jdbc get] + error_check_bad jget [llength $ret] 0 + + set msgnum [expr $op * 2 + 2] + if { $op == 1 } { + puts -nonewline "\t$msg$msgnum: Timeout all cursors" + if { $use_txn } { + puts " and txns" + } else { + puts "" + } + } else { + puts "\t$msg$msgnum: Timeout, then activate join cursor" + } + + tclsleep $sleep + + if { $op == 1 } { + # + # Perform a generic db operations to cause the timeout routine + # to trigger. + # + set stat [catch {$fdb stat} ret] + error_check_good fdbstat $stat 0 + + # + # Check that join cursor is timed out. + # + set stat [catch {$jdbc close} ret] + error_check_good dbc_close:$jdbc $stat 1 + error_check_good dbc_timeout:$jdbc \ + [is_substr $errorInfo "DB_NOSERVER_ID"] 1 + + # + # Now the server may or may not timeout constituent + # cursors when it times out the join cursor. So, just + # sleep again and then they should timeout. + # + tclsleep $sleep + set stat [catch {$fdb stat} ret] + error_check_good fdbstat $stat 0 + + foreach c $curs_list { + set stat [catch {$c close} ret] + error_check_good dbc_close:$c $stat 1 + error_check_good dbc_timeout:$c \ + [is_substr $errorInfo "DB_NOSERVER_ID"] 1 + } + + foreach t $txn_list { + set stat [catch {$t commit} ret] + error_check_good txn_commit:$t $stat 1 + error_check_good txn_timeout:$t \ + [is_substr $errorInfo "DB_NOSERVER_ID"] 1 + } + } else { + set stat [catch {$jdbc get} ret] + error_check_good jget.stat $stat 0 + error_check_bad jget [llength $ret] 0 + set curs_list [linsert $curs_list 0 $jdbc] + foreach c $curs_list { + set stat [catch {$c close} ret] + error_check_good dbc_close:$c $stat 0 + error_check_good dbc_close:$c $ret 0 + } + + foreach t $txn_list { + set stat [catch {$t commit} ret] + error_check_good txn_commit:$t $stat 0 + error_check_good txn_commit:$t $ret 0 + } + } +} diff --git a/bdb/test/rpc002.tcl b/bdb/test/rpc002.tcl new file mode 100644 index 00000000000..6b11914c2eb --- /dev/null +++ b/bdb/test/rpc002.tcl @@ -0,0 +1,144 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: rpc002.tcl,v 1.7 2000/10/27 13:23:56 sue Exp $ +# +# RPC Test 2 +# Test invalid RPC functions and make sure we error them correctly +proc rpc002 { } { + global __debug_on + global __debug_print + global errorInfo + source ./include.tcl + + set testfile "rpc002.db" + set home [file tail $rpc_testdir] + # + # First start the server. + # + puts "Rpc002: Unsupported interface test" + if { [string compare $rpc_server "localhost"] == 0 } { + set dpid [exec $util_path/berkeley_db_svc -h $rpc_testdir &] + } else { + set dpid [exec rsh $rpc_server $rpc_path/berkeley_db_svc \ + -h $rpc_testdir &] + } + puts "\tRpc002.a: Started server, pid $dpid" + tclsleep 2 + remote_cleanup $rpc_server $rpc_testdir $testdir + + puts "\tRpc002.b: Unsupported env options" + # + # Test each "pre-open" option for env's. These need to be + # tested on the 'berkdb env' line. + # + set rlist { + { "-data_dir $rpc_testdir" "Rpc002.b0"} + { "-log_buffer 512" "Rpc002.b1"} + { "-log_dir $rpc_testdir" "Rpc002.b2"} + { "-log_max 100" "Rpc002.b3"} + { "-lock_conflict {3 {0 0 0 0 0 1 0 1 1}}" "Rpc002.b4"} + { "-lock_detect default" "Rpc002.b5"} + { "-lock_max 100" "Rpc002.b6"} + { "-mmapsize 100" "Rpc002.b7"} + { "-shm_key 100" "Rpc002.b9"} + { "-tmp_dir $rpc_testdir" "Rpc002.b10"} + { "-txn_max 100" "Rpc002.b11"} + { "-txn_timestamp 100" "Rpc002.b12"} + { "-verbose {recovery on}" "Rpc002.b13"} + } + + set e "berkdb env -create -mode 0644 -home $home -server $rpc_server \ + -client_timeout 10000 -txn" + foreach pair $rlist { + set cmd [lindex $pair 0] + set msg [lindex $pair 1] + puts "\t$msg: $cmd" + + set stat [catch {eval $e $cmd} ret] + error_check_good $cmd $stat 1 + error_check_good $cmd.err \ + [is_substr $errorInfo "meaningless in RPC env"] 1 + } + + # + # Open an env with all the subsystems (-txn implies all + # the rest) + # + puts "\tRpc002.c: Unsupported env related interfaces" + set env [eval {berkdb env -create -mode 0644 -home $home \ + -server $rpc_server -client_timeout 10000 -txn}] + error_check_good envopen [is_valid_env $env] TRUE + set dbcmd "berkdb_open_noerr -create -btree -mode 0644 -env $env \ + $testfile" + set db [eval $dbcmd] + error_check_good dbopen [is_valid_db $db] TRUE + + # + # Test each "post-open" option relating to envs, txns, locks, + # logs and mpools. + # + set rlist { + { " lock_detect default" "Rpc002.c0"} + { " lock_get read 1 $env" "Rpc002.c1"} + { " lock_id" "Rpc002.c2"} + { " lock_stat" "Rpc002.c3"} + { " lock_vec 1 {get $env read}" "Rpc002.c4"} + { " log_archive" "Rpc002.c5"} + { " log_file {0 0}" "Rpc002.c6"} + { " log_flush" "Rpc002.c7"} + { " log_get -current" "Rpc002.c8"} + { " log_register $db $testfile" "Rpc002.c9"} + { " log_stat" "Rpc002.c10"} + { " log_unregister $db" "Rpc002.c11"} + { " mpool -create -pagesize 512" "Rpc002.c12"} + { " mpool_stat" "Rpc002.c13"} + { " mpool_sync {0 0}" "Rpc002.c14"} + { " mpool_trickle 50" "Rpc002.c15"} + { " txn_checkpoint -min 1" "Rpc002.c16"} + { " txn_stat" "Rpc002.c17"} + } + + foreach pair $rlist { + set cmd [lindex $pair 0] + set msg [lindex $pair 1] + puts "\t$msg: $cmd" + + set stat [catch {eval $env $cmd} ret] + error_check_good $cmd $stat 1 + error_check_good $cmd.err \ + [is_substr $errorInfo "meaningless in RPC env"] 1 + } + error_check_good dbclose [$db close] 0 + + # + # The database operations that aren't supported are few + # because mostly they are the ones Tcl doesn't support + # either so we have no way to get at them. Test what we can. + # + puts "\tRpc002.d: Unsupported database related interfaces" + # + # NOTE: the type of database doesn't matter, just use btree. + # + puts "\tRpc002.d0: -cachesize" + set dbcmd "berkdb_open_noerr -create -btree -mode 0644 -env $env \ + -cachesize {0 65536 0} $testfile" + set stat [catch {eval $dbcmd} ret] + error_check_good dbopen_cache $stat 1 + error_check_good dbopen_cache_err \ + [is_substr $errorInfo "meaningless in RPC env"] 1 + + puts "\tRpc002.d1: Try to upgrade a database" + # + # NOTE: the type of database doesn't matter, just use btree. + set stat [catch {eval {berkdb upgrade -env} $env $testfile} ret] + error_check_good dbupgrade $stat 1 + error_check_good dbupgrade_err \ + [is_substr $errorInfo "meaningless in RPC env"] 1 + + error_check_good envclose [$env close] 0 + + exec $KILL $dpid +} diff --git a/bdb/test/rsrc001.tcl b/bdb/test/rsrc001.tcl new file mode 100644 index 00000000000..6d76044f454 --- /dev/null +++ b/bdb/test/rsrc001.tcl @@ -0,0 +1,223 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: rsrc001.tcl,v 11.18 2001/01/18 06:41:03 krinsky Exp $ +# +# Recno backing file test. +# Try different patterns of adding records and making sure that the +# corresponding file matches +proc rsrc001 { } { + source ./include.tcl + + puts "Rsrc001: Basic recno backing file writeback tests" + + # We run this test essentially twice, once with a db file + # and once without (an in-memory database). + set rec1 "This is record 1" + set rec2 "This is record 2 This is record 2" + set rec3 "This is record 3 This is record 3 This is record 3" + set rec4 [replicate "This is record 4 " 512] + + foreach testfile { "$testdir/rsrc001.db" "" } { + + cleanup $testdir NULL + + if { $testfile == "" } { + puts "Rsrc001: Testing with in-memory database." + } else { + puts "Rsrc001: Testing with disk-backed database." + } + + # Create backing file for the empty-file test. + set oid1 [open $testdir/rsrc.txt w] + close $oid1 + + puts "\tRsrc001.a: Put to empty file." + set db [eval {berkdb_open -create -mode 0644\ + -recno -source $testdir/rsrc.txt} $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + set txn "" + + set ret [eval {$db put} $txn {1 $rec1}] + error_check_good put_to_empty $ret 0 + error_check_good db_close [$db close] 0 + + # Now fill out the backing file and create the check file. + set oid1 [open $testdir/rsrc.txt a] + set oid2 [open $testdir/check.txt w] + + # This one was already put into rsrc.txt. + puts $oid2 $rec1 + + # These weren't. + puts $oid1 $rec2 + puts $oid2 $rec2 + puts $oid1 $rec3 + puts $oid2 $rec3 + puts $oid1 $rec4 + puts $oid2 $rec4 + close $oid1 + close $oid2 + + puts -nonewline "\tRsrc001.b: Read file, rewrite last record;" + puts " write it out and diff" + set db [eval {berkdb_open -create -mode 0644\ + -recno -source $testdir/rsrc.txt} $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Read the last record; replace it (but we won't change it). + # Then close the file and diff the two files. + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + set rec [$dbc get -last] + error_check_good get_last [llength [lindex $rec 0]] 2 + set key [lindex [lindex $rec 0] 0] + set data [lindex [lindex $rec 0] 1] + + # Get the last record from the text file + set oid [open $testdir/rsrc.txt] + set laststr "" + while { [gets $oid str] != -1 } { + set laststr $str + } + close $oid + set data [sanitize_record $data] + error_check_good getlast $data $laststr + + set ret [eval {$db put} $txn {$key $data}] + error_check_good replace_last $ret 0 + + error_check_good curs_close [$dbc close] 0 + error_check_good db_sync [$db sync] 0 + error_check_good db_sync [$db sync] 0 + error_check_good \ + Rsrc001:diff($testdir/rsrc.txt,$testdir/check.txt) \ + [filecmp $testdir/rsrc.txt $testdir/check.txt] 0 + + puts -nonewline "\tRsrc001.c: " + puts "Append some records in tree and verify in file." + set oid [open $testdir/check.txt a] + for {set i 1} {$i < 10} {incr i} { + set rec [replicate "New Record $i" $i] + puts $oid $rec + incr key + set ret [eval {$db put} $txn {-append $rec}] + error_check_good put_append $ret $key + } + error_check_good db_sync [$db sync] 0 + error_check_good db_sync [$db sync] 0 + close $oid + set ret [filecmp $testdir/rsrc.txt $testdir/check.txt] + error_check_good \ + Rsrc001:diff($testdir/{rsrc.txt,check.txt}) $ret 0 + + puts "\tRsrc001.d: Append by record number" + set oid [open $testdir/check.txt a] + for {set i 1} {$i < 10} {incr i} { + set rec [replicate "New Record (set 2) $i" $i] + puts $oid $rec + incr key + set ret [eval {$db put} $txn {$key $rec}] + error_check_good put_byno $ret 0 + } + + error_check_good db_sync [$db sync] 0 + error_check_good db_sync [$db sync] 0 + close $oid + set ret [filecmp $testdir/rsrc.txt $testdir/check.txt] + error_check_good \ + Rsrc001:diff($testdir/{rsrc.txt,check.txt}) $ret 0 + + puts "\tRsrc001.e: Put beyond end of file." + set oid [open $testdir/check.txt a] + for {set i 1} {$i < 10} {incr i} { + puts $oid "" + incr key + } + set rec "Last Record" + puts $oid $rec + incr key + + set ret [eval {$db put} $txn {$key $rec}] + error_check_good put_byno $ret 0 + + puts "\tRsrc001.f: Put beyond end of file, after reopen." + + error_check_good db_close [$db close] 0 + set db [eval {berkdb_open -create -mode 0644\ + -recno -source $testdir/rsrc.txt} $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set rec "Last record with reopen" + puts $oid $rec + + incr key + set ret [eval {$db put} $txn {$key $rec}] + error_check_good put_byno_with_reopen $ret 0 + + puts "\tRsrc001.g:\ + Put several beyond end of file, after reopen." + error_check_good db_close [$db close] 0 + set db [eval {berkdb_open -create -mode 0644\ + -recno -source $testdir/rsrc.txt} $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set rec "Really really last record with reopen" + puts $oid "" + puts $oid "" + puts $oid "" + puts $oid $rec + + incr key + incr key + incr key + incr key + + set ret [eval {$db put} $txn {$key $rec}] + error_check_good put_byno_with_reopen $ret 0 + + + + error_check_good db_sync [$db sync] 0 + error_check_good db_sync [$db sync] 0 + + close $oid + set ret [filecmp $testdir/rsrc.txt $testdir/check.txt] + error_check_good \ + Rsrc001:diff($testdir/{rsrc.txt,check.txt}) $ret 0 + + puts "\tRsrc001.h: Verify proper syncing of changes on close." + error_check_good Rsrc001:db_close [$db close] 0 + set db [eval {berkdb_open -create -mode 0644 -recno \ + -source $testdir/rsrc.txt} $testfile] + set oid [open $testdir/check.txt a] + for {set i 1} {$i < 10} {incr i} { + set rec [replicate "New Record $i" $i] + puts $oid $rec + set ret [eval {$db put} $txn {-append $rec}] + # Don't bother checking return; we don't know what + # the key number is, and we'll pick up a failure + # when we compare. + } + error_check_good Rsrc001:db_close [$db close] 0 + close $oid + set ret [filecmp $testdir/rsrc.txt $testdir/check.txt] + error_check_good Rsrc001:diff($testdir/{rsrc,check}.txt) $ret 0 + } +} + +# Strip CRs from a record. +# Needed on Windows when a file is created as text (with CR/LF) +# but read as binary (where CR is read as a separate character) +proc sanitize_record { rec } { + source ./include.tcl + + if { $is_windows_test != 1 } { + return $rec + } + regsub -all \15 $rec "" data + return $data +} diff --git a/bdb/test/rsrc002.tcl b/bdb/test/rsrc002.tcl new file mode 100644 index 00000000000..d3b45c9a7f3 --- /dev/null +++ b/bdb/test/rsrc002.tcl @@ -0,0 +1,65 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: rsrc002.tcl,v 11.11 2000/11/29 15:01:06 sue Exp $ +# +# Recno backing file test #2: test of set_re_delim. +# Specify a backing file with colon-delimited records, +# and make sure they are correctly interpreted. +proc rsrc002 { } { + source ./include.tcl + + puts "Rsrc002: Alternate variable-length record delimiters." + + # We run this test essentially twice, once with a db file + # and once without (an in-memory database). + foreach testfile { "$testdir/rsrc002.db" "" } { + + cleanup $testdir NULL + + # Create the starting files + set oid1 [open $testdir/rsrc.txt w] + set oid2 [open $testdir/check.txt w] + puts -nonewline $oid1 "ostrich:emu:kiwi:moa:cassowary:rhea:" + puts -nonewline $oid2 "ostrich:emu:kiwi:penguin:cassowary:rhea:" + close $oid1 + close $oid2 + + if { $testfile == "" } { + puts "Rsrc002: Testing with in-memory database." + } else { + puts "Rsrc002: Testing with disk-backed database." + } + + puts "\tRsrc002.a: Read file, verify correctness." + set db [eval {berkdb_open -create -mode 0644 -delim 58 \ + -recno -source $testdir/rsrc.txt} $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Read the last record; replace it (but we won't change it). + # Then close the file and diff the two files. + set txn "" + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + set rec [$dbc get -first] + error_check_good get_first $rec [list [list 1 "ostrich"]] + set rec [$dbc get -next] + error_check_good get_next $rec [list [list 2 "emu"]] + + puts "\tRsrc002.b: Write record, verify correctness." + + eval {$dbc get -set 4} + set ret [$dbc put -current "penguin"] + error_check_good dbc_put $ret 0 + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + error_check_good \ + Rsrc002:diff($testdir/rsrc.txt,$testdir/check.txt) \ + [filecmp $testdir/rsrc.txt $testdir/check.txt] 0 + } +} diff --git a/bdb/test/rsrc003.tcl b/bdb/test/rsrc003.tcl new file mode 100644 index 00000000000..c93b3bbde12 --- /dev/null +++ b/bdb/test/rsrc003.tcl @@ -0,0 +1,174 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: rsrc003.tcl,v 11.1 2000/11/29 18:28:49 sue Exp $ +# +# Recno backing file test. +# Try different patterns of adding records and making sure that the +# corresponding file matches +proc rsrc003 { } { + source ./include.tcl + global fixed_len + + puts "Rsrc003: Basic recno backing file writeback tests fixed length" + + # We run this test essentially twice, once with a db file + # and once without (an in-memory database). + # + # Then run with big fixed-length records + set rec1 "This is record 1" + set rec2 "This is record 2" + set rec3 "This is record 3" + set bigrec1 [replicate "This is record 1 " 512] + set bigrec2 [replicate "This is record 2 " 512] + set bigrec3 [replicate "This is record 3 " 512] + + set orig_fixed_len $fixed_len + set rlist { + {{$rec1 $rec2 $rec3} "small records" } + {{$bigrec1 $bigrec2 $bigrec3} "large records" }} + + foreach testfile { "$testdir/rsrc003.db" "" } { + + foreach rec $rlist { + cleanup $testdir NULL + + set recs [lindex $rec 0] + set msg [lindex $rec 1] + # Create the starting files + # Note that for the rest of the test, we are going + # to append a LF when we 'put' via DB to maintain + # file structure and allow us to use 'gets'. + set oid1 [open $testdir/rsrc.txt w] + set oid2 [open $testdir/check.txt w] + foreach record $recs { + set r [subst $record] + set fixed_len [string length $r] + puts $oid1 $r + puts $oid2 $r + } + close $oid1 + close $oid2 + + set reclen [expr $fixed_len + 1] + if { $reclen > [string length $rec1] } { + set repl 512 + } else { + set repl 2 + } + if { $testfile == "" } { + puts \ +"Rsrc003: Testing with in-memory database with $msg." + } else { + puts \ +"Rsrc003: Testing with disk-backed database with $msg." + } + + puts -nonewline \ + "\tRsrc003.a: Read file, rewrite last record;" + puts " write it out and diff" + set db [eval {berkdb_open -create -mode 0644 -recno \ + -len $reclen -source $testdir/rsrc.txt} $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Read the last record; replace it (don't change it). + # Then close the file and diff the two files. + set txn "" + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor \ + [is_valid_cursor $dbc $db] TRUE + + set rec [$dbc get -last] + error_check_good get_last [llength [lindex $rec 0]] 2 + set key [lindex [lindex $rec 0] 0] + set data [lindex [lindex $rec 0] 1] + + # Get the last record from the text file + set oid [open $testdir/rsrc.txt] + set laststr "" + while { [gets $oid str] != -1 } { + append str \12 + set laststr $str + } + close $oid + set data [sanitize_record $data] + error_check_good getlast $data $laststr + + set ret [eval {$db put} $txn {$key $data}] + error_check_good replace_last $ret 0 + + error_check_good curs_close [$dbc close] 0 + error_check_good db_sync [$db sync] 0 + error_check_good db_sync [$db sync] 0 + error_check_good \ + diff1($testdir/rsrc.txt,$testdir/check.txt) \ + [filecmp $testdir/rsrc.txt $testdir/check.txt] 0 + + puts -nonewline "\tRsrc003.b: " + puts "Append some records in tree and verify in file." + set oid [open $testdir/check.txt a] + for {set i 1} {$i < 10} {incr i} { + set rec [chop_data -frecno [replicate \ + "This is New Record $i" $repl]] + puts $oid $rec + append rec \12 + incr key + set ret [eval {$db put} $txn {-append $rec}] + error_check_good put_append $ret $key + } + error_check_good db_sync [$db sync] 0 + error_check_good db_sync [$db sync] 0 + close $oid + set ret [filecmp $testdir/rsrc.txt $testdir/check.txt] + error_check_good \ + diff2($testdir/{rsrc.txt,check.txt}) $ret 0 + + puts "\tRsrc003.c: Append by record number" + set oid [open $testdir/check.txt a] + for {set i 1} {$i < 10} {incr i} { + set rec [chop_data -frecno [replicate \ + "New Record (set 2) $i" $repl]] + puts $oid $rec + append rec \12 + incr key + set ret [eval {$db put} $txn {$key $rec}] + error_check_good put_byno $ret 0 + } + + error_check_good db_sync [$db sync] 0 + error_check_good db_sync [$db sync] 0 + close $oid + set ret [filecmp $testdir/rsrc.txt $testdir/check.txt] + error_check_good \ + diff3($testdir/{rsrc.txt,check.txt}) $ret 0 + + puts \ +"\tRsrc003.d: Verify proper syncing of changes on close." + error_check_good Rsrc003:db_close [$db close] 0 + set db [eval {berkdb_open -create -mode 0644 -recno \ + -len $reclen -source $testdir/rsrc.txt} $testfile] + set oid [open $testdir/check.txt a] + for {set i 1} {$i < 10} {incr i} { + set rec [chop_data -frecno [replicate \ + "New Record (set 3) $i" $repl]] + puts $oid $rec + append rec \12 + set ret [eval {$db put} $txn {-append $rec}] + # Don't bother checking return; + # we don't know what + # the key number is, and we'll pick up a failure + # when we compare. + } + error_check_good Rsrc003:db_close [$db close] 0 + close $oid + set ret [filecmp $testdir/rsrc.txt $testdir/check.txt] + error_check_good \ + diff5($testdir/{rsrc,check}.txt) $ret 0 + } + } + set fixed_len $orig_fixed_len + return +} + diff --git a/bdb/test/sdb001.tcl b/bdb/test/sdb001.tcl new file mode 100644 index 00000000000..938b6c10c6d --- /dev/null +++ b/bdb/test/sdb001.tcl @@ -0,0 +1,123 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb001.tcl,v 11.12 2000/08/25 14:21:52 sue Exp $ +# +# Sub DB Test 1 {access method} +# Test non-subdb and subdb operations +# Test naming (filenames begin with -) +# Test existence (cannot create subdb of same name with -excl) +proc subdb001 { method args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Subdb001: $method ($args) subdb and non-subdb tests" + + # Create the database and open the dictionary + set testfile $testdir/subdb001.db + set subdb subdb0 + cleanup $testdir NULL + puts "\tSubdb001.a: Non-subdb database and subdb operations" + # + # Create a db with no subdbs. Add some data. Close. Try to + # open/add with a subdb. Should fail. + # + puts "\tSubdb001.a.0: Create db, add data, close, try subdb" + set db [eval {berkdb_open -create -truncate -mode 0644} \ + $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + while { [gets $did str] != -1 && $count < 5 } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) $str + } else { + set key $str + } + set ret [eval \ + {$db put} $txn $pflags {$key [chop_data $method $str]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $str]]] + incr count + } + close $did + error_check_good db_close [$db close] 0 + set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \ + {$omethod $testfile $subdb}} db] + error_check_bad dbopen $ret 0 + # + # Create a db with no subdbs. Add no data. Close. Try to + # open/add with a subdb. Should fail. + # + set testfile $testdir/subdb001a.db + puts "\tSubdb001.a.1: Create db, close, try subdb" + set db [eval {berkdb_open -create -truncate -mode 0644} $args \ + {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + error_check_good db_close [$db close] 0 + + set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \ + {$omethod $testfile $subdb}} db] + error_check_bad dbopen $ret 0 + + if { [is_queue $method] == 1 } { + puts "Subdb001: skipping remainder of test for method $method" + return + } + + # + # Test naming, db and subdb names beginning with -. + # + puts "\tSubdb001.b: Naming" + set cwd [pwd] + cd $testdir + set testfile1 -subdb001.db + set subdb -subdb + puts "\tSubdb001.b.0: Create db and subdb with -name, no --" + set ret [catch {eval {berkdb_open -create -mode 0644} $args \ + {$omethod $testfile1 $subdb}} db] + error_check_bad dbopen $ret 0 + puts "\tSubdb001.b.1: Create db and subdb with -name, with --" + set db [eval {berkdb_open -create -mode 0644} $args \ + {$omethod -- $testfile1 $subdb}] + error_check_good dbopen [is_valid_db $db] TRUE + error_check_good db_close [$db close] 0 + + cd $cwd + + # + # Create 1 db with 1 subdb. Try to create another subdb of + # the same name. Should fail. + # + puts "\tSubdb001.c: Existence check" + set testfile $testdir/subdb001c.db + set subdb subdb + set ret [catch {eval {berkdb_open -create -excl -mode 0644} $args \ + {$omethod $testfile $subdb}} db] + error_check_good dbopen [is_valid_db $db] TRUE + set ret [catch {eval {berkdb_open_noerr -create -excl -mode 0644} \ + $args {$omethod $testfile $subdb}} db1] + error_check_bad dbopen $ret 0 + error_check_good db_close [$db close] 0 + + return +} diff --git a/bdb/test/sdb002.tcl b/bdb/test/sdb002.tcl new file mode 100644 index 00000000000..11547195c02 --- /dev/null +++ b/bdb/test/sdb002.tcl @@ -0,0 +1,167 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb002.tcl,v 11.20 2000/09/20 13:22:04 sue Exp $ +# +# Sub DB Test 2 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Close file, reopen, do retrieve and re-verify. +# Then repeat using an environment. +proc subdb002 { method {nentries 10000} args } { + source ./include.tcl + + set largs [convert_args $method $args] + set omethod [convert_method $method] + + env_cleanup $testdir + + puts "Subdb002: $method ($largs) basic subdb tests" + set testfile $testdir/subdb002.db + subdb002_body $method $omethod $nentries $largs $testfile NULL + + cleanup $testdir NULL + set env [berkdb env -create -mode 0644 -txn -home $testdir] + error_check_good env_open [is_valid_env $env] TRUE + puts "Subdb002: $method ($largs) basic subdb tests in an environment" + + # We're in an env--use default path to database rather than specifying + # it explicitly. + set testfile subdb002.db + subdb002_body $method $omethod $nentries $largs $testfile $env + error_check_good env_close [$env close] 0 +} + +proc subdb002_body { method omethod nentries largs testfile env } { + source ./include.tcl + + # Create the database and open the dictionary + set subdb subdb0 + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + + if { [is_queue $omethod] == 1 } { + set sdb002_open berkdb_open_noerr + } else { + set sdb002_open berkdb_open + } + + if { $env == "NULL" } { + set ret [catch {eval {$sdb002_open -create -mode 0644} $largs \ + {$omethod $testfile $subdb}} db] + } else { + set ret [catch {eval {$sdb002_open -create -mode 0644} $largs \ + {-env $env $omethod $testfile $subdb}} db] + } + + # + # If -queue method, we need to make sure that trying to + # create a subdb fails. + if { [is_queue $method] == 1 } { + error_check_bad dbopen $ret 0 + puts "Subdb002: skipping remainder of test for method $method" + return + } + + error_check_good dbopen $ret 0 + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + set checkfunc subdb002_recno.check + append gflags " -recno" + } else { + set checkfunc subdb002.check + } + puts "\tSubdb002.a: put/get loop" + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) [pad_data $method $str] + } else { + set key $str + } + set ret [eval \ + {$db put} $txn $pflags {$key [chop_data $method $str]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $str]]] + incr count + } + close $did + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tSubdb002.b: dump file" + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {set i [incr i]} { + puts $oid $i + } + close $oid + file rename -force $t1 $t3 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good Subdb002:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tSubdb002.c: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_subfile $testfile $env $txn $t1 $checkfunc \ + dump_file_direction "-first" "-next" $subdb + if { [is_record_based $method] != 1 } { + filesort $t1 $t3 + } + + error_check_good Subdb002:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tSubdb002.d: close, open, and dump file in reverse direction" + open_and_dump_subfile $testfile $env $txn $t1 $checkfunc \ + dump_file_direction "-last" "-prev" $subdb + + if { [is_record_based $method] != 1 } { + filesort $t1 $t3 + } + + error_check_good Subdb002:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 +} + +# Check function for Subdb002; keys and data are identical +proc subdb002.check { key data } { + error_check_good "key/data mismatch" $data $key +} + +proc subdb002_recno.check { key data } { + global dict + global kvals + + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "key/data mismatch, key $key" $data $kvals($key) +} diff --git a/bdb/test/sdb003.tcl b/bdb/test/sdb003.tcl new file mode 100644 index 00000000000..32bb93d5236 --- /dev/null +++ b/bdb/test/sdb003.tcl @@ -0,0 +1,137 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb003.tcl,v 11.17 2000/08/25 14:21:52 sue Exp $ +# +# Sub DB Test 3 {access method} +# Use the first 10,000 entries from the dictionary as subdbnames. +# Insert each with entry as name of subdatabase and a partial list as key/data. +# After all are entered, retrieve all; compare output to original. +# Close file, reopen, do retrieve and re-verify. +proc subdb003 { method {nentries 1000} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_queue $method] == 1 } { + puts "Subdb003: skipping for method $method" + return + } + + puts "Subdb003: $method ($args) many subdb tests" + + # Create the database and open the dictionary + set testfile $testdir/subdb003.db + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir NULL + + set pflags "" + set gflags "" + set txn "" + set fcount 0 + + if { [is_record_based $method] == 1 } { + set checkfunc subdb003_recno.check + append gflags " -recno" + } else { + set checkfunc subdb003.check + } + + # Here is the loop where we put and get each key/data pair + set ndataent 10 + set fdid [open $dict] + while { [gets $fdid str] != -1 && $fcount < $nentries } { + set subdb $str + set db [eval {berkdb_open -create -mode 0644} \ + $args {$omethod $testfile $subdb}] + error_check_good dbopen [is_valid_db $db] TRUE + + set count 0 + set did [open $dict] + while { [gets $did str] != -1 && $count < $ndataent } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) [pad_data $method $str] + } else { + set key $str + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $str]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags {$key}] + error_check_good get $ret [list [list $key [pad_data $method $str]]] + incr count + } + close $did + incr fcount + + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $ndataent} {set i [incr i]} { + puts $oid $i + } + close $oid + file rename -force $t1 $t3 + } else { + set q q + filehead $ndataent $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good Subdb003:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again. + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-first" "-next" $subdb + if { [is_record_based $method] != 1 } { + filesort $t1 $t3 + } + + error_check_good Subdb003:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-last" "-prev" $subdb + + if { [is_record_based $method] != 1 } { + filesort $t1 $t3 + } + + error_check_good Subdb003:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + if { [expr $fcount % 100] == 0 } { + puts -nonewline "$fcount " + flush stdout + } + } + puts "" +} + +# Check function for Subdb003; keys and data are identical +proc subdb003.check { key data } { + error_check_good "key/data mismatch" $data $key +} + +proc subdb003_recno.check { key data } { + global dict + global kvals + + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "key/data mismatch, key $key" $data $kvals($key) +} diff --git a/bdb/test/sdb004.tcl b/bdb/test/sdb004.tcl new file mode 100644 index 00000000000..fb63f9d6d1d --- /dev/null +++ b/bdb/test/sdb004.tcl @@ -0,0 +1,179 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb004.tcl,v 11.14 2000/08/25 14:21:53 sue 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. +proc subdb004 { method 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 "Subdb004: skipping for method $method" + return + } + + puts "Subdb004: $method ($args) \ + filecontents=subdbname filename=key filecontents=data pairs" + + # 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 + set pflags "" + set gflags "" + set txn "" + if { [is_record_based $method] == 1 } { + set checkfunc subdb004_recno.check + append gflags "-recno" + } else { + set checkfunc subdb004.check + } + + # 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] + set fcount [llength $file_list] + + set count 0 + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $fcount} {set i [incr i]} { + puts $oid $i + } + close $oid + } else { + set oid [open $t2.tmp w] + foreach f $file_list { + puts $oid $f + } + close $oid + filesort $t2.tmp $t2 + } + puts "\tSubdb004.a: Set/Check each subdb" + foreach f $file_list { + 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 data [read $fid] + set subdb $data + close $fid + set db [eval {berkdb_open -create -mode 0644} \ + $args {$omethod $testfile $subdb}] + error_check_good dbopen [is_valid_db $db] TRUE + set ret [eval \ + {$db put} $txn $pflags {$key [chop_data $method $data]}] + error_check_good put $ret 0 + + # Should really catch errors + set fid [open $t4 w] + fconfigure $fid -translation binary + if [catch {eval {$db get} $gflags {$key}} data] { + puts -nonewline $fid $data + } else { + # Data looks like {{key data}} + set key [lindex [lindex $data 0] 0] + set data [lindex [lindex $data 0] 1] + puts -nonewline $fid $data + } + close $fid + + error_check_good Subdb004:diff($f,$t4) \ + [filecmp $f $t4] 0 + + incr count + + # Now we will get each key from the DB and compare the results + # to the original. + # puts "\tSubdb004.b: dump file" + dump_bin_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + } + + # + # Now for each file, check that the subdb name is the same + # 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] + error_check_good dbopen [is_valid_db $db] TRUE + 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] + 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] + puts -nonewline $ofid $subdbname + close $ofid + + # Output the data + set subc [eval {$subdb cursor} $txn] + error_check_good db_cursor [is_valid_cursor $subc $subdb] TRUE + set d [$subc get -first] + error_check_good dbc_get [expr [llength $d] != 0] 1 + set key [lindex [lindex $d 0] 0] + set data [lindex [lindex $d 0] 1] + + set ofid [open $t1 w] + fconfigure $ofid -translation binary + puts -nonewline $ofid $data + close $ofid + + $checkfunc $key $t1 + $checkfunc $key $t3 + + error_check_good Subdb004:diff($t3,$t1) \ + [filecmp $t3 $t1] 0 + error_check_good curs_close [$subc close] 0 + error_check_good db_close [$subdb close] 0 + } + error_check_good curs_close [$c close] 0 + error_check_good db_close [$db close] 0 + + if { [is_record_based $method] != 1 } { + fileremove $t2.tmp + } +} + +# Check function for subdb004; key should be file name; data should be contents +proc subdb004.check { binfile tmpfile } { + source ./include.tcl + + error_check_good Subdb004:datamismatch($binfile,$tmpfile) \ + [filecmp $binfile $tmpfile] 0 +} +proc subdb004_recno.check { binfile tmpfile } { + global names + source ./include.tcl + + set fname $names($binfile) + error_check_good key"$binfile"_exists [info exists names($binfile)] 1 + error_check_good Subdb004:datamismatch($fname,$tmpfile) \ + [filecmp $fname $tmpfile] 0 +} diff --git a/bdb/test/sdb005.tcl b/bdb/test/sdb005.tcl new file mode 100644 index 00000000000..22e4083c46c --- /dev/null +++ b/bdb/test/sdb005.tcl @@ -0,0 +1,109 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb005.tcl,v 11.12 2000/08/25 14:21:53 sue Exp $ +# +# Test cursor operations between subdbs. +# +# We should test this on all btrees, all hash, and a combination thereof +proc subdb005 {method {nentries 100} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_queue $method] == 1 } { + puts "Subdb005: skipping for method $method" + return + } + + puts "Subdb005: $method ( $args ) subdb cursor operations test" + set txn "" + cleanup $testdir NULL + set psize 8192 + set testfile $testdir/subdb005.db + set duplist {-1 -1 -1 -1 -1} + build_all_subdb \ + $testfile [list $method] [list $psize] $duplist $nentries $args + set numdb [llength $duplist] + # + # Get a cursor in each subdb and move past the end of each + # subdb. Make sure we don't end up in another subdb. + # + puts "\tSubdb005.a: Cursor ops - first/prev and last/next" + for {set i 0} {$i < $numdb} {incr i} { + set db [berkdb_open -unknown $testfile sub$i.db] + error_check_good dbopen [is_valid_db $db] TRUE + set db_handle($i) $db + # Used in 005.c test + lappend subdbnames sub$i.db + + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + set d [$dbc get -first] + error_check_good dbc_get [expr [llength $d] != 0] 1 + + # Used in 005.b test + set db_key($i) [lindex [lindex $d 0] 0] + + set d [$dbc get -prev] + error_check_good dbc_get [expr [llength $d] == 0] 1 + set d [$dbc get -last] + error_check_good dbc_get [expr [llength $d] != 0] 1 + set d [$dbc get -next] + error_check_good dbc_get [expr [llength $d] == 0] 1 + } + # + # Get a key from each subdb and try to get this key in a + # different subdb. Make sure it fails + # + puts "\tSubdb005.b: Get keys in different subdb's" + for {set i 0} {$i < $numdb} {incr i} { + set n [expr $i + 1] + if {$n == $numdb} { + set n 0 + } + set db $db_handle($i) + if { [is_record_based $method] == 1 } { + set d [$db get -recno $db_key($n)] + error_check_good \ + db_get [expr [llength $d] == 0] 1 + } else { + set d [$db get $db_key($n)] + error_check_good db_get [expr [llength $d] == 0] 1 + } + } + + # + # Clean up + # + for {set i 0} {$i < $numdb} {incr i} { + error_check_good db_close [$db_handle($i) close] 0 + } + + # + # Check contents of DB for subdb names only. Makes sure that + # every subdbname is there and that nothing else is there. + # + puts "\tSubdb005.c: Check DB is read-only" + error_check_bad dbopen [catch \ + {berkdb_open_noerr -unknown $testfile} ret] 0 + + puts "\tSubdb005.d: Check contents of DB for subdb names only" + set db [berkdb_open -unknown -rdonly $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + set subdblist [$db get -glob *] + foreach kd $subdblist { + # subname also used in subdb005.e,f below + set subname [lindex $kd 0] + set i [lsearch $subdbnames $subname] + error_check_good subdb_search [expr $i != -1] 1 + set subdbnames [lreplace $subdbnames $i $i] + } + error_check_good subdb_done [llength $subdbnames] 0 + + error_check_good db_close [$db close] 0 + return +} diff --git a/bdb/test/sdb006.tcl b/bdb/test/sdb006.tcl new file mode 100644 index 00000000000..70dee5c7343 --- /dev/null +++ b/bdb/test/sdb006.tcl @@ -0,0 +1,130 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb006.tcl,v 11.12 2000/09/20 13:22:03 sue Exp $ +# +# We'll test 2-way, 3-way, and 4-way joins and figure that if those work, +# everything else does as well. We'll create test databases called +# sub1.db, sub2.db, sub3.db, and sub4.db. The number on the database +# describes the duplication -- duplicates are of the form 0, N, 2N, 3N, ... +# where N is the number of the database. Primary.db is the primary database, +# and sub0.db is the database that has no matching duplicates. All of +# these are within a single database. +# +# We should test this on all btrees, all hash, and a combination thereof +proc subdb006 {method {nentries 100} args } { + source ./include.tcl + global rand_init + + # NB: these flags are internal only, ok + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 || [is_rbtree $method] } { + puts "\tSubdb006 skipping for method $method." + return + } + + berkdb srand $rand_init + + foreach opt {" -dup" " -dupsort"} { + append args $opt + + puts "Subdb006: $method ( $args ) Intra-subdb join" + set txn "" + # + # Get a cursor in each subdb and move past the end of each + # subdb. Make sure we don't end up in another subdb. + # + puts "\tSubdb006.a: Intra-subdb join" + + cleanup $testdir NULL + set testfile $testdir/subdb006.db + + set psize [list 8192] + set duplist {0 50 25 16 12} + set numdb [llength $duplist] + build_all_subdb $testfile [list $method] $psize \ + $duplist $nentries $args + + # Build the primary + puts "Subdb006: Building the primary database $method" + set oflags "-create -mode 0644 [conv $omethod \ + [berkdb random_int 1 2]]" + set db [eval {berkdb_open} $oflags $testfile primary.db] + error_check_good dbopen [is_valid_db $db] TRUE + for { set i 0 } { $i < 1000 } { incr i } { + set key [format "%04d" $i] + set ret [$db put $key stub] + error_check_good "primary put" $ret 0 + } + error_check_good "primary close" [$db close] 0 + set did [open $dict] + gets $did str + do_join_subdb $testfile primary.db "1 0" $str + gets $did str + do_join_subdb $testfile primary.db "2 0" $str + gets $did str + do_join_subdb $testfile primary.db "3 0" $str + gets $did str + do_join_subdb $testfile primary.db "4 0" $str + gets $did str + do_join_subdb $testfile primary.db "1" $str + gets $did str + do_join_subdb $testfile primary.db "2" $str + gets $did str + do_join_subdb $testfile primary.db "3" $str + gets $did str + do_join_subdb $testfile primary.db "4" $str + gets $did str + do_join_subdb $testfile primary.db "1 2" $str + gets $did str + do_join_subdb $testfile primary.db "1 2 3" $str + gets $did str + do_join_subdb $testfile primary.db "1 2 3 4" $str + gets $did str + do_join_subdb $testfile primary.db "2 1" $str + gets $did str + do_join_subdb $testfile primary.db "3 2 1" $str + gets $did str + do_join_subdb $testfile primary.db "4 3 2 1" $str + gets $did str + do_join_subdb $testfile primary.db "1 3" $str + gets $did str + do_join_subdb $testfile primary.db "3 1" $str + gets $did str + do_join_subdb $testfile primary.db "1 4" $str + gets $did str + do_join_subdb $testfile primary.db "4 1" $str + gets $did str + do_join_subdb $testfile primary.db "2 3" $str + gets $did str + do_join_subdb $testfile primary.db "3 2" $str + gets $did str + do_join_subdb $testfile primary.db "2 4" $str + gets $did str + do_join_subdb $testfile primary.db "4 2" $str + gets $did str + do_join_subdb $testfile primary.db "3 4" $str + gets $did str + do_join_subdb $testfile primary.db "4 3" $str + gets $did str + do_join_subdb $testfile primary.db "2 3 4" $str + gets $did str + do_join_subdb $testfile primary.db "3 4 1" $str + gets $did str + do_join_subdb $testfile primary.db "4 2 1" $str + gets $did str + do_join_subdb $testfile primary.db "0 2 1" $str + gets $did str + do_join_subdb $testfile primary.db "3 2 0" $str + gets $did str + do_join_subdb $testfile primary.db "4 3 2 1" $str + gets $did str + do_join_subdb $testfile primary.db "4 3 0 1" $str + + close $did + } +} diff --git a/bdb/test/sdb007.tcl b/bdb/test/sdb007.tcl new file mode 100644 index 00000000000..6b56fd411dd --- /dev/null +++ b/bdb/test/sdb007.tcl @@ -0,0 +1,123 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb007.tcl,v 11.13 2000/12/11 17:24:55 sue Exp $ +# +# Sub DB Test 7 {access method} +# Use the first 10,000 entries from the dictionary spread across each subdb. +# Use a different page size for every subdb. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Close file, reopen, do retrieve and re-verify. +proc subdb007 { method {nentries 10000} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_queue $method] == 1 } { + puts "Subdb007: skipping for method $method" + return + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Subdb007: skipping for specific pagesizes" + return + } + + puts "Subdb007: $method ($args) subdb tests with different pagesizes" + + # Create the database and open the dictionary + set testfile $testdir/subdb007.db + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set t4 $testdir/t4 + cleanup $testdir NULL + + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + set checkfunc subdb007_recno.check + } else { + set checkfunc subdb007.check + } + puts "\tSubdb007.a: create subdbs of different page sizes" + set psize {8192 4096 2048 1024 512} + set nsubdbs [llength $psize] + for { set i 0 } { $i < $nsubdbs } { incr i } { + lappend duplist -1 + } + set newent [expr $nentries / $nsubdbs] + build_all_subdb $testfile [list $method] $psize $duplist $newent $args + + # Now we will get each key from the DB and compare the results + # to the original. + for { set subdb 0 } { $subdb < $nsubdbs } { incr subdb } { + puts "\tSubdb007.b: dump file sub$subdb.db" + set db [berkdb_open -unknown $testfile sub$subdb.db] + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary + # (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $newent} {incr i} { + puts $oid [expr $subdb * $newent + $i] + } + close $oid + file rename -force $t1 $t3 + } else { + set beg [expr $subdb * $newent] + incr beg + set end [expr $beg + $newent - 1] + filehead $end $dict $t3 $beg + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good Subdb007:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tSubdb007.c: sub$subdb.db: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-first" "-next" sub$subdb.db + if { [is_record_based $method] != 1 } { + filesort $t1 $t3 + } + + error_check_good Subdb007:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tSubdb007.d: sub$subdb.db:\ + close, open, and dump file in reverse direction" + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-last" "-prev" sub$subdb.db + + if { [is_record_based $method] != 1 } { + filesort $t1 $t3 + } + + error_check_good Subdb007:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + } +} + +# Check function for Subdb007; keys and data are identical +proc subdb007.check { key data } { + error_check_good "key/data mismatch" $data $key +} + +proc subdb007_recno.check { key data } { +global dict +global kvals + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "key/data mismatch, key $key" $data $kvals($key) +} diff --git a/bdb/test/sdb008.tcl b/bdb/test/sdb008.tcl new file mode 100644 index 00000000000..b005f00931a --- /dev/null +++ b/bdb/test/sdb008.tcl @@ -0,0 +1,151 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb008.tcl,v 11.14 2000/08/25 14:21:53 sue Exp $ +# +# Sub DB Test 8 {access method} +# Use the first 10,000 entries from the dictionary. +# Use a different or random lorder for each subdb. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Close file, reopen, do retrieve and re-verify. +proc subdb008 { method {nentries 10000} args } { + source ./include.tcl + global rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_queue $method] == 1 } { + puts "Subdb008: skipping for method $method" + return + } + + berkdb srand $rand_init + + puts "Subdb008: $method ($args) subdb lorder tests" + + # Create the database and open the dictionary + set testfile $testdir/subdb008.db + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set t4 $testdir/t4 + cleanup $testdir NULL + + set txn "" + set pflags "" + set gflags "" + + if { [is_record_based $method] == 1 } { + set checkfunc subdb008_recno.check + } else { + set checkfunc subdb008.check + } + set nsubdbs 4 + set lo [list 4321 1234] + puts "\tSubdb008.a: put/get loop" + # Here is the loop where we put and get each key/data pair + for { set i 0 } { $i < $nsubdbs } { incr i } { + set subdb sub$i.db + if { $i >= [llength $lo]} { + set r [berkdb random_int 0 1] + set order [lindex $lo $r] + } else { + set order [lindex $lo $i] + } + set db [eval {berkdb_open -create -mode 0644} \ + $args {-lorder $order $omethod $testfile $subdb}] + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + global kvals + + set gflags "-recno" + set key [expr $i * $nentries] + set key [expr $key + $count + 1] + set kvals($key) [pad_data $method $str] + } else { + set key $str + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $str]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $str]]] + incr count + } + close $did + error_check_good db_close [$db close] 0 + } + + # Now we will get each key from the DB and compare the results + # to the original. + for { set subdb 0 } { $subdb < $nsubdbs } { incr subdb } { + puts "\tSubdb008.b: dump file sub$subdb.db" + set db [berkdb_open -unknown $testfile sub$subdb.db] + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary + # (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {incr i} { + puts $oid [expr $subdb * $nentries + $i] + } + close $oid + file rename -force $t1 $t3 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good Subdb008:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tSubdb008.c: sub$subdb.db: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-first" "-next" sub$subdb.db + if { [is_record_based $method] != 1 } { + filesort $t1 $t3 + } + + error_check_good Subdb008:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tSubdb008.d: sub$subdb.db:\ + close, open, and dump file in reverse direction" + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-last" "-prev" sub$subdb.db + + if { [is_record_based $method] != 1 } { + filesort $t1 $t3 + } + + error_check_good Subdb008:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + } +} + +# Check function for Subdb008; keys and data are identical +proc subdb008.check { key data } { + error_check_good "key/data mismatch" $data $key +} + +proc subdb008_recno.check { key data } { +global dict +global kvals + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "key/data mismatch, key $key" $data $kvals($key) +} diff --git a/bdb/test/sdb009.tcl b/bdb/test/sdb009.tcl new file mode 100644 index 00000000000..060bea643bb --- /dev/null +++ b/bdb/test/sdb009.tcl @@ -0,0 +1,77 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb009.tcl,v 11.4 2000/08/25 14:21:53 sue Exp $ +# +# Subdatabase Test 9 (replacement) +# Test the DB->rename method. +proc subdb009 { method args } { + global errorCode + source ./include.tcl + set omethod [convert_method $method] + set args [convert_args $method $args] + + puts "Subdb009: $method ($args): Test of DB->rename()" + + if { [is_queue $method] == 1 } { + puts "\tSubdb009: Skipping for method $method." + return + } + + set file $testdir/subdb009.db + set oldsdb OLDDB + set newsdb NEWDB + + # Make sure we're starting from a clean slate. + cleanup $testdir NULL + error_check_bad "$file exists" [file exists $file] 1 + + puts "\tSubdb009.a: Create/rename file" + puts "\t\tSubdb009.a.1: create" + set db [eval {berkdb_open -create -mode 0644}\ + $omethod $args $file $oldsdb] + error_check_good dbopen [is_valid_db $db] TRUE + + # The nature of the key and data are unimportant; use numeric key + # so record-based methods don't need special treatment. + set key 1 + set data [pad_data $method data] + + error_check_good dbput [$db put $key $data] 0 + error_check_good dbclose [$db close] 0 + + puts "\t\tSubdb009.a.2: rename" + error_check_good rename_file [eval {berkdb dbrename} $file \ + $oldsdb $newsdb] 0 + + puts "\t\tSubdb009.a.3: check" + # Open again with create to make sure we've really completely + # disassociated the subdb from the old name. + set odb [eval {berkdb_open -create -mode 0644}\ + $omethod $args $file $oldsdb] + error_check_good odb_open [is_valid_db $odb] TRUE + set odbt [$odb get $key] + error_check_good odb_close [$odb close] 0 + + set ndb [eval {berkdb_open -create -mode 0644}\ + $omethod $args $file $newsdb] + error_check_good ndb_open [is_valid_db $ndb] TRUE + set ndbt [$ndb get $key] + error_check_good ndb_close [$ndb close] 0 + + # The DBT from the "old" database should be empty, not the "new" one. + error_check_good odbt_empty [llength $odbt] 0 + error_check_bad ndbt_empty [llength $ndbt] 0 + error_check_good ndbt [lindex [lindex $ndbt 0] 1] $data + + # Now there's both an old and a new. Rename the "new" to the "old" + # and make sure that fails. + puts "\tSubdb009.b: Make sure rename fails instead of overwriting" + set ret [catch {eval {berkdb dbrename} $file $oldsdb $newsdb} res] + error_check_bad rename_overwrite $ret 0 + error_check_good rename_overwrite_ret [is_substr $errorCode EEXIST] 1 + + puts "\tSubdb009 succeeded." +} diff --git a/bdb/test/sdb010.tcl b/bdb/test/sdb010.tcl new file mode 100644 index 00000000000..6bec78d372b --- /dev/null +++ b/bdb/test/sdb010.tcl @@ -0,0 +1,46 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdb010.tcl,v 11.4 2000/08/25 14:21:53 sue Exp $ +# +# Subdatabase Test 10 {access method} +# Test of dbremove +proc subdb010 { method args } { + global errorCode + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Subdb010: Test of DB->remove()" + + if { [is_queue $method] == 1 } { + puts "\tSubdb010: Skipping for method $method." + return + } + + cleanup $testdir NULL + + set testfile $testdir/subdb010.db + set testdb DATABASE + + set db [eval {berkdb_open -create -truncate -mode 0644} $omethod \ + $args $testfile $testdb] + error_check_good db_open [is_valid_db $db] TRUE + error_check_good db_close [$db close] 0 + + error_check_good file_exists_before [file exists $testfile] 1 + error_check_good db_remove [berkdb dbremove $testfile $testdb] 0 + + # File should still exist. + error_check_good file_exists_after [file exists $testfile] 1 + + # But database should not. + set ret [catch {eval berkdb_open $omethod $args $testfile $testdb} res] + error_check_bad open_failed ret 0 + error_check_good open_failed_ret [is_substr $errorCode ENOENT] 1 + + puts "\tSubdb010 succeeded." +} diff --git a/bdb/test/sdbscript.tcl b/bdb/test/sdbscript.tcl new file mode 100644 index 00000000000..1b099520e88 --- /dev/null +++ b/bdb/test/sdbscript.tcl @@ -0,0 +1,47 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdbscript.tcl,v 11.7 2000/04/21 18:36:23 krinsky Exp $ +# +# Usage: subdbscript testfile subdbnumber factor +# testfile: name of DB itself +# subdbnumber: n, subdb indicator, of form sub$n.db +# factor: Delete over factor'th + n'th from my subdb. +# +# I.e. if factor is 10, and n is 0, remove entries, 0, 10, 20, ... +# if factor is 10 and n is 1, remove entries 1, 11, 21, ... +source ./include.tcl +source $test_path/test.tcl + +set usage "subdbscript testfile subdbnumber factor" + +# Verify usage +if { $argc != 3 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + exit +} + +# Initialize arguments +set testfile [lindex $argv 0] +set n [ lindex $argv 1 ] +set factor [ lindex $argv 2 ] + +set db [berkdb_open -unknown $testfile sub$n.db] +error_check_good db_open [is_valid_db $db] TRUE + +set dbc [$db cursor] +error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE +set i 1 +for {set d [$dbc get -first]} {[llength $d] != 0} {set d [$dbc get -next]} { + set x [expr $i - $n] + if { $x >= 0 && [expr $x % $factor] == 0 } { + puts "Deleting $d" + error_check_good dbc_del [$dbc del] 0 + } + incr i +} +error_check_good db_close [$db close] 0 + +exit diff --git a/bdb/test/sdbtest001.tcl b/bdb/test/sdbtest001.tcl new file mode 100644 index 00000000000..e3ff2b032d3 --- /dev/null +++ b/bdb/test/sdbtest001.tcl @@ -0,0 +1,133 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdbtest001.tcl,v 11.13 2000/08/25 14:21:53 sue Exp $ +# +# Sub DB All-Method Test 1 +# Make several subdb's of different access methods all in one DB. +# Rotate methods and repeat [#762]. +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Close file, reopen, do retrieve and re-verify. +proc subdbtest001 { {nentries 10000} } { + source ./include.tcl + + puts "Subdbtest001: many different subdb access methods in one" + + # Create the database and open the dictionary + set testfile $testdir/subdbtest001.db + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set t4 $testdir/t4 + + set txn "" + set count 0 + + # Set up various methods to rotate through + lappend method_list [list "-rrecno" "-rbtree" "-hash" "-recno" "-btree"] + lappend method_list [list "-recno" "-hash" "-btree" "-rbtree" "-rrecno"] + lappend method_list [list "-btree" "-recno" "-rbtree" "-rrecno" "-hash"] + lappend method_list [list "-hash" "-recno" "-rbtree" "-rrecno" "-btree"] + lappend method_list [list "-rbtree" "-hash" "-btree" "-rrecno" "-recno"] + lappend method_list [list "-rrecno" "-recno"] + lappend method_list [list "-recno" "-rrecno"] + lappend method_list [list "-hash" "-dhash"] + lappend method_list [list "-dhash" "-hash"] + lappend method_list [list "-rbtree" "-btree" "-dbtree" "-ddbtree"] + lappend method_list [list "-btree" "-rbtree" "-ddbtree" "-dbtree"] + lappend method_list [list "-dbtree" "-ddbtree" "-btree" "-rbtree"] + lappend method_list [list "-ddbtree" "-dbtree" "-rbtree" "-btree"] + foreach methods $method_list { + cleanup $testdir NULL + puts "\tSubdbtest001.a: create subdbs of different access methods:" + puts "\tSubdbtest001.a: $methods" + set psize {8192 4096} + set nsubdbs [llength $methods] + set duplist "" + for { set i 0 } { $i < $nsubdbs } { incr i } { + lappend duplist -1 + } + set newent [expr $nentries / $nsubdbs] + build_all_subdb $testfile $methods $psize $duplist $newent + + # Now we will get each key from the DB and compare the results + # to the original. + for { set subdb 0 } { $subdb < $nsubdbs } { incr subdb } { + + set method [lindex $methods $subdb] + set method [convert_method $method] + if { [is_record_based $method] == 1 } { + set checkfunc subdbtest001_recno.check + } else { + set checkfunc subdbtest001.check + } + + puts "\tSubdbtest001.b: dump file sub$subdb.db" + set db [berkdb_open -unknown $testfile sub$subdb.db] + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the + # dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $newent} {incr i} { + puts $oid [expr $subdb * $newent + $i] + } + close $oid + file rename -force $t1 $t3 + } else { + # filehead uses 1-based line numbers + set beg [expr $subdb * $newent] + incr beg + set end [expr $beg + $newent - 1] + filehead $end $dict $t3 $beg + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good Subdbtest001:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tSubdbtest001.c: sub$subdb.db: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-first" "-next" sub$subdb.db + if { [string compare $method "-recno"] != 0 } { + filesort $t1 $t3 + } + + error_check_good Subdbtest001:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tSubdbtest001.d: sub$subdb.db: close, open, and dump file in reverse direction" + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-last" "-prev" sub$subdb.db + + if { [string compare $method "-recno"] != 0 } { + filesort $t1 $t3 + } + + error_check_good Subdbtest001:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + } + } +} + +# Check function for Subdbtest001; keys and data are identical +proc subdbtest001.check { key data } { + error_check_good "key/data mismatch" $data $key +} + +proc subdbtest001_recno.check { key data } { +global dict +global kvals + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "key/data mismatch, key $key" $data $kvals($key) +} diff --git a/bdb/test/sdbtest002.tcl b/bdb/test/sdbtest002.tcl new file mode 100644 index 00000000000..b8bad4e70e1 --- /dev/null +++ b/bdb/test/sdbtest002.tcl @@ -0,0 +1,163 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdbtest002.tcl,v 11.19 2000/08/25 14:21:53 sue Exp $ +# +# Sub DB All-Method Test 2 +# Make several subdb's of different access methods all in one DB. +# Fork of some child procs to each manipulate one subdb and when +# they are finished, verify the contents of the databases. +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Close file, reopen, do retrieve and re-verify. +proc subdbtest002 { {nentries 10000} } { + source ./include.tcl + + puts "Subdbtest002: many different subdb access methods in one" + + # Create the database and open the dictionary + set testfile $testdir/subdbtest002.db + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set t4 $testdir/t4 + + set txn "" + set count 0 + + # Set up various methods to rotate through + set methods \ + [list "-rbtree" "-recno" "-btree" "-btree" "-recno" "-rbtree"] + cleanup $testdir NULL + puts "\tSubdbtest002.a: create subdbs of different access methods:" + puts "\t\t$methods" + set psize {8192 4096} + set nsubdbs [llength $methods] + set duplist "" + for { set i 0 } { $i < $nsubdbs } { incr i } { + lappend duplist -1 + } + set newent [expr $nentries / $nsubdbs] + + # + # XXX We need dict sorted to figure out what was deleted + # since things are stored sorted in the btree. + # + filesort $dict $t4 + set dictorig $dict + set dict $t4 + + build_all_subdb $testfile $methods $psize $duplist $newent + + # Now we will get each key from the DB and compare the results + # to the original. + set pidlist "" + puts "\tSubdbtest002.b: create $nsubdbs procs to delete some keys" + for { set subdb 0 } { $subdb < $nsubdbs } { incr subdb } { + puts "$tclsh_path\ + $test_path/sdbscript.tcl $testfile \ + $subdb $nsubdbs >& $testdir/subdb002.log.$subdb" + set p [exec $tclsh_path $test_path/wrap.tcl \ + sdbscript.tcl \ + $testdir/subdb002.log.$subdb $testfile $subdb $nsubdbs &] + lappend pidlist $p + } + watch_procs 5 + + for { set subdb 0 } { $subdb < $nsubdbs } { incr subdb } { + set method [lindex $methods $subdb] + set method [convert_method $method] + if { [is_record_based $method] == 1 } { + set checkfunc subdbtest002_recno.check + } else { + set checkfunc subdbtest002.check + } + + puts "\tSubdbtest002.b: dump file sub$subdb.db" + set db [berkdb_open -unknown $testfile sub$subdb.db] + error_check_good db_open [is_valid_db $db] TRUE + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + # + # This is just so that t2 is there and empty + # since we are only appending below. + # + exec > $t2 + + # Now compare the keys to see if they match the dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $newent} {incr i} { + set x [expr $i - $subdb] + if { [expr $x % $nsubdbs] != 0 } { + puts $oid [expr $subdb * $newent + $i] + } + } + close $oid + file rename -force $t1 $t3 + } else { + set oid [open $t4 r] + for {set i 1} {[gets $oid line] >= 0} {incr i} { + set farr($i) $line + } + close $oid + + set oid [open $t2 w] + for {set i 1} {$i <= $newent} {incr i} { + # Sed uses 1-based line numbers + set x [expr $i - $subdb] + if { [expr $x % $nsubdbs] != 0 } { + set beg [expr $subdb * $newent] + set beg [expr $beg + $i] + puts $oid $farr($beg) + } + } + close $oid + filesort $t1 $t3 + } + + error_check_good Subdbtest002:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tSubdbtest002.c: sub$subdb.db: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-first" "-next" sub$subdb.db + if { [string compare $method "-recno"] != 0 } { + filesort $t1 $t3 + } + + error_check_good Subdbtest002:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tSubdbtest002.d: sub$subdb.db: close, open, and dump file in reverse direction" + open_and_dump_subfile $testfile NULL $txn $t1 $checkfunc \ + dump_file_direction "-last" "-prev" sub$subdb.db + + if { [string compare $method "-recno"] != 0 } { + filesort $t1 $t3 + } + + error_check_good Subdbtest002:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + } + set dict $dictorig + return +} + +# Check function for Subdbtest002; keys and data are identical +proc subdbtest002.check { key data } { + error_check_good "key/data mismatch" $data $key +} + +proc subdbtest002_recno.check { key data } { +global dict +global kvals + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "key/data mismatch, key $key" $data $kvals($key) +} diff --git a/bdb/test/sdbutils.tcl b/bdb/test/sdbutils.tcl new file mode 100644 index 00000000000..0cb33b28649 --- /dev/null +++ b/bdb/test/sdbutils.tcl @@ -0,0 +1,171 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sdbutils.tcl,v 11.9 2000/05/22 12:51:38 bostic Exp $ +# +proc build_all_subdb { dbname methods psize dups {nentries 100} {dbargs ""}} { + set nsubdbs [llength $dups] + set plen [llength $psize] + set mlen [llength $methods] + set savearg $dbargs + for {set i 0} {$i < $nsubdbs} { incr i } { + set m [lindex $methods [expr $i % $mlen]] + set dbargs $savearg + set p [lindex $psize [expr $i % $plen]] + subdb_build $dbname $nentries [lindex $dups $i] \ + $i $m $p sub$i.db $dbargs + } +} + +proc subdb_build { name nkeys ndups dup_interval method psize subdb dbargs} { + source ./include.tcl + + set dbargs [convert_args $method $dbargs] + set omethod [convert_method $method] + + puts "Method: $method" + + # Create the database and open the dictionary + set oflags "-create -mode 0644 $omethod \ + -pagesize $psize $dbargs $name $subdb" + set db [eval {berkdb_open} $oflags] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + set count 0 + if { $ndups >= 0 } { + puts "\tBuilding $method $name $subdb. \ + $nkeys keys with $ndups duplicates at interval of $dup_interval" + } + if { $ndups < 0 } { + puts "\tBuilding $method $name $subdb. \ + $nkeys unique keys of pagesize $psize" + # + # If ndups is < 0, we want unique keys in each subdb, + # so skip ahead in the dict by nkeys * iteration + # + for { set count 0 } \ + { $count < [expr $nkeys * $dup_interval] } { + incr count} { + set ret [gets $did str] + if { $ret == -1 } { + break + } + } + } + for { set count 0 } { [gets $did str] != -1 && $count < $nkeys } { + incr count} { + for { set i 0 } { $i < $ndups } { incr i } { + set data [format "%04d" [expr $i * $dup_interval]] + set ret [$db put $str [chop_data $method $data]] + error_check_good put $ret 0 + } + + if { $ndups == 0 } { + set ret [$db put $str [chop_data $method NODUP]] + error_check_good put $ret 0 + } elseif { $ndups < 0 } { + if { [is_record_based $method] == 1 } { + global kvals + + set num [expr $nkeys * $dup_interval] + set num [expr $num + $count + 1] + set ret [$db put $num [chop_data $method $str]] + set kvals($num) [pad_data $method $str] + error_check_good put $ret 0 + } else { + set ret [$db put $str [chop_data $method $str]] + error_check_good put $ret 0 + } + } + } + close $did + error_check_good close:$name [$db close] 0 +} + +proc do_join_subdb { db primary subdbs key } { + source ./include.tcl + + puts "\tJoining: $subdbs on $key" + + # Open all the databases + set p [berkdb_open -unknown $db $primary] + error_check_good "primary open" [is_valid_db $p] TRUE + + set dblist "" + set curslist "" + + foreach i $subdbs { + set jdb [berkdb_open -unknown $db sub$i.db] + error_check_good "sub$i.db open" [is_valid_db $jdb] TRUE + + lappend jlist [list $jdb $key] + lappend dblist $jdb + + } + + set join_res [eval {$p get_join} $jlist] + set ndups [llength $join_res] + + # Calculate how many dups we expect. + # We go through the list of indices. If we find a 0, then we + # expect 0 dups. For everything else, we look at pairs of numbers, + # if the are relatively prime, multiply them and figure out how + # many times that goes into 50. If they aren't relatively prime, + # take the number of times the larger goes into 50. + set expected 50 + set last 1 + foreach n $subdbs { + if { $n == 0 } { + set expected 0 + break + } + if { $last == $n } { + continue + } + + if { [expr $last % $n] == 0 || [expr $n % $last] == 0 } { + if { $n > $last } { + set last $n + set expected [expr 50 / $last] + } + } else { + set last [expr $n * $last / [gcd $n $last]] + set expected [expr 50 / $last] + } + } + + error_check_good number_of_dups:$subdbs $ndups $expected + + # + # If we get here, we have the number expected, now loop + # through each and see if it is what we expected. + # + for { set i 0 } { $i < $ndups } { incr i } { + set pair [lindex $join_res $i] + set k [lindex $pair 0] + foreach j $subdbs { + error_check_bad valid_dup:$j:$subdbs $j 0 + set kval [string trimleft $k 0] + if { [string length $kval] == 0 } { + set kval 0 + } + error_check_good \ + valid_dup:$j:$subdbs [expr $kval % $j] 0 + } + } + + error_check_good close_primary [$p close] 0 + foreach i $dblist { + error_check_good close_index:$i [$i close] 0 + } +} + +proc n_to_subname { n } { + if { $n == 0 } { + return null.db; + } else { + return sub$n.db; + } +} diff --git a/bdb/test/sysscript.tcl b/bdb/test/sysscript.tcl new file mode 100644 index 00000000000..1b7545e4c6b --- /dev/null +++ b/bdb/test/sysscript.tcl @@ -0,0 +1,283 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: sysscript.tcl,v 11.12 2000/05/22 12:51:38 bostic Exp $ +# +# System integration test script. +# This script runs a single process that tests the full functionality of +# the system. The database under test contains nfiles files. Each process +# randomly generates a key and some data. Both keys and data are bimodally +# distributed between small keys (1-10 characters) and large keys (the avg +# length is indicated via the command line parameter. +# The process then decides on a replication factor between 1 and nfiles. +# It writes the key and data to that many files and tacks on the file ids +# of the files it writes to the data string. For example, let's say that +# I randomly generate the key dog and data cat. Then I pick a replication +# factor of 3. I pick 3 files from the set of n (say 1, 3, and 5). I then +# rewrite the data as 1:3:5:cat. I begin a transaction, add the key/data +# pair to each file and then commit. Notice that I may generate replication +# of the form 1:3:3:cat in which case I simply add a duplicate to file 3. +# +# Usage: sysscript dir nfiles key_avg data_avg +# +# dir: DB_HOME directory +# nfiles: number of files in the set +# key_avg: average big key size +# data_avg: average big data size + +source ./include.tcl +source $test_path/test.tcl +source $test_path/testutils.tcl + +set alphabet "abcdefghijklmnopqrstuvwxyz" +set mypid [pid] + +set usage "sysscript dir nfiles key_avg data_avg method" + +# Verify usage +if { $argc != 5 } { + puts stderr "FAIL:[timestamp] Usage: $usage" + exit +} + +puts [concat "Argc: " $argc " Argv: " $argv] + +# Initialize arguments +set dir [lindex $argv 0] +set nfiles [ lindex $argv 1 ] +set key_avg [ lindex $argv 2 ] +set data_avg [ lindex $argv 3 ] +set method [ lindex $argv 4 ] + +# Initialize seed +global rand_init +berkdb srand $rand_init + +puts "Beginning execution for $mypid" +puts "$dir DB_HOME" +puts "$nfiles files" +puts "$key_avg average key length" +puts "$data_avg average data length" + +flush stdout + +# Create local environment +set dbenv [berkdb env -txn -home $dir] +set err [catch {error_check_good $mypid:dbenv [is_substr $dbenv env] 1} ret] +if {$err != 0} { + puts $ret + return +} + +# Now open the files +for { set i 0 } { $i < $nfiles } { incr i } { + set file test044.$i.db + set db($i) [berkdb open -env $dbenv $method $file] + set err [catch {error_check_bad $mypid:dbopen $db($i) NULL} ret] + if {$err != 0} { + puts $ret + return + } + set err [catch {error_check_bad $mypid:dbopen [is_substr $db($i) \ + error] 1} ret] + if {$err != 0} { + puts $ret + return + } +} + +set record_based [is_record_based $method] +while { 1 } { + # Decide if we're going to create a big key or a small key + # We give small keys a 70% chance. + if { [berkdb random_int 1 10] < 8 } { + set k [random_data 5 0 0 $record_based] + } else { + set k [random_data $key_avg 0 0 $record_based] + } + set data [chop_data $method [random_data $data_avg 0 0]] + + set txn [$dbenv txn] + set err [catch {error_check_good $mypid:txn_begin [is_substr $txn \ + $dbenv.txn] 1} ret] + if {$err != 0} { + puts $ret + return + } + + # Open cursors + for { set f 0 } {$f < $nfiles} {incr f} { + set cursors($f) [$db($f) cursor -txn $txn] + set err [catch {error_check_good $mypid:cursor_open \ + [is_substr $cursors($f) $db($f)] 1} ret] + if {$err != 0} { + puts $ret + return + } + } + set aborted 0 + + # Check to see if key is already in database + set found 0 + for { set i 0 } { $i < $nfiles } { incr i } { + set r [$db($i) get -txn $txn $k] + set r [$db($i) get -txn $txn $k] + if { $r == "-1" } { + for {set f 0 } {$f < $nfiles} {incr f} { + set err [catch {error_check_good \ + $mypid:cursor_close \ + [$cursors($f) close] 0} ret] + if {$err != 0} { + puts $ret + return + } + } + set err [catch {error_check_good $mypid:txn_abort \ + [$txn abort] 0} ret] + if {$err != 0} { + puts $ret + return + } + set aborted 1 + set found 2 + break + } elseif { $r != "Key $k not found." } { + set found 1 + break + } + } + switch $found { + 2 { + # Transaction aborted, no need to do anything. + } + 0 { + # Key was not found, decide how much to replicate + # and then create a list of that many file IDs. + set repl [berkdb random_int 1 $nfiles] + set fset "" + for { set i 0 } { $i < $repl } {incr i} { + set f [berkdb random_int 0 [expr $nfiles - 1]] + lappend fset $f + set data [chop_data $method $f:$data] + } + + foreach i $fset { + set r [$db($i) put -txn $txn $k $data] + if {$r == "-1"} { + for {set f 0 } {$f < $nfiles} {incr f} { + set err [catch {error_check_good \ + $mypid:cursor_close \ + [$cursors($f) close] 0} ret] + if {$err != 0} { + puts $ret + return + } + } + set err [catch {error_check_good \ + $mypid:txn_abort [$txn abort] 0} ret] + if {$err != 0} { + puts $ret + return + } + set aborted 1 + break + } + } + } + 1 { + # Key was found. Make sure that all the data values + # look good. + set f [zero_list $nfiles] + set data $r + while { [set ndx [string first : $r]] != -1 } { + set fnum [string range $r 0 [expr $ndx - 1]] + if { [lindex $f $fnum] == 0 } { + #set flag -set + set full [record $cursors($fnum) get -set $k] + } else { + #set flag -next + set full [record $cursors($fnum) get -next] + } + if {[llength $full] == 0} { + for {set f 0 } {$f < $nfiles} {incr f} { + set err [catch {error_check_good \ + $mypid:cursor_close \ + [$cursors($f) close] 0} ret] + if {$err != 0} { + puts $ret + return + } + } + set err [catch {error_check_good \ + $mypid:txn_abort [$txn abort] 0} ret] + if {$err != 0} { + puts $ret + return + } + set aborted 1 + break + } + set err [catch {error_check_bad \ + $mypid:curs_get($k,$data,$fnum,$flag) \ + [string length $full] 0} ret] + if {$err != 0} { + puts $ret + return + } + set key [lindex [lindex $full 0] 0] + set rec [pad_data $method [lindex [lindex $full 0] 1]] + set err [catch {error_check_good \ + $mypid:dbget_$fnum:key $key $k} ret] + if {$err != 0} { + puts $ret + return + } + set err [catch {error_check_good \ + $mypid:dbget_$fnum:data($k) $rec $data} ret] + if {$err != 0} { + puts $ret + return + } + set f [lreplace $f $fnum $fnum 1] + incr ndx + set r [string range $r $ndx end] + } + } + } + if { $aborted == 0 } { + for {set f 0 } {$f < $nfiles} {incr f} { + set err [catch {error_check_good $mypid:cursor_close \ + [$cursors($f) close] 0} ret] + if {$err != 0} { + puts $ret + return + } + } + set err [catch {error_check_good $mypid:commit [$txn commit] \ + 0} ret] + if {$err != 0} { + puts $ret + return + } + } +} + +# Close files +for { set i 0 } { $i < $nfiles} { incr i } { + set r [$db($i) close] + set err [catch {error_check_good $mypid:db_close:$i $r 0} ret] + if {$err != 0} { + puts $ret + return + } +} + +# Close tm and environment +$dbenv close + +puts "[timestamp] [pid] Complete" +flush stdout + +filecheck $file 0 diff --git a/bdb/test/test.tcl b/bdb/test/test.tcl new file mode 100644 index 00000000000..7678f2fcbfb --- /dev/null +++ b/bdb/test/test.tcl @@ -0,0 +1,1297 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test.tcl,v 11.114 2001/01/09 21:28:52 sue Exp $ + +source ./include.tcl + +# Load DB's TCL API. +load $tcllib + +if { [file exists $testdir] != 1 } { + file mkdir $testdir +} + +global __debug_print +global __debug_on +global util_path + +# +# Test if utilities work to figure out the path. Most systems +# use ., but QNX has a problem with execvp of shell scripts which +# causes it to break. +# +set stat [catch {exec ./db_printlog -?} ret] +if { [string first "exec format error" $ret] != -1 } { + set util_path ./.libs +} else { + set util_path . +} +set __debug_print 0 +set __debug_on 0 + +# This is where the test numbering and parameters now live. +source $test_path/testparams.tcl + +for { set i 1 } { $i <= $deadtests } {incr i} { + set name [format "dead%03d.tcl" $i] + source $test_path/$name +} +for { set i 1 } { $i <= $envtests } {incr i} { + set name [format "env%03d.tcl" $i] + source $test_path/$name +} +for { set i 1 } { $i <= $recdtests } {incr i} { + set name [format "recd%03d.tcl" $i] + source $test_path/$name +} +for { set i 1 } { $i <= $rpctests } {incr i} { + set name [format "rpc%03d.tcl" $i] + source $test_path/$name +} +for { set i 1 } { $i <= $rsrctests } {incr i} { + set name [format "rsrc%03d.tcl" $i] + source $test_path/$name +} +for { set i 1 } { $i <= $runtests } {incr i} { + set name [format "test%03d.tcl" $i] + # Test numbering may be sparse. + if { [file exists $test_path/$name] == 1 } { + source $test_path/$name + } +} +for { set i 1 } { $i <= $subdbtests } {incr i} { + set name [format "sdb%03d.tcl" $i] + source $test_path/$name +} + +source $test_path/archive.tcl +source $test_path/byteorder.tcl +source $test_path/dbm.tcl +source $test_path/hsearch.tcl +source $test_path/join.tcl +source $test_path/lock001.tcl +source $test_path/lock002.tcl +source $test_path/lock003.tcl +source $test_path/log.tcl +source $test_path/logtrack.tcl +source $test_path/mpool.tcl +source $test_path/mutex.tcl +source $test_path/ndbm.tcl +source $test_path/sdbtest001.tcl +source $test_path/sdbtest002.tcl +source $test_path/sdbutils.tcl +source $test_path/testutils.tcl +source $test_path/txn.tcl +source $test_path/upgrade.tcl + +set dict $test_path/wordlist +set alphabet "abcdefghijklmnopqrstuvwxyz" + +# Random number seed. +global rand_init +set rand_init 1013 + +# Default record length and padding character for +# fixed record length access method(s) +set fixed_len 20 +set fixed_pad 0 + +set recd_debug 0 +set log_log_record_types 0 +set ohandles {} + +# Set up any OS-specific values +global tcl_platform +set is_windows_test [is_substr $tcl_platform(os) "Win"] +set is_hp_test [is_substr $tcl_platform(os) "HP-UX"] +set is_qnx_test [is_substr $tcl_platform(os) "QNX"] + +# From here on out, test.tcl contains the procs that are used to +# run all or part of the test suite. + +proc run_am { } { + global runtests + source ./include.tcl + + fileremove -f ALL.OUT + + # Access method tests. + # + # XXX + # Broken up into separate tclsh instantiations so we don't require + # so much memory. + foreach i "btree rbtree hash queue queueext recno frecno rrecno" { + puts "Running $i tests" + for { set j 1 } { $j <= $runtests } {incr j} { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + run_method -$i $j $j" >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: [format "test%03d" $j] $i" + close $o + } + } + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + subdb -$i 0 1" >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: subdb -$i test" + close $o + } + } +} + +proc run_std { args } { + global runtests + global subdbtests + source ./include.tcl + + set exflgs [eval extractflags $args] + set args [lindex $exflgs 0] + set flags [lindex $exflgs 1] + + set display 1 + set run 1 + set am_only 0 + set std_only 1 + set rflags {--} + foreach f $flags { + switch $f { + A { + set std_only 0 + } + m { + set am_only 1 + puts "run_std: access method tests only." + } + n { + set display 1 + set run 0 + set rflags [linsert $rflags 0 "-n"] + } + } + } + + if { $std_only == 1 } { + fileremove -f ALL.OUT + + set o [open ALL.OUT a] + if { $run == 1 } { + puts -nonewline "Test suite run started at: " + puts [clock format [clock seconds] -format "%H:%M %D"] + puts [berkdb version -string] + + puts -nonewline $o "Test suite run started at: " + puts $o [clock format [clock seconds] -format "%H:%M %D"] + puts $o [berkdb version -string] + } + close $o + } + + set test_list { + {"environment" "env"} + {"archive" "archive"} + {"locking" "lock"} + {"logging" "log"} + {"memory pool" "mpool"} + {"mutex" "mutex"} + {"transaction" "txn"} + {"deadlock detection" "dead"} + {"subdatabase" "subdb_gen"} + {"byte-order" "byte"} + {"recno backing file" "rsrc"} + {"DBM interface" "dbm"} + {"NDBM interface" "ndbm"} + {"Hsearch interface" "hsearch"} + } + + if { $am_only == 0 } { + + foreach pair $test_list { + set msg [lindex $pair 0] + set cmd [lindex $pair 1] + puts "Running $msg tests" + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; r $rflags $cmd" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: $cmd test" + close $o + } + } + + # Run recovery tests. + # + # XXX These too are broken into separate tclsh instantiations + # so we don't require so much memory, but I think it's cleaner + # and more useful to do it down inside proc r than here, + # since "r recd" gets done a lot and needs to work. + puts "Running recovery tests" + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + r $rflags recd" >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: recd test" + close $o + } + + # Run join test + # + # XXX + # Broken up into separate tclsh instantiations so we don't + # require so much memory. + puts "Running join test" + foreach i "join1 join2 join3 join4 join5 join6" { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; r $rflags $i" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: $i test" + close $o + } + } + } + + # Access method tests. + # + # XXX + # Broken up into separate tclsh instantiations so we don't require + # so much memory. + foreach i "btree rbtree hash queue queueext recno frecno rrecno" { + puts "Running $i tests" + for { set j 1 } { $j <= $runtests } {incr j} { + if { $run == 0 } { + set o [open ALL.OUT a] + run_method -$i $j $j $display $run $o + close $o + } + if { $run } { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + run_method -$i $j $j $display $run" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o \ + "FAIL: [format "test%03d" $j] $i" + close $o + } + } + } + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + subdb -$i $display $run" >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: subdb -$i test" + close $o + } + } + + # If not actually running, no need to check for failure. + # If running in the context of the larger 'run_all' we don't + # check for failure here either. + if { $run == 0 || $std_only == 0 } { + return + } + + set failed 0 + set o [open ALL.OUT r] + while { [gets $o line] >= 0 } { + if { [regexp {^FAIL} $line] != 0 } { + set failed 1 + } + } + close $o + set o [open ALL.OUT a] + if { $failed == 0 } { + puts "Regression Tests Succeeded" + puts $o "Regression Tests Succeeded" + } else { + puts "Regression Tests Failed; see ALL.OUT for log" + puts $o "Regression Tests Failed" + } + + puts -nonewline "Test suite run completed at: " + puts [clock format [clock seconds] -format "%H:%M %D"] + puts -nonewline $o "Test suite run completed at: " + puts $o [clock format [clock seconds] -format "%H:%M %D"] + close $o +} + +proc r { args } { + global envtests + global recdtests + global subdbtests + global deadtests + source ./include.tcl + + set exflgs [eval extractflags $args] + set args [lindex $exflgs 0] + set flags [lindex $exflgs 1] + + set display 1 + set run 1 + set saveflags "--" + foreach f $flags { + switch $f { + n { + set display 1 + set run 0 + set saveflags "-n $saveflags" + } + } + } + + if {[catch { + set l [ lindex $args 0 ] + switch $l { + archive { + if { $display } { + puts "eval archive [lrange $args 1 end]" + } + if { $run } { + check_handles + eval archive [lrange $args 1 end] + } + } + byte { + foreach method \ + "-hash -btree -recno -queue -queueext -frecno" { + if { $display } { + puts "byteorder $method" + } + if { $run } { + check_handles + byteorder $method + } + } + } + dbm { + if { $display } { + puts "dbm" + } + if { $run } { + check_handles + dbm + } + } + dead { + for { set i 1 } { $i <= $deadtests } \ + { incr i } { + if { $display } { + puts "eval dead00$i\ + [lrange $args 1 end]" + } + if { $run } { + check_handles + eval dead00$i\ + [lrange $args 1 end] + } + } + } + env { + for { set i 1 } { $i <= $envtests } {incr i} { + if { $display } { + puts "eval env00$i" + } + if { $run } { + check_handles + eval env00$i + } + } + } + hsearch { + if { $display } { puts "hsearch" } + if { $run } { + check_handles + hsearch + } + } + join { + eval r $saveflags join1 + eval r $saveflags join2 + eval r $saveflags join3 + eval r $saveflags join4 + eval r $saveflags join5 + eval r $saveflags join6 + } + join1 { + if { $display } { puts jointest } + if { $run } { + check_handles + jointest + } + } + joinbench { + puts "[timestamp]" + eval r $saveflags join1 + eval r $saveflags join2 + puts "[timestamp]" + } + join2 { + if { $display } { puts "jointest 512" } + if { $run } { + check_handles + jointest 512 + } + } + join3 { + if { $display } { + puts "jointest 8192 0 -join_item" + } + if { $run } { + check_handles + jointest 8192 0 -join_item + } + } + join4 { + if { $display } { puts "jointest 8192 2" } + if { $run } { + check_handles + jointest 8192 2 + } + } + join5 { + if { $display } { puts "jointest 8192 3" } + if { $run } { + check_handles + jointest 8192 3 + } + } + join6 { + if { $display } { puts "jointest 512 3" } + if { $run } { + check_handles + jointest 512 3 + } + } + lock { + if { $display } { + puts \ + "eval locktest [lrange $args 1 end]" + } + if { $run } { + check_handles + eval locktest [lrange $args 1 end] + } + } + log { + if { $display } { + puts "eval logtest [lrange $args 1 end]" + } + if { $run } { + check_handles + eval logtest [lrange $args 1 end] + } + } + mpool { + eval r $saveflags mpool1 + eval r $saveflags mpool2 + eval r $saveflags mpool3 + } + mpool1 { + if { $display } { + puts "eval mpool [lrange $args 1 end]" + } + if { $run } { + check_handles + eval mpool [lrange $args 1 end] + } + } + mpool2 { + if { $display } { + puts "eval mpool\ + -mem system [lrange $args 1 end]" + } + if { $run } { + check_handles + eval mpool\ + -mem system [lrange $args 1 end] + } + } + mpool3 { + if { $display } { + puts "eval mpool\ + -mem private [lrange $args 1 end]" + } + if { $run } { + eval mpool\ + -mem private [lrange $args 1 end] + } + } + mutex { + if { $display } { + puts "eval mutex [lrange $args 1 end]" + } + if { $run } { + check_handles + eval mutex [lrange $args 1 end] + } + } + ndbm { + if { $display } { puts ndbm } + if { $run } { + check_handles + ndbm + } + } + recd { + if { $display } { puts run_recds } + if { $run } { + check_handles + run_recds + } + } + rpc { + # RPC must be run as one unit due to server, + # so just print "r rpc" in the display case. + if { $display } { puts "r rpc" } + if { $run } { + check_handles + eval rpc001 + check_handles + eval rpc002 + if { [catch {run_rpcmethod -txn} ret]\ + != 0 } { + puts $ret + } + foreach method \ + "hash queue queueext recno frecno rrecno rbtree btree" { + if { [catch {run_rpcmethod \ + -$method} ret] != 0 } { + puts $ret + } + } + } + } + rsrc { + if { $display } { puts "rsrc001\nrsrc002" } + if { $run } { + check_handles + rsrc001 + check_handles + rsrc002 + } + } + subdb { + eval r $saveflags subdb_gen + + foreach method \ + "btree rbtree hash queue queueext recno frecno rrecno" { + check_handles + eval subdb -$method $display $run + } + } + subdb_gen { + if { $display } { + puts "subdbtest001 ; verify_dir" + puts "subdbtest002 ; verify_dir" + } + if { $run } { + check_handles + eval subdbtest001 + verify_dir + check_handles + eval subdbtest002 + verify_dir + } + } + txn { + if { $display } { + puts "txntest [lrange $args 1 end]" + } + if { $run } { + check_handles + eval txntest [lrange $args 1 end] + } + } + + btree - + rbtree - + hash - + queue - + queueext - + recno - + frecno - + rrecno { + eval run_method [lindex $args 0] \ + 1 0 $display $run [lrange $args 1 end] + } + + default { + error \ + "FAIL:[timestamp] r: $args: unknown command" + } + } + flush stdout + flush stderr + } res] != 0} { + global errorInfo; + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp] r: $args: $theError" + } else { + error $theError; + } + } +} + +proc run_method { method {start 1} {stop 0} {display 0} {run 1} \ + { outfile stdout } args } { + global __debug_on + global __debug_print + global parms + global runtests + source ./include.tcl + + if { $stop == 0 } { + set stop $runtests + } + if { $run == 1 } { + puts $outfile "run_method: $method $start $stop $args" + } + + if {[catch { + for { set i $start } { $i <= $stop } {incr i} { + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + if { $display } { + puts -nonewline $outfile "eval $name $method" + puts -nonewline $outfile " $parms($name) $args" + puts $outfile " ; verify_dir $testdir \"\" 1" + } + if { $run } { + check_handles $outfile + puts $outfile "[timestamp]" + eval $name $method $parms($name) $args + if { $__debug_print != 0 } { + puts $outfile "" + } + # verify all databases the test leaves behind + verify_dir $testdir "" 1 + if { $__debug_on != 0 } { + debug + } + } + flush stdout + flush stderr + } + } res] != 0} { + global errorInfo; + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_method: $method $i: $theError" + } else { + error $theError; + } + } +} + +proc run_rpcmethod { type {start 1} {stop 0} {largs ""} } { + global __debug_on + global __debug_print + global parms + global runtests + source ./include.tcl + + if { $stop == 0 } { + set stop $runtests + } + puts "run_rpcmethod: $type $start $stop $largs" + + set save_largs $largs + if { [string compare $rpc_server "localhost"] == 0 } { + set dpid [exec $util_path/berkeley_db_svc -h $rpc_testdir &] + } else { + set dpid [exec rsh $rpc_server $rpc_path/berkeley_db_svc \ + -h $rpc_testdir &] + } + puts "\tRun_rpcmethod.a: starting server, pid $dpid" + tclsleep 2 + remote_cleanup $rpc_server $rpc_testdir $testdir + + set home [file tail $rpc_testdir] + + set txn "" + set use_txn 0 + if { [string first "txn" $type] != -1 } { + set use_txn 1 + } + if { $use_txn == 1 } { + if { $start == 1 } { + set ntxns 32 + } else { + set ntxns $start + } + set i 1 + check_handles + remote_cleanup $rpc_server $rpc_testdir $testdir + set env [eval {berkdb env -create -mode 0644 -home $home \ + -server $rpc_server -client_timeout 10000} -txn] + error_check_good env_open [is_valid_env $env] TRUE + + set stat [catch {eval txn001_suba $ntxns $env} res] + if { $stat == 0 } { + set stat [catch {eval txn001_subb $ntxns $env} res] + } + error_check_good envclose [$env close] 0 + } else { + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + check_handles + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + remote_cleanup $rpc_server $rpc_testdir $testdir + # + # Set server cachesize to 1Mb. Otherwise some + # tests won't fit (like test084 -btree). + # + set env [eval {berkdb env -create -mode 0644 \ + -home $home -server $rpc_server \ + -client_timeout 10000 \ + -cachesize {0 1048576 1} }] + error_check_good env_open \ + [is_valid_env $env] TRUE + append largs " -env $env " + + puts "[timestamp]" + eval $name $type $parms($name) $largs + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug + } + flush stdout + flush stderr + set largs $save_largs + error_check_good envclose [$env close] 0 + } + } res] + } + if { $stat != 0} { + global errorInfo; + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + exec $KILL $dpid + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_rpcmethod: $type $i: $theError" + } else { + error $theError; + } + } + exec $KILL $dpid + +} + +proc run_rpcnoserver { type {start 1} {stop 0} {largs ""} } { + global __debug_on + global __debug_print + global parms + global runtests + source ./include.tcl + + if { $stop == 0 } { + set stop $runtests + } + puts "run_rpcnoserver: $type $start $stop $largs" + + set save_largs $largs + remote_cleanup $rpc_server $rpc_testdir $testdir + set home [file tail $rpc_testdir] + + set txn "" + set use_txn 0 + if { [string first "txn" $type] != -1 } { + set use_txn 1 + } + if { $use_txn == 1 } { + if { $start == 1 } { + set ntxns 32 + } else { + set ntxns $start + } + set i 1 + check_handles + remote_cleanup $rpc_server $rpc_testdir $testdir + set env [eval {berkdb env -create -mode 0644 -home $home \ + -server $rpc_server -client_timeout 10000} -txn] + error_check_good env_open [is_valid_env $env] TRUE + + set stat [catch {eval txn001_suba $ntxns $env} res] + if { $stat == 0 } { + set stat [catch {eval txn001_subb $ntxns $env} res] + } + error_check_good envclose [$env close] 0 + } else { + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + check_handles + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + remote_cleanup $rpc_server $rpc_testdir $testdir + # + # Set server cachesize to 1Mb. Otherwise some + # tests won't fit (like test084 -btree). + # + set env [eval {berkdb env -create -mode 0644 \ + -home $home -server $rpc_server \ + -client_timeout 10000 \ + -cachesize {0 1048576 1} }] + error_check_good env_open \ + [is_valid_env $env] TRUE + append largs " -env $env " + + puts "[timestamp]" + eval $name $type $parms($name) $largs + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug + } + flush stdout + flush stderr + set largs $save_largs + error_check_good envclose [$env close] 0 + } + } res] + } + if { $stat != 0} { + global errorInfo; + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_rpcnoserver: $type $i: $theError" + } else { + error $theError; + } + } + +} + +# +# Run method tests in one environment. (As opposed to run_envmethod1 +# which runs each test in its own, new environment.) +# +proc run_envmethod { type {start 1} {stop 0} {largs ""} } { + global __debug_on + global __debug_print + global parms + global runtests + source ./include.tcl + + if { $stop == 0 } { + set stop $runtests + } + puts "run_envmethod: $type $start $stop $largs" + + set save_largs $largs + env_cleanup $testdir + set txn "" + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + check_handles + set env [eval {berkdb env -create -mode 0644 \ + -home $testdir}] + error_check_good env_open [is_valid_env $env] TRUE + append largs " -env $env " + + puts "[timestamp]" + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + eval $name $type $parms($name) $largs + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug + } + flush stdout + flush stderr + set largs $save_largs + error_check_good envclose [$env close] 0 + error_check_good envremove [berkdb envremove \ + -home $testdir] 0 + } + } res] + if { $stat != 0} { + global errorInfo; + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_envmethod: $type $i: $theError" + } else { + error $theError; + } + } + +} + +proc subdb { method display run {outfile stdout} args} { + global subdbtests testdir + global parms + + for { set i 1 } {$i <= $subdbtests} {incr i} { + set name [format "subdb%03d" $i] + if { [info exists parms($name)] != 1 } { + puts "[format Subdb%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + if { $display } { + puts -nonewline $outfile "eval $name $method" + puts -nonewline $outfile " $parms($name) $args;" + puts $outfile "verify_dir $testdir \"\" 1" + } + if { $run } { + check_handles $outfile + eval $name $method $parms($name) $args + verify_dir $testdir "" 1 + } + flush stdout + flush stderr + } +} + +proc run_recd { method {start 1} {stop 0} args } { + global __debug_on + global __debug_print + global parms + global recdtests + global log_log_record_types + source ./include.tcl + + if { $stop == 0 } { + set stop $recdtests + } + puts "run_recd: $method $start $stop $args" + + if {[catch { + for { set i $start } { $i <= $stop } {incr i} { + check_handles + puts "[timestamp]" + set name [format "recd%03d" $i] + # By redirecting stdout to stdout, we make exec + # print output rather than simply returning it. + exec $tclsh_path << "source $test_path/test.tcl; \ + set log_log_record_types $log_log_record_types; \ + eval $name $method" >@ stdout + if { $__debug_print != 0 } { + puts "" + } + if { $__debug_on != 0 } { + debug + } + flush stdout + flush stderr + } + } res] != 0} { + global errorInfo; + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_recd: $method $i: $theError" + } else { + error $theError; + } + } +} + +proc run_recds { } { + global log_log_record_types + + set log_log_record_types 1 + logtrack_init + foreach method \ + "btree rbtree hash queue queueext recno frecno rrecno" { + check_handles + if { [catch \ + {run_recd -$method} ret ] != 0 } { + puts $ret + } + } + logtrack_summary + set log_log_record_types 0 +} + +proc run_all { args } { + global runtests + global subdbtests + source ./include.tcl + + fileremove -f ALL.OUT + + set exflgs [eval extractflags $args] + set flags [lindex $exflgs 1] + set display 1 + set run 1 + set am_only 0 + set rflags {--} + foreach f $flags { + switch $f { + m { + set am_only 1 + } + n { + set display 1 + set run 0 + set rflags [linsert $rflags 0 "-n"] + } + } + } + + set o [open ALL.OUT a] + if { $run == 1 } { + puts -nonewline "Test suite run started at: " + puts [clock format [clock seconds] -format "%H:%M %D"] + puts [berkdb version -string] + + puts -nonewline $o "Test suite run started at: " + puts $o [clock format [clock seconds] -format "%H:%M %D"] + puts $o [berkdb version -string] + } + close $o + # + # First run standard tests. Send in a -A to let run_std know + # that it is part of the "run_all" run, so that it doesn't + # print out start/end times. + # + lappend args -A + eval {run_std} $args + + set test_pagesizes { 512 8192 65536 } + set args [lindex $exflgs 0] + set save_args $args + + foreach pgsz $test_pagesizes { + set args $save_args + append args " -pagesize $pgsz" + if { $am_only == 0 } { + # Run recovery tests. + # + # XXX These too are broken into separate tclsh + # instantiations so we don't require so much + # memory, but I think it's cleaner + # and more useful to do it down inside proc r than here, + # since "r recd" gets done a lot and needs to work. + puts "Running recovery tests with pagesize $pgsz" + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + r $rflags recd $args" >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: recd test" + close $o + } + } + + # Access method tests. + # + # XXX + # Broken up into separate tclsh instantiations so + # we don't require so much memory. + foreach i \ + "btree rbtree hash queue queueext recno frecno rrecno" { + puts "Running $i tests with pagesize $pgsz" + for { set j 1 } { $j <= $runtests } {incr j} { + if { $run == 0 } { + set o [open ALL.OUT a] + run_method -$i $j $j $display \ + $run $o $args + close $o + } + if { $run } { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + run_method -$i $j $j $display \ + $run stdout $args" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o \ + "FAIL: [format \ + "test%03d" $j] $i" + close $o + } + } + } + + # + # Run subdb tests with varying pagesizes too. + # + if { $run == 0 } { + set o [open ALL.OUT a] + subdb -$i $display $run $o $args + close $o + } + if { $run == 1 } { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + subdb -$i $display $run stdout $args" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o "FAIL: subdb -$i test" + close $o + } + } + } + } + set args $save_args + # + # Run access method tests at default page size in one env. + # + foreach i "btree rbtree hash queue queueext recno frecno rrecno" { + puts "Running $i tests in an env" + if { $run == 0 } { + set o [open ALL.OUT a] + run_envmethod1 -$i 1 $runtests $display \ + $run $o $args + close $o + } + if { $run } { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl; \ + run_envmethod1 -$i 1 $runtests $display \ + $run stdout $args" \ + >>& ALL.OUT } res] { + set o [open ALL.OUT a] + puts $o \ + "FAIL: run_envmethod1 $i" + close $o + } + } + } + + # If not actually running, no need to check for failure. + if { $run == 0 } { + return + } + + set failed 0 + set o [open ALL.OUT r] + while { [gets $o line] >= 0 } { + if { [regexp {^FAIL} $line] != 0 } { + set failed 1 + } + } + close $o + set o [open ALL.OUT a] + if { $failed == 0 } { + puts "Regression Tests Succeeded" + puts $o "Regression Tests Succeeded" + } else { + puts "Regression Tests Failed; see ALL.OUT for log" + puts $o "Regression Tests Failed" + } + + puts -nonewline "Test suite run completed at: " + puts [clock format [clock seconds] -format "%H:%M %D"] + puts -nonewline $o "Test suite run completed at: " + puts $o [clock format [clock seconds] -format "%H:%M %D"] + close $o +} + +# +# Run method tests in one environment. (As opposed to run_envmethod +# which runs each test in its own, new environment.) +# +proc run_envmethod1 { method {start 1} {stop 0} {display 0} {run 1} \ + { outfile stdout } args } { + global __debug_on + global __debug_print + global parms + global runtests + source ./include.tcl + + if { $stop == 0 } { + set stop $runtests + } + if { $run == 1 } { + puts "run_envmethod1: $method $start $stop $args" + } + + set txn "" + if { $run == 1 } { + check_handles + env_cleanup $testdir + error_check_good envremove [berkdb envremove -home $testdir] 0 + set env [eval {berkdb env -create -mode 0644 -home $testdir}] + error_check_good env_open [is_valid_env $env] TRUE + append largs " -env $env " + } + + set stat [catch { + for { set i $start } { $i <= $stop } {incr i} { + set name [format "test%03d" $i] + if { [info exists parms($name)] != 1 } { + puts "[format Test%03d $i] disabled in\ + testparams.tcl; skipping." + continue + } + if { $display } { + puts -nonewline $outfile "eval $name $method" + puts -nonewline $outfile " $parms($name) $args" + puts $outfile " ; verify_dir $testdir \"\" 1" + } + if { $run } { + check_handles $outfile + puts $outfile "[timestamp]" + eval $name $method $parms($name) $largs + if { $__debug_print != 0 } { + puts $outfile "" + } + if { $__debug_on != 0 } { + debug + } + } + flush stdout + flush stderr + } + } res] + if { $run == 1 } { + error_check_good envclose [$env close] 0 + } + if { $stat != 0} { + global errorInfo; + + set fnl [string first "\n" $errorInfo] + set theError [string range $errorInfo 0 [expr $fnl - 1]] + if {[string first FAIL $errorInfo] == -1} { + error "FAIL:[timestamp]\ + run_envmethod1: $method $i: $theError" + } else { + error $theError; + } + } + +} diff --git a/bdb/test/test001.tcl b/bdb/test/test001.tcl new file mode 100644 index 00000000000..fa8e112d100 --- /dev/null +++ b/bdb/test/test001.tcl @@ -0,0 +1,157 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test001.tcl,v 11.17 2000/12/06 16:08:05 bostic Exp $ +# +# DB Test 1 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and data; retrieve each. +# After all are entered, retrieve all; compare output to original. +# Close file, reopen, do retrieve and re-verify. +proc test001 { method {nentries 10000} {start 0} {tnum "01"} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test0$tnum: $method ($args) $nentries equal key/data pairs" + if { $start != 0 } { + puts "\tStarting at $start" + } + + # Create the database and open the dictionary + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args $omethod $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + + set nentries [expr $nentries + $start] + + if { [is_record_based $method] == 1 } { + set checkfunc test001_recno.check + append gflags " -recno" + } else { + set checkfunc test001.check + } + puts "\tTest0$tnum.a: put/get loop" + # Here is the loop where we put and get each key/data pair + set count $start + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) [pad_data $method $str] + } else { + set key $str + set str [reverse $str] + } + set ret [eval \ + {$db put} $txn $pflags {$key [chop_data $method $str]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $str]]] + + # Test DB_GET_BOTH for success + set ret [$db get -get_both $key [pad_data $method $str]] + error_check_good \ + getboth $ret [list [list $key [pad_data $method $str]]] + + # Test DB_GET_BOTH for failure + set ret [$db get -get_both $key [pad_data $method BAD$str]] + error_check_good getbothBAD [llength $ret] 0 + + incr count + if { [expr $count + 1] == 0 } { + incr count + } + } + close $did + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest0$tnum.b: dump file" + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i [expr $start + 1]} {$i <= $nentries} {set i [incr i]} { + if { $i == 0 } { + incr i + } + puts $oid $i + } + close $oid + } else { + set q q + filehead $nentries $dict $t2 + } + filesort $t2 $t3 + file rename -force $t3 $t2 + filesort $t1 $t3 + + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tTest0$tnum.c: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_file $testfile $env $txn $t1 $checkfunc \ + dump_file_direction "-first" "-next" + if { [string compare $omethod "-recno"] != 0 } { + filesort $t1 $t3 + } + + error_check_good Test0$tnum:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tTest0$tnum.d: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 $checkfunc \ + dump_file_direction "-last" "-prev" + + if { [string compare $omethod "-recno"] != 0 } { + filesort $t1 $t3 + } + + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 +} + +# Check function for test001; keys and data are identical +proc test001.check { key data } { + error_check_good "key/data mismatch" $data [reverse $key] +} + +proc test001_recno.check { key data } { + global dict + global kvals + + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "key/data mismatch, key $key" $data $kvals($key) +} diff --git a/bdb/test/test002.tcl b/bdb/test/test002.tcl new file mode 100644 index 00000000000..882240b77bb --- /dev/null +++ b/bdb/test/test002.tcl @@ -0,0 +1,128 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test002.tcl,v 11.13 2000/08/25 14:21:53 sue Exp $ +# +# DB Test 2 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and a fixed, medium length data string; +# retrieve each. After all are entered, retrieve all; compare output +# to original. Close file, reopen, do retrieve and re-verify. + +set datastr abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz + +proc test002 { method {nentries 10000} args } { + global datastr + global pad_datastr + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test002: $method ($args) $nentries key <fixed data> pairs" + + 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/test002.db + set env NULL + } else { + set testfile test002.db + incr eindex + set env [lindex $args $eindex] + } + # Create the database and open the dictionary + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put and get each key/data pair + + if { [is_record_based $method] == 1 } { + append gflags "-recno" + } + set pad_datastr [pad_data $method $datastr] + puts "\tTest002.a: put/get loop" + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + } else { + set key $str + } + set ret [eval {$db put} $txn $pflags {$key [chop_data $method $datastr]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags {$key}] + + error_check_good get $ret [list [list $key [pad_data $method $datastr]]] + incr count + } + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest002.b: dump file" + dump_file $db $txn $t1 test002.check + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {set i [incr i]} { + puts $oid $i + } + close $oid + filesort $t2 $t3 + file rename -force $t3 $t2 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + } + filesort $t1 $t3 + + error_check_good Test002:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again. + puts "\tTest002.c: close, open, and dump file" + open_and_dump_file $testfile $env $txn $t1 test002.check \ + dump_file_direction "-first" "-next" + + if { [string compare $omethod "-recno"] != 0 } { + filesort $t1 $t3 + } + error_check_good Test002:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again in reverse direction. + puts "\tTest002.d: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 test002.check \ + dump_file_direction "-last" "-prev" + + if { [string compare $omethod "-recno"] != 0 } { + filesort $t1 $t3 + } + error_check_good Test002:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 +} + +# Check function for test002; data should be fixed are identical +proc test002.check { key data } { + global pad_datastr + error_check_good "data mismatch for key $key" $data $pad_datastr +} diff --git a/bdb/test/test003.tcl b/bdb/test/test003.tcl new file mode 100644 index 00000000000..013af2d419c --- /dev/null +++ b/bdb/test/test003.tcl @@ -0,0 +1,177 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test003.tcl,v 11.18 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 3 {access method} +# 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. +proc test003 { method args} { + global names + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if {[is_fixed_length $method] == 1} { + puts "Test003 skipping for method $method" + return + } + puts "Test003: $method ($args) filename=key filecontents=data pairs" + + # Create the database and open the dictionary + 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/test003.db + set env NULL + } else { + set testfile test003.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set t4 $testdir/t4 + + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args $omethod $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + set pflags "" + set gflags "" + set txn "" + if { [is_record_based $method] == 1 } { + set checkfunc test003_recno.check + append gflags "-recno" + } else { + set checkfunc test003.check + } + + # Here is the loop where we put and get each key/data pair + set file_list [ glob \ + { $test_path/../*/*.[ch] } $test_path/*.tcl *.{a,o,lo,exe} \ + $test_path/file.1 ] + + puts "\tTest003.a: put/get loop" + set count 0 + foreach f $file_list { + if { [string compare [file type $f] "file"] != 0 } { + continue + } + + 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 data [read $fid] + close $fid + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $data]}] + error_check_good put $ret 0 + + # Should really catch errors + set fid [open $t4 w] + fconfigure $fid -translation binary + if [catch {eval {$db get} $gflags {$key}} data] { + puts -nonewline $fid $data + } else { + # Data looks like {{key data}} + set key [lindex [lindex $data 0] 0] + set data [lindex [lindex $data 0] 1] + puts -nonewline $fid [pad_data $method $data] + } + close $fid + + error_check_good \ + Test003:diff($f,$t4) [filecmp $f $t4] 0 + + incr count + } + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest003.b: dump file" + dump_bin_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the entries in the + # current directory + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $count} {set i [incr i]} { + puts $oid $i + } + close $oid + file rename -force $t1 $t3 + } else { + set oid [open $t2.tmp w] + foreach f $file_list { + if { [string compare [file type $f] "file"] != 0 } { + continue + } + puts $oid $f + } + close $oid + filesort $t2.tmp $t2 + fileremove $t2.tmp + filesort $t1 $t3 + } + + error_check_good \ + Test003:diff($t3,$t2) [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again. + puts "\tTest003.c: close, open, and dump file" + open_and_dump_file $testfile $env $txn $t1 $checkfunc \ + dump_bin_file_direction "-first" "-next" + + if { [is_record_based $method] == 1 } { + filesort $t1 $t3 -n + } + + error_check_good \ + Test003:diff($t3,$t2) [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again in reverse direction. + puts "\tTest003.d: close, open, and dump file in reverse direction" + + open_and_dump_file $testfile $env $txn $t1 $checkfunc \ + dump_bin_file_direction "-last" "-prev" + + if { [is_record_based $method] == 1 } { + filesort $t1 $t3 -n + } + + error_check_good \ + Test003:diff($t3,$t2) [filecmp $t3 $t2] 0 +} + +# Check function for test003; key should be file name; data should be contents +proc test003.check { binfile tmpfile } { + source ./include.tcl + + error_check_good Test003:datamismatch($binfile,$tmpfile) \ + [filecmp $binfile $tmpfile] 0 +} +proc test003_recno.check { binfile tmpfile } { + global names + source ./include.tcl + + set fname $names($binfile) + error_check_good key"$binfile"_exists [info exists names($binfile)] 1 + error_check_good Test003:datamismatch($fname,$tmpfile) \ + [filecmp $fname $tmpfile] 0 +} diff --git a/bdb/test/test004.tcl b/bdb/test/test004.tcl new file mode 100644 index 00000000000..0b076d6cfb7 --- /dev/null +++ b/bdb/test/test004.tcl @@ -0,0 +1,134 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test004.tcl,v 11.15 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 4 {access method} +# Check that cursor operations work. Create a database. +# Read through the database sequentially using cursors and +# delete each element. +proc test004 { method {nentries 10000} {reopen 4} {build_only 0} args} { + source ./include.tcl + + set do_renumber [is_rrecno $method] + set args [convert_args $method $args] + set omethod [convert_method $method] + + set tnum test00$reopen + + puts -nonewline "$tnum:\ + $method ($args) $nentries delete small key; medium data pairs" + if {$reopen == 5} { + puts "(with close)" + } else { + puts "" + } + + # Create the database and open the dictionary + 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/test004.db + set env NULL + } else { + set testfile test004.db + incr eindex + set env [lindex $args $eindex] + } + # Create the database and open the dictionary + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + set db [eval {berkdb_open -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + + # Here is the loop where we put and get each key/data pair + set kvals "" + puts "\tTest00$reopen.a: put/get loop" + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + lappend kvals $str + } else { + set key $str + } + + set datastr [ make_data_str $str ] + + set ret [eval {$db put} $txn $pflags {$key [chop_data $method $datastr]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags {$key}] + error_check_good "$tnum:put" $ret \ + [list [list $key [pad_data $method $datastr]]] + incr count + } + close $did + if { $build_only == 1 } { + return $db + } + if { $reopen == 5 } { + error_check_good db_close [$db close] 0 + + set db [eval {berkdb_open} $args {$testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + } + puts "\tTest00$reopen.b: get/delete loop" + # Now we will get each key from the DB and compare the results + # to the original, then delete it. + set outf [open $t1 w] + set c [eval {$db cursor} $txn] + + set count 0 + for {set d [$c get -first] } { [llength $d] != 0 } { + set d [$c get -next] } { + set k [lindex [lindex $d 0] 0] + set d2 [lindex [lindex $d 0] 1] + if { [is_record_based $method] == 1 } { + set datastr \ + [make_data_str [lindex $kvals [expr $k - 1]]] + } else { + set datastr [make_data_str $k] + } + error_check_good $tnum:$k $d2 [pad_data $method $datastr] + puts $outf $k + $c del + if { [is_record_based $method] == 1 && \ + $do_renumber == 1 } { + set kvals [lreplace $kvals 0 0] + } + incr count + } + close $outf + error_check_good curs_close [$c close] 0 + + # Now compare the keys to see if they match the dictionary + if { [is_record_based $method] == 1 } { + error_check_good test00$reopen:keys_deleted $count $nentries + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + error_check_good Test00$reopen:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + } + + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test005.tcl b/bdb/test/test005.tcl new file mode 100644 index 00000000000..4cb5d88dfe2 --- /dev/null +++ b/bdb/test/test005.tcl @@ -0,0 +1,14 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test005.tcl,v 11.4 2000/05/22 12:51:38 bostic Exp $ +# +# DB Test 5 {access method} +# Check that cursor operations work. Create a database; close database and +# reopen it. Then read through the database sequentially using cursors and +# delete each element. +proc test005 { method {nentries 10000} args } { + eval {test004 $method $nentries 5 0} $args +} diff --git a/bdb/test/test006.tcl b/bdb/test/test006.tcl new file mode 100644 index 00000000000..9364d2a4f60 --- /dev/null +++ b/bdb/test/test006.tcl @@ -0,0 +1,118 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test006.tcl,v 11.13 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 6 {access method} +# Keyed delete test. +# Create database. +# Go through database, deleting all entries by key. +proc test006 { method {nentries 10000} {reopen 0} {tnum 6} args} { + source ./include.tcl + + set do_renumber [is_rrecno $method] + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { $tnum < 10 } { + set tname Test00$tnum + set dbname test00$tnum + } else { + set tname Test0$tnum + set dbname test0$tnum + } + puts -nonewline "$tname: $method ($args) " + puts -nonewline "$nentries equal small key; medium data pairs" + if {$reopen == 1} { + puts " (with close)" + } else { + puts "" + } + + # Create the database and open the dictionary + 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/$dbname.db + set env NULL + } else { + set testfile $dbname.db + incr eindex + set env [lindex $args $eindex] + } + + set pflags "" + set gflags "" + set txn "" + set count 0 + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + + # Here is the loop where we put and get each key/data pair + + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1 ] + } else { + set key $str + } + + set datastr [make_data_str $str] + + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $datastr]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags {$key}] + error_check_good "$tname: put $datastr got $ret" \ + $ret [list [list $key [pad_data $method $datastr]]] + incr count + } + close $did + + if { $reopen == 1 } { + error_check_good db_close [$db close] 0 + + set db [eval {berkdb_open} $args {$testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + } + + # Now we will get each key from the DB and compare the results + # to the original, then delete it. + set count 0 + set did [open $dict] + set key 0 + while { [gets $did str] != -1 && $count < $nentries } { + if { $do_renumber == 1 } { + set key 1 + } elseif { [is_record_based $method] == 1 } { + incr key + } else { + set key $str + } + + set datastr [make_data_str $str] + + set ret [eval {$db get} $gflags {$key}] + error_check_good "$tname: get $datastr got $ret" \ + $ret [list [list $key [pad_data $method $datastr]]] + + set ret [eval {$db del} $txn {$key}] + error_check_good db_del:$key $ret 0 + incr count + } + close $did + + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test007.tcl b/bdb/test/test007.tcl new file mode 100644 index 00000000000..305740f0369 --- /dev/null +++ b/bdb/test/test007.tcl @@ -0,0 +1,13 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test007.tcl,v 11.5 2000/05/22 12:51:38 bostic Exp $ +# +# DB Test 7 {access method} +# Check that delete operations work. Create a database; close database and +# reopen it. Then issues delete by key for each entry. +proc test007 { method {nentries 10000} {tnum 7} args} { + eval {test006 $method $nentries 1 $tnum} $args +} diff --git a/bdb/test/test008.tcl b/bdb/test/test008.tcl new file mode 100644 index 00000000000..34144391ccc --- /dev/null +++ b/bdb/test/test008.tcl @@ -0,0 +1,138 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test008.tcl,v 11.17 2000/10/19 17:35:39 sue Exp $ +# +# DB Test 8 {access method} +# Take the source files and dbtest executable and enter their names as the +# key with their contents as data. After all are entered, begin looping +# through the entries; deleting some pairs and then readding them. +proc test008 { method {nentries 10000} {reopen 8} {debug 0} args} { + source ./include.tcl + + set tnum test00$reopen + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 } { + puts "Test00$reopen skipping for method $method" + return + } + + puts -nonewline "$tnum: $method filename=key filecontents=data pairs" + if {$reopen == 9} { + puts "(with close)" + } else { + puts "" + } + + # Create the database and open the dictionary + 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/$tnum.db + set env NULL + } else { + set testfile $tnum.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set t4 $testdir/t4 + + cleanup $testdir $env + + set db [eval {berkdb_open -create -truncate -mode 0644} \ + $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set pflags "" + set gflags "" + set txn "" + + # Here is the loop where we put and get each key/data pair + set file_list [glob ../*/*.c ./*.o ./*.lo ./*.exe] + + set count 0 + puts "\tTest00$reopen.a: Initial put/get loop" + foreach f $file_list { + set names($count) $f + set key $f + + put_file $db $txn $pflags $f + + get_file $db $txn $gflags $f $t4 + + error_check_good Test00$reopen:diff($f,$t4) \ + [filecmp $f $t4] 0 + + incr count + } + + if {$reopen == 9} { + error_check_good db_close [$db close] 0 + + set db [eval {berkdb_open} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + } + + # Now we will get step through keys again (by increments) and + # delete all the entries, then re-insert them. + + puts "\tTest00$reopen.b: Delete re-add loop" + foreach i "1 2 4 8 16" { + for {set ndx 0} {$ndx < $count} { incr ndx $i} { + set r [eval {$db del} $txn {$names($ndx)}] + error_check_good db_del:$names($ndx) $r 0 + } + for {set ndx 0} {$ndx < $count} { incr ndx $i} { + put_file $db $txn $pflags $names($ndx) + } + } + + if {$reopen == 9} { + error_check_good db_close [$db close] 0 + set db [eval {berkdb_open} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + } + + # Now, reopen the file and make sure the key/data pairs look right. + puts "\tTest00$reopen.c: Dump contents forward" + dump_bin_file $db $txn $t1 test008.check + + set oid [open $t2.tmp w] + foreach f $file_list { + puts $oid $f + } + close $oid + filesort $t2.tmp $t2 + fileremove $t2.tmp + filesort $t1 $t3 + + error_check_good Test00$reopen:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again in reverse direction. + puts "\tTest00$reopen.d: Dump contents backward" + dump_bin_file_direction $db $txn $t1 test008.check "-last" "-prev" + + filesort $t1 $t3 + + error_check_good Test00$reopen:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + error_check_good close:$db [$db close] 0 +} + +proc test008.check { binfile tmpfile } { + global tnum + source ./include.tcl + + error_check_good diff($binfile,$tmpfile) \ + [filecmp $binfile $tmpfile] 0 +} diff --git a/bdb/test/test009.tcl b/bdb/test/test009.tcl new file mode 100644 index 00000000000..e9c01875f77 --- /dev/null +++ b/bdb/test/test009.tcl @@ -0,0 +1,15 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test009.tcl,v 11.4 2000/05/22 12:51:38 bostic Exp $ +# +# DB Test 9 {access method} +# Check that we reuse overflow pages. Create database with lots of +# big key/data pairs. Go through and delete and add keys back +# randomly. Then close the DB and make sure that we have everything +# we think we should. +proc test009 { method {nentries 10000} args} { + eval {test008 $method $nentries 9 0} $args +} diff --git a/bdb/test/test010.tcl b/bdb/test/test010.tcl new file mode 100644 index 00000000000..b3aedb2bee9 --- /dev/null +++ b/bdb/test/test010.tcl @@ -0,0 +1,126 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test010.tcl,v 11.14 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 10 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and data; add duplicate +# records for each. +# After all are entered, retrieve all; verify output. +# Close file, reopen, do retrieve and re-verify. +# This does not work for recno +proc test010 { method {nentries 10000} {ndups 5} {tnum 10} args } { + source ./include.tcl + + set omethod $method + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $method" + return + } + + puts "Test0$tnum: $method ($args) $nentries small dup key/data pairs" + + # Create the database and open the dictionary + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + + cleanup $testdir $env + + set db [eval {berkdb_open \ + -create -truncate -mode 0644 -dup} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put and get each key/data pair + set dbc [eval {$db cursor} $txn] + while { [gets $did str] != -1 && $count < $nentries } { + for { set i 1 } { $i <= $ndups } { incr i } { + set datastr $i:$str + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good put $ret 0 + } + + # Now retrieve all the keys matching this key + set x 1 + for {set ret [$dbc get "-set" $str]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get "-next"] } { + if {[llength $ret] == 0} { + break + } + set k [lindex [lindex $ret 0] 0] + if { [string compare $k $str] != 0 } { + break + } + set datastr [lindex [lindex $ret 0] 1] + set d [data_of $datastr] + error_check_good "Test0$tnum:get" $d $str + set id [ id_of $datastr ] + error_check_good "Test0$tnum:dup#" $id $x + incr x + } + error_check_good "Test0$tnum:ndups:$str" [expr $x - 1] $ndups + incr count + } + error_check_good cursor_close [$dbc close] 0 + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest0$tnum.a: Checking file for correct duplicates" + set dlist "" + for { set i 1 } { $i <= $ndups } {incr i} { + lappend dlist $i + } + dup_check $db $txn $t1 $dlist + + # Now compare the keys to see if they match the dictionary entries + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + error_check_good db_close [$db close] 0 + set db [eval {berkdb_open} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + puts "\tTest0$tnum.b: Checking file for correct duplicates after close" + dup_check $db $txn $t1 $dlist + + # Now compare the keys to see if they match the dictionary entries + filesort $t1 $t3 + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test011.tcl b/bdb/test/test011.tcl new file mode 100644 index 00000000000..444f6240e92 --- /dev/null +++ b/bdb/test/test011.tcl @@ -0,0 +1,349 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test011.tcl,v 11.20 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 11 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and data; add duplicate +# records for each. +# Then do some key_first/key_last add_before, add_after operations. +# This does not work for recno +# To test if dups work when they fall off the main page, run this with +# a very tiny page size. +proc test011 { method {nentries 10000} {ndups 5} {tnum 11} args } { + global dlist + global rand_init + source ./include.tcl + + set dlist "" + + if { [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $method" + return + } + if { [is_record_based $method] == 1 } { + test011_recno $method $nentries $tnum $args + return + } else { + puts -nonewline "Test0$tnum: $method $nentries small dup " + puts "key/data pairs, cursor ops" + } + if {$ndups < 5} { + set ndups 5 + } + + set args [convert_args $method $args] + set omethod [convert_method $method] + + berkdb srand $rand_init + + # Create the database and open the dictionary + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + set db [eval {berkdb_open -create -truncate \ + -mode 0644} [concat $args "-dup"] {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put and get each key/data pair + # We will add dups with values 1, 3, ... $ndups. Then we'll add + # 0 and $ndups+1 using keyfirst/keylast. We'll add 2 and 4 using + # add before and add after. + puts "\tTest0$tnum.a: put and get duplicate keys." + set dbc [eval {$db cursor} $txn] + set i "" + for { set i 1 } { $i <= $ndups } { incr i 2 } { + lappend dlist $i + } + set maxodd $i + while { [gets $did str] != -1 && $count < $nentries } { + for { set i 1 } { $i <= $ndups } { incr i 2 } { + set datastr $i:$str + set ret [eval {$db put} $txn $pflags {$str $datastr}] + error_check_good put $ret 0 + } + + # Now retrieve all the keys matching this key + set x 1 + for {set ret [$dbc get "-set" $str ]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get "-next"] } { + if {[llength $ret] == 0} { + break + } + set k [lindex [lindex $ret 0] 0] + if { [string compare $k $str] != 0 } { + break + } + set datastr [lindex [lindex $ret 0] 1] + set d [data_of $datastr] + + error_check_good Test0$tnum:put $d $str + set id [ id_of $datastr ] + error_check_good Test0$tnum:dup# $id $x + incr x 2 + } + error_check_good Test0$tnum:numdups $x $maxodd + incr count + } + error_check_good curs_close [$dbc close] 0 + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest0$tnum.b: \ + traverse entire file checking duplicates before close." + dup_check $db $txn $t1 $dlist + + # Now compare the keys to see if they match the dictionary entries + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + error_check_good db_close [$db close] 0 + + set db [eval {berkdb_open} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + puts "\tTest0$tnum.c: \ + traverse entire file checking duplicates after close." + dup_check $db $txn $t1 $dlist + + # Now compare the keys to see if they match the dictionary entries + filesort $t1 $t3 + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tTest0$tnum.d: Testing key_first functionality" + add_dup $db $txn $nentries "-keyfirst" 0 0 + set dlist [linsert $dlist 0 0] + dup_check $db $txn $t1 $dlist + + puts "\tTest0$tnum.e: Testing key_last functionality" + add_dup $db $txn $nentries "-keylast" [expr $maxodd - 1] 0 + lappend dlist [expr $maxodd - 1] + dup_check $db $txn $t1 $dlist + + puts "\tTest0$tnum.f: Testing add_before functionality" + add_dup $db $txn $nentries "-before" 2 3 + set dlist [linsert $dlist 2 2] + dup_check $db $txn $t1 $dlist + + puts "\tTest0$tnum.g: Testing add_after functionality" + add_dup $db $txn $nentries "-after" 4 4 + set dlist [linsert $dlist 4 4] + dup_check $db $txn $t1 $dlist + + error_check_good db_close [$db close] 0 +} + +proc add_dup {db txn nentries flag dataval iter} { + source ./include.tcl + + set dbc [eval {$db cursor} $txn] + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < $nentries } { + set datastr $dataval:$str + set ret [$dbc get "-set" $str] + error_check_bad "cget(SET)" [is_substr $ret Error] 1 + for { set i 1 } { $i < $iter } { incr i } { + set ret [$dbc get "-next"] + error_check_bad "cget(NEXT)" [is_substr $ret Error] 1 + } + + if { [string compare $flag "-before"] == 0 || + [string compare $flag "-after"] == 0 } { + set ret [$dbc put $flag $datastr] + } else { + set ret [$dbc put $flag $str $datastr] + } + error_check_good "$dbc put $flag" $ret 0 + incr count + } + close $did + $dbc close +} + +proc test011_recno { method {nentries 10000} {tnum 11} largs } { + global dlist + source ./include.tcl + + set largs [convert_args $method $largs] + set omethod [convert_method $method] + set renum [is_rrecno $method] + + puts "Test0$tnum: \ + $method ($largs) $nentries test cursor insert functionality" + + # Create the database and open the dictionary + set eindex [lsearch -exact $largs "-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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $largs $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + if {$renum == 1} { + append largs " -renumber" + } + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $largs {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # The basic structure of the test is that we pick a random key + # in the database and then add items before, after, ?? it. The + # trickiness is that with RECNO, these are not duplicates, they + # are creating new keys. Therefore, every time we do this, the + # keys assigned to other values change. For this reason, we'll + # keep the database in tcl as a list and insert properly into + # it to verify that the right thing is happening. If we do not + # have renumber set, then the BEFORE and AFTER calls should fail. + + # Seed the database with an initial record + gets $did str + set ret [eval {$db put} $txn {1 [chop_data $method $str]}] + error_check_good put $ret 0 + set count 1 + + set dlist "NULL $str" + + # Open a cursor + set dbc [eval {$db cursor} $txn] + puts "\tTest0$tnum.a: put and get entries" + while { [gets $did str] != -1 && $count < $nentries } { + # Pick a random key + set key [berkdb random_int 1 $count] + set ret [$dbc get -set $key] + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_good cget:SET:key $k $key + error_check_good \ + cget:SET $d [pad_data $method [lindex $dlist $key]] + + # Current + set ret [$dbc put -current [chop_data $method $str]] + error_check_good cput:$key $ret 0 + set dlist [lreplace $dlist $key $key [pad_data $method $str]] + + # Before + if { [gets $did str] == -1 } { + continue; + } + + if { $renum == 1 } { + set ret [$dbc put \ + -before [chop_data $method $str]] + error_check_good cput:$key:BEFORE $ret $key + set dlist [linsert $dlist $key $str] + incr count + + # After + if { [gets $did str] == -1 } { + continue; + } + set ret [$dbc put \ + -after [chop_data $method $str]] + error_check_good cput:$key:AFTER $ret [expr $key + 1] + set dlist [linsert $dlist [expr $key + 1] $str] + incr count + } + + # Now verify that the keys are in the right place + set i 0 + for {set ret [$dbc get "-set" $key]} \ + {[string length $ret] != 0 && $i < 3} \ + {set ret [$dbc get "-next"] } { + set check_key [expr $key + $i] + + set k [lindex [lindex $ret 0] 0] + error_check_good cget:$key:loop $k $check_key + + set d [lindex [lindex $ret 0] 1] + error_check_good cget:data $d \ + [pad_data $method [lindex $dlist $check_key]] + incr i + } + } + close $did + error_check_good cclose [$dbc close] 0 + + # Create check key file. + set oid [open $t2 w] + for {set i 1} {$i <= $count} {incr i} { + puts $oid $i + } + close $oid + + puts "\tTest0$tnum.b: dump file" + dump_file $db $txn $t1 test011_check + error_check_good Test0$tnum:diff($t2,$t1) \ + [filecmp $t2 $t1] 0 + + error_check_good db_close [$db close] 0 + + puts "\tTest0$tnum.c: close, open, and dump file" + open_and_dump_file $testfile $env $txn $t1 test011_check \ + dump_file_direction "-first" "-next" + error_check_good Test0$tnum:diff($t2,$t1) \ + [filecmp $t2 $t1] 0 + + puts "\tTest0$tnum.d: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 test011_check \ + dump_file_direction "-last" "-prev" + + filesort $t1 $t3 -n + error_check_good Test0$tnum:diff($t2,$t3) \ + [filecmp $t2 $t3] 0 +} + +proc test011_check { key data } { + global dlist + + error_check_good "get key $key" $data [lindex $dlist $key] +} diff --git a/bdb/test/test012.tcl b/bdb/test/test012.tcl new file mode 100644 index 00000000000..87127901e19 --- /dev/null +++ b/bdb/test/test012.tcl @@ -0,0 +1,113 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test012.tcl,v 11.14 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 12 {access method} +# Take the source files and dbtest executable and enter their contents as +# the key with their names as data. After all are entered, retrieve all; +# compare output to original. Close file, reopen, do retrieve and re-verify. +proc test012 { method args} { + global names + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 } { + puts "Test012 skipping for method $method" + return + } + + puts "Test012: $method ($args) filename=data filecontents=key pairs" + + # Create the database and open the dictionary + 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/test012.db + set env NULL + } else { + set testfile test012.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set t4 $testdir/t4 + + cleanup $testdir $env + + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set pflags "" + set gflags "" + set txn "" + + # Here is the loop where we put and get each key/data pair + set file_list [glob $test_path/../\[a-z\]*/*.c \ + $test_path/./*.lo ./*.exe] + + puts "\tTest012.a: put/get loop" + set count 0 + foreach f $file_list { + put_file_as_key $db $txn $pflags $f + + set kd [get_file_as_key $db $txn $gflags $f] + incr count + } + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest012.b: dump file" + dump_binkey_file $db $txn $t1 test012.check + error_check_good db_close [$db close] 0 + + # Now compare the data to see if they match the .o and dbtest files + set oid [open $t2.tmp w] + foreach f $file_list { + puts $oid $f + } + close $oid + filesort $t2.tmp $t2 + fileremove $t2.tmp + filesort $t1 $t3 + + error_check_good Test012:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again. + puts "\tTest012.c: close, open, and dump file" + open_and_dump_file $testfile $env $txn $t1 test012.check \ + dump_binkey_file_direction "-first" "-next" + + filesort $t1 $t3 + + error_check_good Test012:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again in reverse direction. + puts "\tTest012.d: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 test012.check\ + dump_binkey_file_direction "-last" "-prev" + + filesort $t1 $t3 + + error_check_good Test012:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 +} + +# Check function for test012; key should be file name; data should be contents +proc test012.check { binfile tmpfile } { + source ./include.tcl + + error_check_good Test012:diff($binfile,$tmpfile) \ + [filecmp $binfile $tmpfile] 0 +} diff --git a/bdb/test/test013.tcl b/bdb/test/test013.tcl new file mode 100644 index 00000000000..5812cf8f64d --- /dev/null +++ b/bdb/test/test013.tcl @@ -0,0 +1,193 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test013.tcl,v 11.18 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 13 {access method} +# +# 1. Insert 10000 keys and retrieve them (equal key/data pairs). +# 2. Attempt to overwrite keys with NO_OVERWRITE set (expect error). +# 3. Actually overwrite each one with its datum reversed. +# +# No partial testing here. +proc test013 { method {nentries 10000} args } { + global errorCode + global errorInfo + global fixed_pad + global fixed_len + + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test013: $method ($args) $nentries equal key/data pairs, put test" + + # Create the database and open the dictionary + 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/test013.db + set env NULL + } else { + set testfile test013.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + set checkfunc test013_recno.check + append gflags " -recno" + global kvals + } else { + set checkfunc test013.check + } + puts "\tTest013.a: put/get loop" + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + set kvals($key) [pad_data $method $str] + } else { + set key $str + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $str]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags $txn {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $str]]] + incr count + } + close $did + + # Now we will try to overwrite each datum, but set the + # NOOVERWRITE flag. + puts "\tTest013.b: overwrite values with NOOVERWRITE flag." + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + } else { + set key $str + } + + set ret [eval {$db put} $txn $pflags \ + {-nooverwrite $key [chop_data $method $str]}] + error_check_good put [is_substr $ret "DB_KEYEXIST"] 1 + + # Value should be unchanged. + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $str]]] + incr count + } + close $did + + # Now we will replace each item with its datum capitalized. + puts "\tTest013.c: overwrite values with capitalized datum" + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + } else { + set key $str + } + set rstr [string toupper $str] + set r [eval {$db put} \ + $txn $pflags {$key [chop_data $method $rstr]}] + error_check_good put $r 0 + + # Value should be changed. + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $rstr]]] + incr count + } + close $did + + # Now make sure that everything looks OK + puts "\tTest013.d: check entire file contents" + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {incr i} { + puts $oid $i + } + close $oid + file rename -force $t1 $t3 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good \ + Test013:diff($t3,$t2) [filecmp $t3 $t2] 0 + + puts "\tTest013.e: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_file $testfile $env $txn $t1 $checkfunc \ + dump_file_direction "-first" "-next" + + if { [is_record_based $method] == 0 } { + filesort $t1 $t3 + } + + error_check_good \ + Test013:diff($t3,$t2) [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tTest013.f: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 $checkfunc \ + dump_file_direction "-last" "-prev" + + if { [is_record_based $method] == 0 } { + filesort $t1 $t3 + } + + error_check_good \ + Test013:diff($t3,$t2) [filecmp $t3 $t2] 0 +} + +# Check function for test013; keys and data are identical +proc test013.check { key data } { + error_check_good \ + "key/data mismatch for $key" $data [string toupper $key] +} + +proc test013_recno.check { key data } { + global dict + global kvals + + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good \ + "data mismatch for $key" $data [string toupper $kvals($key)] +} diff --git a/bdb/test/test014.tcl b/bdb/test/test014.tcl new file mode 100644 index 00000000000..3ad5335dd0a --- /dev/null +++ b/bdb/test/test014.tcl @@ -0,0 +1,204 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test014.tcl,v 11.19 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 14 {access method} +# +# Partial put test, small data, replacing with same size. The data set +# consists of the first nentries of the dictionary. We will insert them +# (and retrieve them) as we do in test 1 (equal key/data pairs). Then +# we'll try to perform partial puts of some characters at the beginning, +# some at the end, and some at the middle. +proc test014 { method {nentries 10000} args } { + set fixed 0 + set args [convert_args $method $args] + + if { [is_fixed_length $method] == 1 } { + set fixed 1 + } + + puts "Test014: $method ($args) $nentries equal key/data pairs, put test" + + # flagp indicates whether this is a postpend or a + # normal partial put + set flagp 0 + + eval {test014_body $method $flagp 1 1 $nentries} $args + eval {test014_body $method $flagp 1 4 $nentries} $args + eval {test014_body $method $flagp 2 4 $nentries} $args + eval {test014_body $method $flagp 1 128 $nentries} $args + eval {test014_body $method $flagp 2 16 $nentries} $args + if { $fixed == 0 } { + eval {test014_body $method $flagp 0 1 $nentries} $args + eval {test014_body $method $flagp 0 4 $nentries} $args + eval {test014_body $method $flagp 0 128 $nentries} $args + + # POST-PENDS : + # partial put data after the end of the existent record + # chars: number of empty spaces that will be padded with null + # increase: is the length of the str to be appended (after pad) + # + set flagp 1 + eval {test014_body $method $flagp 1 1 $nentries} $args + eval {test014_body $method $flagp 4 1 $nentries} $args + eval {test014_body $method $flagp 128 1 $nentries} $args + eval {test014_body $method $flagp 1 4 $nentries} $args + eval {test014_body $method $flagp 1 128 $nentries} $args + } + puts "Test014 complete." +} + +proc test014_body { method flagp chars increase {nentries 10000} args } { + source ./include.tcl + + set omethod [convert_method $method] + + if { [is_fixed_length $method] == 1 && $chars != $increase } { + puts "Test014: $method: skipping replace\ + $chars chars with string $increase times larger." + return + } + + if { $flagp == 1} { + puts "Test014: Postpending string of len $increase with \ + gap $chars." + } else { + puts "Test014: Replace $chars chars with string \ + $increase times larger" + } + + # Create the database and open the dictionary + 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/test014.db + set env NULL + } else { + set testfile test014.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set gflags "" + set pflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + + puts "\tTest014.a: put/get loop" + # Here is the loop where we put and get each key/data pair + # We will do the initial put and then three Partial Puts + # for the beginning, middle and end of the string. + set did [open $dict] + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + } else { + set key $str + } + if { $flagp == 1 } { + # this is for postpend only + global dvals + + # initial put + set ret [$db put $key $str] + error_check_good dbput $ret 0 + + set offset [string length $str] + + # increase is the actual number of new bytes + # to be postpended (besides the null padding) + set data [repeat "P" $increase] + + # chars is the amount of padding in between + # the old data and the new + set len [expr $offset + $chars + $increase] + set dvals($key) [binary format \ + a[set offset]x[set chars]a[set increase] \ + $str $data] + set offset [expr $offset + $chars] + set ret [$db put -partial [list $offset 0] $key $data] + error_check_good dbput:post $ret 0 + } else { + partial_put $method $db $txn \ + $gflags $key $str $chars $increase + } + incr count + } + close $did + + # Now make sure that everything looks OK + puts "\tTest014.b: check entire file contents" + dump_file $db $txn $t1 test014.check + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {set i [incr i]} { + puts $oid $i + } + close $oid + file rename -force $t1 $t3 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good \ + Test014:diff($t3,$t2) [filecmp $t3 $t2] 0 + + puts "\tTest014.c: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_file $testfile $env $txn \ + $t1 test014.check dump_file_direction "-first" "-next" + + if { [string compare $omethod "-recno"] != 0 } { + filesort $t2 $t3 + file rename -force $t3 $t2 + filesort $t1 $t3 + } + + error_check_good \ + Test014:diff($t3,$t2) [filecmp $t3 $t2] 0 + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tTest014.d: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 \ + test014.check dump_file_direction "-last" "-prev" + + if { [string compare $omethod "-recno"] != 0 } { + filesort $t2 $t3 + file rename -force $t3 $t2 + filesort $t1 $t3 + } + + error_check_good \ + Test014:diff($t3,$t2) [filecmp $t3 $t2] 0 +} + +# Check function for test014; keys and data are identical +proc test014.check { key data } { + global dvals + + error_check_good key"$key"_exists [info exists dvals($key)] 1 + error_check_good "data mismatch for key $key" $data $dvals($key) +} diff --git a/bdb/test/test015.tcl b/bdb/test/test015.tcl new file mode 100644 index 00000000000..61abddd3799 --- /dev/null +++ b/bdb/test/test015.tcl @@ -0,0 +1,235 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test015.tcl,v 11.20 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 15 {access method} +# Partial put test when item does not exist. +proc test015 { method {nentries 7500} { start 0 } args } { + global fixed_len + + set low_range 50 + set mid_range 100 + set high_range 1000 + + if { [is_fixed_length $method] } { + set low_range [expr $fixed_len/2 - 2] + set mid_range [expr $fixed_len/2] + set high_range $fixed_len + } + + set t_table { + { 1 { 1 1 1 } } + { 2 { 1 1 5 } } + { 3 { 1 1 $low_range } } + { 4 { 1 $mid_range 1 } } + { 5 { $mid_range $high_range 5 } } + { 6 { 1 $mid_range $low_range } } + } + + puts "Test015: \ + $method ($args) $nentries equal key/data pairs, partial put test" + test015_init + if { $start == 0 } { + set start { 1 2 3 4 5 6 } + } + foreach entry $t_table { + set this [lindex $entry 0] + if { [lsearch $start $this] == -1 } { + continue + } + puts -nonewline "$this: " + eval [concat test015_body $method [lindex $entry 1] \ + $nentries $args] + } +} + +proc test015_init { } { + global rand_init + + berkdb srand $rand_init +} + +proc test015_body { method off_low off_hi rcount {nentries 10000} args } { + global dvals + global fixed_len + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + set checkfunc test015.check + + if { [is_fixed_length $method] && \ + [string compare $omethod "-recno"] == 0} { + # is fixed recno method + set checkfunc test015.check + } + + puts "Put $rcount strings random offsets between $off_low and $off_hi" + + # Create the database and open the dictionary + 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/test015.db + set env NULL + } else { + set testfile test015.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set pflags "" + set gflags "" + set txn "" + set count 0 + + puts "\tTest015.a: put/get loop" + + # Here is the loop where we put and get each key/data pair + # Each put is a partial put of a record that does not exist. + set did [open $dict] + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + if { [string length $str] > $fixed_len } { + continue + } + set key [expr $count + 1] + } else { + set key $str + } + + if { 0 } { + set data [replicate $str $rcount] + set off [ berkdb random_int $off_low $off_hi ] + set offn [expr $off + 1] + if { [is_fixed_length $method] && \ + [expr [string length $data] + $off] >= $fixed_len} { + set data [string range $data 0 [expr $fixed_len-$offn]] + } + set dvals($key) [partial_shift $data $off right] + } else { + set data [chop_data $method [replicate $str $rcount]] + + # This is a hack. In DB we will store the records with + # some padding, but these will get lost if we just return + # them in TCL. As a result, we're going to have to hack + # get to check for 0 padding and return a list consisting + # of the number of 0's and the actual data. + set off [ berkdb random_int $off_low $off_hi ] + + # There is no string concatenation function in Tcl + # (although there is one in TclX), so we have to resort + # to this hack. Ugh. + set slen [string length $data] + if {[is_fixed_length $method] && \ + $slen > $fixed_len - $off} { + set $slen [expr $fixed_len - $off] + } + set a "a" + set dvals($key) [pad_data \ + $method [eval "binary format x$off$a$slen" {$data}]] + } + if {[is_fixed_length $method] && \ + [string length $data] > ($fixed_len - $off)} { + set slen [expr $fixed_len - $off] + set data [eval "binary format a$slen" {$data}] + } + set ret [eval {$db put} \ + {-partial [list $off [string length $data]] $key $data}] + error_check_good put $ret 0 + + incr count + } + close $did + + # Now make sure that everything looks OK + puts "\tTest015.b: check entire file contents" + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {set i [incr i]} { + puts $oid $i + } + close $oid + filesort $t2 $t3 + file rename -force $t3 $t2 + filesort $t1 $t3 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good Test015:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + puts "\tTest015.c: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_file $testfile $env $txn $t1 \ + $checkfunc dump_file_direction "-first" "-next" + + if { [string compare $omethod "-recno"] != 0 } { + filesort $t1 $t3 + } + + error_check_good Test015:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tTest015.d: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 \ + $checkfunc dump_file_direction "-last" "-prev" + + if { [string compare $omethod "-recno"] != 0 } { + filesort $t1 $t3 + } + + error_check_good Test015:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + unset dvals +} + +# Check function for test015; keys and data are identical +proc test015.check { key data } { + global dvals + + error_check_good key"$key"_exists [info exists dvals($key)] 1 + binary scan $data "c[string length $data]" a + binary scan $dvals($key) "c[string length $dvals($key)]" b + error_check_good "mismatch on padding for key $key" $a $b +} + +proc test015.fixed.check { key data } { + global dvals + global fixed_len + + error_check_good key"$key"_exists [info exists dvals($key)] 1 + if { [string length $data] > $fixed_len } { + error_check_bad \ + "data length:[string length $data] \ + for fixed:$fixed_len" 1 1 + } + puts "$data : $dvals($key)" + error_check_good compare_data($data,$dvals($key) \ + $dvals($key) $data +} diff --git a/bdb/test/test016.tcl b/bdb/test/test016.tcl new file mode 100644 index 00000000000..def3c114693 --- /dev/null +++ b/bdb/test/test016.tcl @@ -0,0 +1,170 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test016.tcl,v 11.17 2000/08/25 14:21:54 sue Exp $ +# +# DB Test 16 {access method} +# Partial put test where partial puts make the record smaller. +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and a fixed, medium length data string; +# retrieve each. After all are entered, go back and do partial puts, +# replacing a random-length string with the key value. +# Then verify. + +set datastr abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz + +proc test016 { method {nentries 10000} args } { + global datastr + global dvals + global rand_init + source ./include.tcl + + berkdb srand $rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_fixed_length $method] == 1 } { + puts "Test016: skipping for method $method" + return + } + + puts "Test016: $method ($args) $nentries partial put shorten" + + # Create the database and open the dictionary + 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/test016.db + set env NULL + } else { + set testfile test016.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + + # Here is the loop where we put and get each key/data pair + + puts "\tTest016.a: put/get loop" + set did [open $dict] + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + } else { + set key $str + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $datastr]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $datastr]]] + incr count + } + close $did + + # Next we will do a partial put replacement, making the data + # shorter + puts "\tTest016.b: partial put loop" + set did [open $dict] + set count 0 + set len [string length $datastr] + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + } else { + set key $str + } + + set repl_len [berkdb random_int [string length $key] $len] + set repl_off [berkdb random_int 0 [expr $len - $repl_len] ] + set s1 [string range $datastr 0 [ expr $repl_off - 1] ] + set s2 [string toupper $key] + set s3 [string range $datastr [expr $repl_off + $repl_len] end ] + set dvals($key) [pad_data $method $s1$s2$s3] + set ret [eval {$db put} $txn {-partial \ + [list $repl_off $repl_len] $key [chop_data $method $s2]}] + error_check_good put $ret 0 + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good \ + put $ret [list [list $key [pad_data $method $s1$s2$s3]]] + incr count + } + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest016.c: dump file" + dump_file $db $txn $t1 test016.check + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {set i [incr i]} { + puts $oid $i + } + close $oid + file rename -force $t1 $t3 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good Test016:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again. + puts "\tTest016.d: close, open, and dump file" + open_and_dump_file $testfile $env $txn $t1 test016.check \ + dump_file_direction "-first" "-next" + + if { [ is_record_based $method ] == 0 } { + filesort $t1 $t3 + } + error_check_good Test016:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now, reopen the file and run the last test again in reverse direction. + puts "\tTest016.e: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 test016.check \ + dump_file_direction "-last" "-prev" + + if { [ is_record_based $method ] == 0 } { + filesort $t1 $t3 + } + error_check_good Test016:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 +} + +# Check function for test016; data should be whatever is set in dvals +proc test016.check { key data } { + global datastr + global dvals + + error_check_good key"$key"_exists [info exists dvals($key)] 1 + error_check_good "data mismatch for key $key" $data $dvals($key) +} diff --git a/bdb/test/test017.tcl b/bdb/test/test017.tcl new file mode 100644 index 00000000000..95fe82e081c --- /dev/null +++ b/bdb/test/test017.tcl @@ -0,0 +1,237 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test017.tcl,v 11.13 2000/12/11 17:42:18 sue Exp $ +# +# DB Test 17 {access method} +# Run duplicates with small page size so that we test off page duplicates. +# Then after we have an off-page database, test with overflow pages too. +# +proc test017 { method {contents 0} {ndups 19} {tnum 17} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $method" + return + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + incr pgindex + if { [lindex $args $pgindex] > 8192 } { + puts "Test0$tnum: Skipping for large pagesizes" + return + } + } + + puts "Test0$tnum: $method ($args) Off page duplicate tests with $ndups duplicates" + + # Create the database and open the dictionary + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set t4 $testdir/t4 + + cleanup $testdir $env + + set db [eval {berkdb_open \ + -create -truncate -mode 0644 -dup} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set pflags "" + set gflags "" + set txn "" + set count 0 + + set ovfl "" + # Here is the loop where we put and get each key/data pair + set dbc [eval {$db cursor} $txn] + puts -nonewline \ + "\tTest0$tnum.a: Creating duplicates with " + if { $contents != 0 } { + puts "file contents as key/data" + } else { + puts "file name as key/data" + } + set file_list [glob ../*/*.c ./*.lo] + foreach f $file_list { + if { $contents != 0 } { + set fid [open $f r] + fconfigure $fid -translation binary + # + # Prepend file name to guarantee uniqueness + set filecont [read $fid] + set str $f:$filecont + close $fid + } else { + set str $f + } + for { set i 1 } { $i <= $ndups } { incr i } { + set datastr $i:$str + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good put $ret 0 + } + + # + # Save 10% files for overflow test + # + if { $contents == 0 && [expr $count % 10] == 0 } { + lappend ovfl $f + } + # Now retrieve all the keys matching this key + set ret [$db get $str] + error_check_bad $f:dbget_dups [llength $ret] 0 + error_check_good $f:dbget_dups1 [llength $ret] $ndups + set x 1 + for {set ret [$dbc get "-set" $str]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get "-next"] } { + set k [lindex [lindex $ret 0] 0] + if { [string compare $k $str] != 0 } { + break + } + set datastr [lindex [lindex $ret 0] 1] + set d [data_of $datastr] + if {[string length $d] == 0} { + break + } + error_check_good "Test0$tnum:get" $d $str + set id [ id_of $datastr ] + error_check_good "Test0$tnum:$f:dup#" $id $x + incr x + } + error_check_good "Test0$tnum:ndups:$str" [expr $x - 1] $ndups + incr count + } + error_check_good cursor_close [$dbc close] 0 + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest0$tnum.b: Checking file for correct duplicates" + set dlist "" + for { set i 1 } { $i <= $ndups } {incr i} { + lappend dlist $i + } + set oid [open $t2.tmp w] + set o1id [open $t4.tmp w] + foreach f $file_list { + for {set i 1} {$i <= $ndups} {incr i} { + puts $o1id $f + } + puts $oid $f + } + close $oid + close $o1id + filesort $t2.tmp $t2 + filesort $t4.tmp $t4 + fileremove $t2.tmp + fileremove $t4.tmp + + dup_check $db $txn $t1 $dlist + if {$contents == 0} { + filesort $t1 $t3 + + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + # Now compare the keys to see if they match the file names + dump_file $db $txn $t1 test017.check + filesort $t1 $t3 + + error_check_good Test0$tnum:diff($t3,$t4) \ + [filecmp $t3 $t4] 0 + } + + error_check_good db_close [$db close] 0 + set db [eval {berkdb_open} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + puts "\tTest0$tnum.c: Checking file for correct duplicates after close" + dup_check $db $txn $t1 $dlist + + if {$contents == 0} { + # Now compare the keys to see if they match the filenames + filesort $t1 $t3 + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + } + error_check_good db_close [$db close] 0 + + puts "\tTest0$tnum.d: Verify off page duplicates and overflow status" + set db [eval {berkdb_open} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + set stat [$db stat] + if { [is_btree $method] } { + error_check_bad stat:offpage \ + [is_substr $stat "{{Internal pages} 0}"] 1 + } + if {$contents == 0} { + # This check doesn't work in hash, since overflow + # pages count extra pages in buckets as well as true + # P_OVERFLOW pages. + if { [is_hash $method] == 0 } { + error_check_good overflow \ + [is_substr $stat "{{Overflow pages} 0}"] 1 + } + } else { + error_check_bad overflow \ + [is_substr $stat "{{Overflow pages} 0}"] 1 + } + + # + # If doing overflow test, do that now. Else we are done. + # Add overflow pages by adding a large entry to a duplicate. + # + if { [llength $ovfl] == 0} { + error_check_good db_close [$db close] 0 + return + } + puts "\tTest0$tnum.e: Add overflow duplicate entries" + set ovfldup [expr $ndups + 1] + foreach f $ovfl { + # + # This is just like put_file, but prepends the dup number + # + set fid [open $f r] + fconfigure $fid -translation binary + set fdata [read $fid] + close $fid + set data $ovfldup:$fdata + + set ret [eval {$db put} $txn $pflags {$f $data}] + error_check_good ovfl_put $ret 0 + } + puts "\tTest0$tnum.f: Verify overflow duplicate entries" + dup_check $db $txn $t1 $dlist $ovfldup + filesort $t1 $t3 + error_check_good Test0$tnum:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 + + set stat [$db stat] + error_check_bad overflow1 \ + [is_substr $stat "{{Overflow pages} 0}"] 1 + error_check_good db_close [$db close] 0 +} + +# Check function; verify data contains key +proc test017.check { key data } { + error_check_good "data mismatch for key $key" $key [data_of $data] +} diff --git a/bdb/test/test018.tcl b/bdb/test/test018.tcl new file mode 100644 index 00000000000..95493da2d03 --- /dev/null +++ b/bdb/test/test018.tcl @@ -0,0 +1,13 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test018.tcl,v 11.3 2000/02/14 03:00:18 bostic Exp $ +# +# DB Test 18 {access method} +# Run duplicates with small page size so that we test off page duplicates. +proc test018 { method {nentries 10000} args} { + puts "Test018: Off page duplicate tests" + eval {test011 $method $nentries 19 18 -pagesize 512} $args +} diff --git a/bdb/test/test019.tcl b/bdb/test/test019.tcl new file mode 100644 index 00000000000..4031ae2dc16 --- /dev/null +++ b/bdb/test/test019.tcl @@ -0,0 +1,107 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test019.tcl,v 11.14 2000/08/25 14:21:54 sue Exp $ +# +# Test019 { access_method nentries } +# Test the partial get functionality. +proc test019 { method {nentries 10000} args } { + global fixed_len + global rand_init + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + puts "Test019: $method ($args) $nentries partial get test" + + # Create the database and open the dictionary + 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/test019.db + set env NULL + } else { + set testfile test019.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + berkdb srand $rand_init + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + + puts "\tTest019.a: put/get loop" + for { set i 0 } { [gets $did str] != -1 && $i < $nentries } \ + { incr i } { + + if { [is_record_based $method] == 1 } { + set key [expr $i + 1] + } else { + set key $str + } + set repl [berkdb random_int $fixed_len 100] + set data [chop_data $method [replicate $str $repl]] + set ret [eval {$db put} $txn {-nooverwrite $key $data}] + error_check_good dbput:$key $ret 0 + + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good \ + dbget:$key $ret [list [list $key [pad_data $method $data]]] + set kvals($key) $repl + } + close $did + + puts "\tTest019.b: partial get loop" + set did [open $dict] + for { set i 0 } { [gets $did str] != -1 && $i < $nentries } \ + { incr i } { + if { [is_record_based $method] == 1 } { + set key [expr $i + 1] + } else { + set key $str + } + set data [replicate $str $kvals($key)] + + if { [is_fixed_length $method] == 1 } { + set maxndx $fixed_len + } else { + set maxndx [expr [string length $data] - 1] + } + set beg [berkdb random_int 0 [expr $maxndx - 1]] + set len [berkdb random_int 1 [expr $maxndx - $beg]] + + set ret [eval {$db get} \ + $txn {-partial [list $beg $len]} $gflags {$key}] + + # In order for tcl to handle this, we have to overwrite the + # last character with a NULL. That makes the length one less + # than we expect. + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_good dbget_key $k $key + # If $d contains some of the padding, we want to get rid of it. + set firstnull [string first "\0" $d] + if { $firstnull == -1 } { set firstnull [string length $d] } + error_check_good dbget_data \ + [string range $d 0 [expr $firstnull - 1]] \ + [string range $data $beg [expr $beg + $len - 1]] + } + error_check_good db_close [$db close] 0 + close $did +} diff --git a/bdb/test/test020.tcl b/bdb/test/test020.tcl new file mode 100644 index 00000000000..1961d0e02dd --- /dev/null +++ b/bdb/test/test020.tcl @@ -0,0 +1,108 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test020.tcl,v 11.12 2000/10/19 23:15:22 ubell Exp $ +# +# DB Test 20 {access method} +# Test in-memory databases. +proc test020 { method {nentries 10000} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + if { [is_queueext $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test020 skipping for method $method" + return + } + puts "Test020: $method ($args) $nentries equal key/data pairs" + + # Create the database and open the dictionary + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + set eindex [lsearch -exact $args "-env"] + # + # Check if we are using an env. + if { $eindex == -1 } { + set env NULL + } else { + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + set checkfunc test020_recno.check + append gflags " -recno" + } else { + set checkfunc test020.check + } + puts "\tTest020.a: put/get loop" + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) [pad_data $method $str] + } else { + set key $str + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $str]}] + error_check_good put $ret 0 + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $str]]] + incr count + } + close $did + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest020.b: dump file" + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {set i [incr i]} { + puts $oid $i + } + close $oid + file rename -force $t1 $t3 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + + error_check_good Test020:diff($t3,$t2) \ + [filecmp $t3 $t2] 0 +} + +# Check function for test020; keys and data are identical +proc test020.check { key data } { + error_check_good "key/data mismatch" $data $key +} + +proc test020_recno.check { key data } { + global dict + global kvals + + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "data mismatch: key $key" $data $kvals($key) +} diff --git a/bdb/test/test021.tcl b/bdb/test/test021.tcl new file mode 100644 index 00000000000..f9a1fe32f7e --- /dev/null +++ b/bdb/test/test021.tcl @@ -0,0 +1,130 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test021.tcl,v 11.10 2000/08/25 14:21:55 sue Exp $ +# +# DB Test 21 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self, reversed as key and self as data. +# After all are entered, retrieve each using a cursor SET_RANGE, and getting +# about 20 keys sequentially after it (in some cases we'll run out towards +# the end of the file). +proc test021 { method {nentries 10000} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test021: $method ($args) $nentries equal key/data pairs" + + # Create the database and open the dictionary + 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/test021.db + set env NULL + } else { + set testfile test021.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + set checkfunc test021_recno.check + append gflags " -recno" + } else { + set checkfunc test021.check + } + puts "\tTest021.a: put loop" + # Here is the loop where we put each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) [pad_data $method $str] + } else { + set key [reverse $str] + } + + set r [eval {$db put} \ + $txn $pflags {$key [chop_data $method $str]}] + error_check_good db_put $r 0 + incr count + } + close $did + + # Now we will get each key from the DB and retrieve about 20 + # records after it. + error_check_good db_close [$db close] 0 + + puts "\tTest021.b: test ranges" + set db [eval {berkdb_open -rdonly} $args $omethod $testfile ] + error_check_good dbopen [is_valid_db $db] TRUE + + # Open a cursor + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor [is_substr $dbc $db] 1 + + set did [open $dict] + set i 0 + while { [gets $did str] != -1 && $i < $count } { + if { [is_record_based $method] == 1 } { + set key [expr $i + 1] + } else { + set key [reverse $str] + } + + set r [$dbc get -set_range $key] + error_check_bad dbc_get:$key [string length $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + $checkfunc $k $d + + for { set nrecs 0 } { $nrecs < 20 } { incr nrecs } { + set r [$dbc get "-next"] + # no error checking because we may run off the end + # of the database + if { [llength $r] == 0 } { + continue; + } + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + $checkfunc $k $d + } + incr i + } + error_check_good db_close [$db close] 0 + close $did +} + +# Check function for test021; keys and data are reversed +proc test021.check { key data } { + error_check_good "key/data mismatch for $key" $data [reverse $key] +} + +proc test021_recno.check { key data } { + global dict + global kvals + + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "data mismatch: key $key" $data $kvals($key) +} diff --git a/bdb/test/test022.tcl b/bdb/test/test022.tcl new file mode 100644 index 00000000000..f9a4c96637e --- /dev/null +++ b/bdb/test/test022.tcl @@ -0,0 +1,55 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test022.tcl,v 11.10 2000/08/25 14:21:55 sue Exp $ +# +# Test022: Test of DB->get_byteswapped +proc test022 { method args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test022 ($args) $omethod: DB->getbyteswapped()" + + 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 testfile1 "$testdir/test022a.db" + set testfile2 "$testdir/test022b.db" + set env NULL + } else { + set testfile1 "test022a.db" + set testfile2 "test022b.db" + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + # Create two databases, one in each byte order. + set db1 [eval {berkdb_open -create \ + -mode 0644} $omethod $args {-lorder 1234} $testfile1] + error_check_good db1_open [is_valid_db $db1] TRUE + + set db2 [eval {berkdb_open -create \ + -mode 0644} $omethod $args {-lorder 4321} $testfile2] + error_check_good db2_open [is_valid_db $db2] TRUE + + # Call DB->get_byteswapped on both of them. + set db1_order [$db1 is_byteswapped] + set db2_order [$db2 is_byteswapped] + + # Make sure that both answers are either 1 or 0, + # and that exactly one of them is 1. + error_check_good is_byteswapped_sensible_1 \ + [expr ($db1_order == 1 && $db2_order == 0) || \ + ($db1_order == 0 && $db2_order == 1)] 1 + + error_check_good db1_close [$db1 close] 0 + error_check_good db2_close [$db2 close] 0 + puts "\tTest022 complete." +} diff --git a/bdb/test/test023.tcl b/bdb/test/test023.tcl new file mode 100644 index 00000000000..c222bdd83c5 --- /dev/null +++ b/bdb/test/test023.tcl @@ -0,0 +1,204 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test023.tcl,v 11.13 2000/08/25 14:21:55 sue Exp $ +# +# Duplicate delete test. +# Add a key with duplicates (first time on-page, second time off-page) +# Number the dups. +# Delete dups and make sure that CURRENT/NEXT/PREV work correctly. +proc test023 { method args } { + global alphabet + global dupnum + global dupstr + global errorInfo + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + puts "Test023: $method delete duplicates/check cursor operations" + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test023: skipping for method $omethod" + return + } + + # Create the database and open the dictionary + 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/test023.db + set env NULL + } else { + set testfile test023.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644 -dup} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set pflags "" + set gflags "" + set txn "" + + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor [is_substr $dbc $db] 1 + + foreach i { onpage offpage } { + if { $i == "onpage" } { + set dupstr DUP + } else { + set dupstr [repeat $alphabet 50] + } + puts "\tTest023.a: Insert key w/$i dups" + set key "duplicate_val_test" + for { set count 0 } { $count < 20 } { incr count } { + set ret \ + [eval {$db put} $txn $pflags {$key $count$dupstr}] + error_check_good db_put $ret 0 + } + + # Now let's get all the items and make sure they look OK. + puts "\tTest023.b: Check initial duplicates" + set dupnum 0 + dump_file $db $txn $t1 test023.check + + # Delete a couple of random items (FIRST, LAST one in middle) + # Make sure that current returns an error and that NEXT and + # PREV do the right things. + + set ret [$dbc get -set $key] + error_check_bad dbc_get:SET [llength $ret] 0 + + puts "\tTest023.c: Delete first and try gets" + # This should be the first duplicate + error_check_good \ + dbc_get:SET $ret [list [list duplicate_val_test 0$dupstr]] + + # Now delete it. + set ret [$dbc del] + error_check_good dbc_del:FIRST $ret 0 + + # Now current should fail + set ret [$dbc get -current] + error_check_good dbc_get:CURRENT $ret [list [list [] []]] + + # Now Prev should fail + set ret [$dbc get -prev] + error_check_good dbc_get:prev0 [llength $ret] 0 + + # Now 10 nexts should work to get us in the middle + for { set j 1 } { $j <= 10 } { incr j } { + set ret [$dbc get -next] + error_check_good \ + dbc_get:next [llength [lindex $ret 0]] 2 + error_check_good \ + dbc_get:next [lindex [lindex $ret 0] 1] $j$dupstr + } + + puts "\tTest023.d: Delete middle and try gets" + # Now do the delete on the current key. + set ret [$dbc del] + error_check_good dbc_del:10 $ret 0 + + # Now current should fail + set ret [$dbc get -current] + error_check_good \ + dbc_get:deleted $ret [list [list [] []]] + + # Prev and Next should work + set ret [$dbc get -next] + error_check_good dbc_get:next [llength [lindex $ret 0]] 2 + error_check_good \ + dbc_get:next [lindex [lindex $ret 0] 1] 11$dupstr + + set ret [$dbc get -prev] + error_check_good dbc_get:next [llength [lindex $ret 0]] 2 + error_check_good \ + dbc_get:next [lindex [lindex $ret 0] 1] 9$dupstr + + # Now go to the last one + for { set j 11 } { $j <= 19 } { incr j } { + set ret [$dbc get -next] + error_check_good \ + dbc_get:next [llength [lindex $ret 0]] 2 + error_check_good \ + dbc_get:next [lindex [lindex $ret 0] 1] $j$dupstr + } + + puts "\tTest023.e: Delete last and try gets" + # Now do the delete on the current key. + set ret [$dbc del] + error_check_good dbc_del:LAST $ret 0 + + # Now current should fail + set ret [$dbc get -current] + error_check_good \ + dbc_get:deleted $ret [list [list [] []]] + + # Next should fail + set ret [$dbc get -next] + error_check_good dbc_get:next19 [llength $ret] 0 + + # Prev should work + set ret [$dbc get -prev] + error_check_good dbc_get:next [llength [lindex $ret 0]] 2 + error_check_good \ + dbc_get:next [lindex [lindex $ret 0] 1] 18$dupstr + + # Now overwrite the current one, then count the number + # of data items to make sure that we have the right number. + + puts "\tTest023.f: Count keys, overwrite current, count again" + # At this point we should have 17 keys the (initial 20 minus + # 3 deletes) + set dbc2 [$db cursor] + error_check_good db_cursor:2 [is_substr $dbc2 $db] 1 + + set count_check 0 + for { set rec [$dbc2 get -first] } { + [llength $rec] != 0 } { set rec [$dbc2 get -next] } { + incr count_check + } + error_check_good numdups $count_check 17 + + set ret [$dbc put -current OVERWRITE] + error_check_good dbc_put:current $ret 0 + + set count_check 0 + for { set rec [$dbc2 get -first] } { + [llength $rec] != 0 } { set rec [$dbc2 get -next] } { + incr count_check + } + error_check_good numdups $count_check 17 + + # Done, delete all the keys for next iteration + set ret [eval {$db del} $txn {$key}] + error_check_good db_delete $ret 0 + + # database should be empty + + set ret [$dbc get -first] + error_check_good first_after_empty [llength $ret] 0 + } + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + +} + +# Check function for test023; keys and data are identical +proc test023.check { key data } { + global dupnum + global dupstr + error_check_good "bad key" $key duplicate_val_test + error_check_good "data mismatch for $key" $data $dupnum$dupstr + incr dupnum +} diff --git a/bdb/test/test024.tcl b/bdb/test/test024.tcl new file mode 100644 index 00000000000..f0b6762cd2f --- /dev/null +++ b/bdb/test/test024.tcl @@ -0,0 +1,206 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test024.tcl,v 11.14 2000/08/25 14:21:55 sue Exp $ +# +# DB Test 24 {method nentries} +# Test the Btree and Record number get-by-number functionality. +proc test024 { method {nentries 10000} args} { + source ./include.tcl + global rand_init + + set do_renumber [is_rrecno $method] + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test024: $method ($args)" + + if { [string compare $omethod "-hash"] == 0 } { + puts "Test024 skipping for method HASH" + return + } + + berkdb srand $rand_init + + # Create the database and open the dictionary + 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/test024.db + set env NULL + } else { + set testfile test024.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + + cleanup $testdir $env + + # Read the first nentries dictionary elements and reverse them. + # Keep a list of these (these will be the keys). + puts "\tTest024.a: initialization" + set keys "" + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < $nentries } { + lappend keys [reverse $str] + incr count + } + close $did + + # Generate sorted order for the keys + set sorted_keys [lsort $keys] + # Create the database + if { [string compare $omethod "-btree"] == 0 } { + set db [eval {berkdb_open -create -truncate \ + -mode 0644 -recnum} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + } else { + set db [eval {berkdb_open -create -truncate \ + -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + } + + set pflags "" + set gflags "" + set txn "" + + if { [is_record_based $method] == 1 } { + set gflags " -recno" + } + + puts "\tTest024.b: put/get loop" + foreach k $keys { + if { [is_record_based $method] == 1 } { + set key [lsearch $sorted_keys $k] + incr key + } else { + set key $k + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $k]}] + error_check_good put $ret 0 + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good \ + get $ret [list [list $key [pad_data $method $k]]] + } + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest024.c: dump file" + + # Put sorted keys in file + set oid [open $t1 w] + foreach k $sorted_keys { + puts $oid [pad_data $method $k] + } + close $oid + + # Instead of using dump_file; get all the keys by keynum + set oid [open $t2 w] + if { [string compare $omethod "-btree"] == 0 } { + set do_renumber 1 + } + + set gflags " -recno" + + for { set k 1 } { $k <= $count } { incr k } { + set ret [eval {$db get} $txn $gflags {$k}] + puts $oid [lindex [lindex $ret 0] 1] + error_check_good recnum_get [lindex [lindex $ret 0] 1] \ + [pad_data $method [lindex $sorted_keys [expr $k - 1]]] + } + close $oid + error_check_good db_close [$db close] 0 + + error_check_good Test024.c:diff($t1,$t2) \ + [filecmp $t1 $t2] 0 + + # Now, reopen the file and run the last test again. + puts "\tTest024.d: close, open, and dump file" + set db [eval {berkdb_open -rdonly} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + set oid [open $t2 w] + for { set k 1 } { $k <= $count } { incr k } { + set ret [eval {$db get} $txn $gflags {$k}] + puts $oid [lindex [lindex $ret 0] 1] + error_check_good recnum_get [lindex [lindex $ret 0] 1] \ + [pad_data $method [lindex $sorted_keys [expr $k - 1]]] + } + close $oid + error_check_good db_close [$db close] 0 + error_check_good Test024.d:diff($t1,$t2) \ + [filecmp $t1 $t2] 0 + + # Now, reopen the file and run the last test again in reverse direction. + puts "\tTest024.e: close, open, and dump file in reverse direction" + set db [eval {berkdb_open -rdonly} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + # Put sorted keys in file + set rsorted "" + foreach k $sorted_keys { + set rsorted [linsert $rsorted 0 $k] + } + set oid [open $t1 w] + foreach k $rsorted { + puts $oid [pad_data $method $k] + } + close $oid + + set oid [open $t2 w] + for { set k $count } { $k > 0 } { incr k -1 } { + set ret [eval {$db get} $txn $gflags {$k}] + puts $oid [lindex [lindex $ret 0] 1] + error_check_good recnum_get [lindex [lindex $ret 0] 1] \ + [pad_data $method [lindex $sorted_keys [expr $k - 1]]] + } + close $oid + error_check_good db_close [$db close] 0 + error_check_good Test024.e:diff($t1,$t2) \ + [filecmp $t1 $t2] 0 + + # Now try deleting elements and making sure they work + puts "\tTest024.f: delete test" + set db [eval {berkdb_open} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + while { $count > 0 } { + set kndx [berkdb random_int 1 $count] + set kval [lindex $keys [expr $kndx - 1]] + set recno [expr [lsearch $sorted_keys $kval] + 1] + + if { [is_record_based $method] == 1 } { + set ret [eval {$db del} $txn {$recno}] + } else { + set ret [eval {$db del} $txn {$kval}] + } + error_check_good delete $ret 0 + + # Remove the key from the key list + set ndx [expr $kndx - 1] + set keys [lreplace $keys $ndx $ndx] + + if { $do_renumber == 1 } { + set r [expr $recno - 1] + set sorted_keys [lreplace $sorted_keys $r $r] + } + + # Check that the keys after it have been renumbered + if { $do_renumber == 1 && $recno != $count } { + set r [expr $recno - 1] + set ret [eval {$db get} $txn $gflags {$recno}] + error_check_good get_after_del \ + [lindex [lindex $ret 0] 1] [lindex $sorted_keys $r] + } + + # Decrement count + incr count -1 + } + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test025.tcl b/bdb/test/test025.tcl new file mode 100644 index 00000000000..9f8deecb488 --- /dev/null +++ b/bdb/test/test025.tcl @@ -0,0 +1,105 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test025.tcl,v 11.11 2000/11/16 23:56:18 ubell Exp $ +# +# DB Test 25 {method nentries} +# Test the DB_APPEND flag. +proc test025 { method {nentries 10000} {start 0 } {tnum "25" } args} { + global kvals + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + puts "Test0$tnum: $method ($args)" + + if { [string compare $omethod "-btree"] == 0 } { + puts "Test0$tnum skipping for method BTREE" + return + } + if { [string compare $omethod "-hash"] == 0 } { + puts "Test0$tnum skipping for method HASH" + return + } + + # Create the database and open the dictionary + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + puts "\tTest0$tnum.a: put/get loop" + set gflags " -recno" + set pflags " -append" + set txn "" + set checkfunc test025_check + + # Here is the loop where we put and get each key/data pair + set count $start + set nentries [expr $start + $nentries] + if { $count != 0 } { + gets $did str + set k [expr $count + 1] + set kvals($k) [pad_data $method $str] + set ret [eval {$db put} $txn $k {[chop_data $method $str]}] + error_check_good db_put $ret 0 + incr count + } + + while { [gets $did str] != -1 && $count < $nentries } { + set k [expr $count + 1] + set kvals($k) [pad_data $method $str] + set ret [eval {$db put} $txn $pflags {[chop_data $method $str]}] + error_check_good db_put $ret $k + + set ret [eval {$db get} $txn $gflags {$k}] + error_check_good \ + get $ret [list [list $k [pad_data $method $str]]] + incr count + if { [expr $count + 1] == 0 } { + incr count + } + } + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest0$tnum.b: dump file" + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + puts "\tTest0$tnum.c: close, open, and dump file" + # Now, reopen the file and run the last test again. + open_and_dump_file $testfile $env $txn $t1 $checkfunc \ + dump_file_direction -first -next + + # Now, reopen the file and run the last test again in the + # reverse direction. + puts "\tTest0$tnum.d: close, open, and dump file in reverse direction" + open_and_dump_file $testfile $env $txn $t1 $checkfunc \ + dump_file_direction -last -prev +} + +proc test025_check { key data } { + global kvals + + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good " key/data mismatch for |$key|" $data $kvals($key) +} diff --git a/bdb/test/test026.tcl b/bdb/test/test026.tcl new file mode 100644 index 00000000000..6c19c60a2e5 --- /dev/null +++ b/bdb/test/test026.tcl @@ -0,0 +1,112 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test026.tcl,v 11.13 2000/11/17 19:07:51 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. +proc test026 { method {nentries 2000} {ndups 5} {tnum 26} args} { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + 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 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # 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 \ + -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]}] + error_check_good db_put $ret 0 + incr count + } + } + close $did + + error_check_good db_close [$db close] 0 + set db [eval {berkdb_open} $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Now we will sequentially traverse the database getting each + # item and deleting it. + set count 0 + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor [is_substr $dbc $db] 1 + + puts "\tTest0$tnum.b: Get/delete loop" + set i 1 + for { set ret [$dbc get -first] } { + [string length $ret] != 0 } { + set ret [$dbc get -next] } { + + set key [lindex [lindex $ret 0] 0] + set data [lindex [lindex $ret 0] 1] + if { $i == 1 } { + set curkey $key + } + error_check_good seq_get:key $key $curkey + error_check_good \ + seq_get:data $data [pad_data $method $i[make_data_str $key]] + + if { $i == $ndups } { + set i 1 + } else { + incr i + } + + # Now delete the key + set ret [$dbc del] + error_check_good db_del:$key $ret 0 + } + error_check_good dbc_close [$dbc close] 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 + 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 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test027.tcl b/bdb/test/test027.tcl new file mode 100644 index 00000000000..ae4bf64fb3e --- /dev/null +++ b/bdb/test/test027.tcl @@ -0,0 +1,13 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test027.tcl,v 11.4 2000/05/22 12:51:39 bostic Exp $ +# +# DB Test 27 {access method} +# Check that delete operations work. Create a database; close database and +# reopen it. Then issues delete by key for each entry. +proc test027 { method {nentries 100} args} { + eval {test026 $method $nentries 100 27} $args +} diff --git a/bdb/test/test028.tcl b/bdb/test/test028.tcl new file mode 100644 index 00000000000..b460dd53a98 --- /dev/null +++ b/bdb/test/test028.tcl @@ -0,0 +1,208 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test028.tcl,v 11.12 2000/08/25 14:21:55 sue Exp $ +# +# Put after cursor delete test. +proc test028 { method args } { + global dupnum + global dupstr + global alphabet + global errorInfo + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test028: $method put after cursor delete test" + + if { [is_rbtree $method] == 1 } { + puts "Test028 skipping for method $method" + return + } + if { [is_record_based $method] == 1 } { + set key 10 + } else { + append args " -dup" + set key "put_after_cursor_del" + } + + # Create the database and open the dictionary + 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/test028.db + set env NULL + } else { + set testfile test028.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set ndups 20 + set txn "" + set pflags "" + set gflags "" + + if { [is_record_based $method] == 1 } { + set gflags " -recno" + } + + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor [is_substr $dbc $db] 1 + + foreach i { offpage onpage } { + foreach b { bigitem smallitem } { + if { $i == "onpage" } { + if { $b == "bigitem" } { + set dupstr [repeat $alphabet 100] + } else { + set dupstr DUP + } + } else { + if { $b == "bigitem" } { + set dupstr [repeat $alphabet 100] + } else { + set dupstr [repeat $alphabet 50] + } + } + + if { $b == "bigitem" } { + set dupstr [repeat $dupstr 10] + } + puts "\tTest028: $i/$b" + + puts "\tTest028.a: Insert key with single data item" + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $dupstr]}] + error_check_good db_put $ret 0 + + # Now let's get the item and make sure its OK. + puts "\tTest028.b: Check initial entry" + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good db_get \ + $ret [list [list $key [pad_data $method $dupstr]]] + + # Now try a put with NOOVERWRITE SET (should be error) + puts "\tTest028.c: No_overwrite test" + set ret [eval {$db put} $txn \ + {-nooverwrite $key [chop_data $method $dupstr]}] + error_check_good \ + db_put [is_substr $ret "DB_KEYEXIST"] 1 + + # Now delete the item with a cursor + puts "\tTest028.d: Delete test" + set ret [$dbc get -set $key] + error_check_bad dbc_get:SET [llength $ret] 0 + + set ret [$dbc del] + error_check_good dbc_del $ret 0 + + puts "\tTest028.e: Reput the item" + set ret [eval {$db put} $txn \ + {-nooverwrite $key [chop_data $method $dupstr]}] + error_check_good db_put $ret 0 + + puts "\tTest028.f: Retrieve the item" + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good db_get $ret \ + [list [list $key [pad_data $method $dupstr]]] + + # Delete the key to set up for next test + set ret [eval {$db del} $txn {$key}] + error_check_good db_del $ret 0 + + # Now repeat the above set of tests with + # duplicates (if not RECNO). + if { [is_record_based $method] == 1 } { + continue; + } + + puts "\tTest028.g: Insert key with duplicates" + for { set count 0 } { $count < $ndups } { incr count } { + set ret [eval {$db put} \ + $txn {$key [chop_data $method $count$dupstr]}] + error_check_good db_put $ret 0 + } + + puts "\tTest028.h: Check dups" + set dupnum 0 + dump_file $db $txn $t1 test028.check + + # Try no_overwrite + puts "\tTest028.i: No_overwrite test" + set ret [eval {$db put} \ + $txn {-nooverwrite $key $dupstr}] + error_check_good \ + db_put [is_substr $ret "DB_KEYEXIST"] 1 + + # Now delete all the elements with a cursor + puts "\tTest028.j: Cursor Deletes" + set count 0 + for { set ret [$dbc get -set $key] } { + [string length $ret] != 0 } { + set ret [$dbc get -next] } { + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_good db_seq(key) $k $key + error_check_good db_seq(data) $d $count$dupstr + set ret [$dbc del] + error_check_good dbc_del $ret 0 + incr count + if { $count == [expr $ndups - 1] } { + puts "\tTest028.k:\ + Duplicate No_Overwrite test" + set $errorInfo "" + set ret [eval {$db put} $txn \ + {-nooverwrite $key $dupstr}] + error_check_good db_put [is_substr \ + $ret "DB_KEYEXIST"] 1 + } + } + + # Make sure all the items are gone + puts "\tTest028.l: Get after delete" + set ret [$dbc get -set $key] + error_check_good get_after_del [string length $ret] 0 + + puts "\tTest028.m: Reput the item" + set ret [eval {$db put} \ + $txn {-nooverwrite $key 0$dupstr}] + error_check_good db_put $ret 0 + for { set count 1 } { $count < $ndups } { incr count } { + set ret [eval {$db put} $txn {$key $count$dupstr}] + error_check_good db_put $ret 0 + } + + puts "\tTest028.n: Retrieve the item" + set dupnum 0 + dump_file $db $txn $t1 test028.check + + # Clean out in prep for next test + set ret [eval {$db del} $txn {$key}] + error_check_good db_del $ret 0 + } + } + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + +} + +# Check function for test028; keys and data are identical +proc test028.check { key data } { + global dupnum + global dupstr + error_check_good "Bad key" $key put_after_cursor_del + error_check_good "data mismatch for $key" $data $dupnum$dupstr + incr dupnum +} diff --git a/bdb/test/test029.tcl b/bdb/test/test029.tcl new file mode 100644 index 00000000000..c10815b0bf3 --- /dev/null +++ b/bdb/test/test029.tcl @@ -0,0 +1,192 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test029.tcl,v 11.13 2000/08/25 14:21:55 sue Exp $ +# +# DB Test 29 {method nentries} +# Test the Btree and Record number renumbering. +proc test029 { method {nentries 10000} args} { + source ./include.tcl + + set do_renumber [is_rrecno $method] + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test029: $method ($args)" + + if { [string compare $omethod "-hash"] == 0 } { + puts "Test029 skipping for method HASH" + return + } + if { [is_record_based $method] == 1 && $do_renumber != 1 } { + puts "Test029 skipping for method RECNO (w/out renumbering)" + return + } + + # Create the database and open the dictionary + 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/test029.db + set env NULL + } else { + set testfile test029.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + # Read the first nentries dictionary elements and reverse them. + # Keep a list of these (these will be the keys). + puts "\tTest029.a: initialization" + set keys "" + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < $nentries } { + lappend keys [reverse $str] + incr count + } + close $did + + # Generate sorted order for the keys + set sorted_keys [lsort $keys] + + # Save the first and last keys + set last_key [lindex $sorted_keys end] + set last_keynum [llength $sorted_keys] + + set first_key [lindex $sorted_keys 0] + set first_keynum 1 + + # Create the database + if { [string compare $omethod "-btree"] == 0 } { + set db [eval {berkdb_open -create -truncate \ + -mode 0644 -recnum} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + } else { + set db [eval {berkdb_open -create -truncate \ + -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + } + + set pflags "" + set gflags "" + set txn "" + + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + + puts "\tTest029.b: put/get loop" + foreach k $keys { + if { [is_record_based $method] == 1 } { + set key [lsearch $sorted_keys $k] + incr key + } else { + set key $k + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $k]}] + error_check_good dbput $ret 0 + + set ret [eval {$db get} $txn $gflags {$key}] + if { [string compare [lindex [lindex $ret 0] 1] $k] != 0 } { + puts "Test029: put key-data $key $k got $ret" + return + } + } + + # Now delete the first key in the database + puts "\tTest029.c: delete and verify renumber" + + # Delete the first key in the file + if { [is_record_based $method] == 1 } { + set key $first_keynum + } else { + set key $first_key + } + + set ret [eval {$db del} $txn {$key}] + error_check_good db_del $ret 0 + + # Now we are ready to retrieve records based on + # record number + if { [string compare $omethod "-btree"] == 0 } { + append gflags " -recno" + } + + # First try to get the old last key (shouldn't exist) + set ret [eval {$db get} $txn $gflags {$last_keynum}] + error_check_good get_after_del $ret [list] + + # Now try to get what we think should be the last key + set ret [eval {$db get} $txn $gflags {[expr $last_keynum - 1]}] + error_check_good \ + getn_last_after_del [lindex [lindex $ret 0] 1] $last_key + + # Create a cursor; we need it for the next test and we + # need it for recno here. + set dbc [eval {$db cursor} $txn] + error_check_good db_cursor [is_substr $dbc $db] 1 + + # OK, now re-put the first key and make sure that we + # renumber the last key appropriately. + if { [string compare $omethod "-btree"] == 0 } { + set ret [eval {$db put} $txn {$key [chop_data $method $first_key]}] + error_check_good db_put $ret 0 + } else { + # Recno + set ret [eval {$dbc get} $txn {-first}] + set ret [eval {$dbc put} $txn $pflags {-before $first_key}] + error_check_bad dbc_put:DB_BEFORE $ret 0 + } + + # Now check that the last record matches the last record number + set ret [eval {$db get} $txn $gflags {$last_keynum}] + error_check_good \ + getn_last_after_put [lindex [lindex $ret 0] 1] $last_key + + # Now delete the first key in the database using a cursor + puts "\tTest029.d: delete with cursor and verify renumber" + + set ret [eval {$dbc get} $txn {-first}] + error_check_good dbc_first $ret [list [list $key $first_key]] + + # Now delete at the cursor + set ret [$dbc del] + error_check_good dbc_del $ret 0 + + # Now check the record numbers of the last keys again. + # First try to get the old last key (shouldn't exist) + set ret [eval {$db get} $txn $gflags {$last_keynum}] + error_check_good get_last_after_cursor_del:$ret $ret [list] + + # Now try to get what we think should be the last key + set ret [eval {$db get} $txn $gflags {[expr $last_keynum - 1]}] + error_check_good \ + getn_after_cursor_del [lindex [lindex $ret 0] 1] $last_key + + # Re-put the first key and make sure that we renumber the last + # key appropriately. + puts "\tTest029.e: put with cursor and verify renumber" + if { [string compare $omethod "-btree"] == 0 } { + set ret [eval {$dbc put} \ + $txn $pflags {-current $first_key}] + error_check_good dbc_put:DB_CURRENT $ret 0 + } else { + set ret [eval {$dbc put} $txn $pflags {-before $first_key}] + error_check_bad dbc_put:DB_BEFORE $ret 0 + } + + # Now check that the last record matches the last record number + set ret [eval {$db get} $txn $gflags {$last_keynum}] + error_check_good \ + get_after_cursor_reput [lindex [lindex $ret 0] 1] $last_key + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test030.tcl b/bdb/test/test030.tcl new file mode 100644 index 00000000000..7395adf82bd --- /dev/null +++ b/bdb/test/test030.tcl @@ -0,0 +1,191 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test030.tcl,v 11.13 2000/08/25 14:21:55 sue Exp $ +# +# DB Test 30: Test DB_NEXT_DUP Functionality. +proc test030 { method {nentries 10000} args } { + global rand_init + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 || + [is_rbtree $method] == 1 } { + puts "Test030 skipping for method $method" + return + } + + puts "Test030: $method ($args) $nentries DB_NEXT_DUP testing" + berkdb srand $rand_init + + # Create the database and open the dictionary + 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/test030.db + set cntfile $testdir/cntfile.db + set env NULL + } else { + set testfile test030.db + set cntfile cntfile.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + set db [eval {berkdb_open -create -truncate \ + -mode 0644 -dup} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + # Use a second DB to keep track of how many duplicates + # we enter per key + + set cntdb [eval {berkdb_open -create -truncate \ + -mode 0644} $args {-btree $cntfile}] + error_check_good dbopen:cntfile [is_valid_db $db] TRUE + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put and get each key/data pair + # We will add between 1 and 10 dups with values 1 ... dups + # We'll verify each addition. + + set did [open $dict] + puts "\tTest030.a: put and get duplicate keys." + set dbc [eval {$db cursor} $txn] + + while { [gets $did str] != -1 && $count < $nentries } { + set ndup [berkdb random_int 1 10] + + for { set i 1 } { $i <= $ndup } { incr i 1 } { + set ret [eval {$cntdb put} \ + $txn $pflags {$str [chop_data $method $ndup]}] + error_check_good put_cnt $ret 0 + set datastr $i:$str + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good put $ret 0 + } + + # Now retrieve all the keys matching this key + set x 0 + for {set ret [$dbc get -set $str]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -nextdup] } { + incr x + + if { [llength $ret] == 0 } { + break + } + + set k [lindex [lindex $ret 0] 0] + if { [string compare $k $str] != 0 } { + break + } + + set datastr [lindex [lindex $ret 0] 1] + set d [data_of $datastr] + error_check_good Test030:put $d $str + + set id [ id_of $datastr ] + error_check_good Test030:dup# $id $x + } + error_check_good Test030:numdups $x $ndup + incr count + } + close $did + + # Verify on sequential pass of entire file + puts "\tTest030.b: sequential check" + + # We can't just set lastkey to a null string, since that might + # be a key now! + set lastkey "THIS STRING WILL NEVER BE A KEY" + + for {set ret [$dbc get -first]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -next] } { + + # Outer loop should always get a new key + + set k [lindex [lindex $ret 0] 0] + error_check_bad outer_get_loop:key $k $lastkey + + set datastr [lindex [lindex $ret 0] 1] + set d [data_of $datastr] + set id [ id_of $datastr ] + + error_check_good outer_get_loop:data $d $k + error_check_good outer_get_loop:id $id 1 + + set lastkey $k + # Figure out how may dups we should have + set ret [eval {$cntdb get} $txn $pflags {$k}] + set ndup [lindex [lindex $ret 0] 1] + + set howmany 1 + for { set ret [$dbc get -nextdup] } \ + { [llength $ret] != 0 } \ + { set ret [$dbc get -nextdup] } { + incr howmany + + set k [lindex [lindex $ret 0] 0] + error_check_good inner_get_loop:key $k $lastkey + + set datastr [lindex [lindex $ret 0] 1] + set d [data_of $datastr] + set id [ id_of $datastr ] + + error_check_good inner_get_loop:data $d $k + error_check_good inner_get_loop:id $id $howmany + + } + error_check_good ndups_found $howmany $ndup + } + + # Verify on key lookup + puts "\tTest030.c: keyed check" + set cnt_dbc [$cntdb cursor] + for {set ret [$cnt_dbc get -first]} \ + {[llength $ret] != 0} \ + {set ret [$cnt_dbc get -next] } { + set k [lindex [lindex $ret 0] 0] + + set howmany [lindex [lindex $ret 0] 1] + error_check_bad cnt_seq:data [string length $howmany] 0 + + set i 0 + for {set ret [$dbc get -set $k]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -nextdup] } { + incr i + + set k [lindex [lindex $ret 0] 0] + + set datastr [lindex [lindex $ret 0] 1] + set d [data_of $datastr] + set id [ id_of $datastr ] + + error_check_good inner_get_loop:data $d $k + error_check_good inner_get_loop:id $id $i + } + error_check_good keyed_count $i $howmany + + } + error_check_good cnt_curs_close [$cnt_dbc close] 0 + error_check_good db_curs_close [$dbc close] 0 + error_check_good cnt_file_close [$cntdb close] 0 + error_check_good db_file_close [$db close] 0 +} diff --git a/bdb/test/test031.tcl b/bdb/test/test031.tcl new file mode 100644 index 00000000000..35041541fa7 --- /dev/null +++ b/bdb/test/test031.tcl @@ -0,0 +1,196 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test031.tcl,v 11.17 2000/11/06 19:31:55 sue Exp $ +# +# DB Test 31 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and "ndups" duplicates +# For the data field, prepend random five-char strings (see test032) +# that we force the duplicate sorting code to do something. +# Along the way, test that we cannot insert duplicate duplicates +# using DB_NODUPDATA. +# By setting ndups large, we can make this an off-page test +# After all are entered, retrieve all; verify output. +# Close file, reopen, do retrieve and re-verify. +# This does not work for recno +proc test031 { method {nentries 10000} {ndups 5} {tnum 31} args } { + global alphabet + global rand_init + source ./include.tcl + + berkdb srand $rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + # Create the database and open the dictionary + 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/test0$tnum.db + set checkdb $testdir/checkdb.db + set env NULL + } else { + set testfile test0$tnum.db + set checkdb checkdb.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + puts "Test0$tnum: \ + $method ($args) $nentries small sorted dup key/data pairs" + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $omethod" + return + } + set db [eval {berkdb_open -create -truncate \ + -mode 0644} $args {$omethod -dup -dupsort $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set check_db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {-hash $checkdb}] + error_check_good dbopen:check_db [is_valid_db $check_db] TRUE + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put and get each key/data pair + puts "\tTest0$tnum.a: Put/get loop, check nodupdata" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + while { [gets $did str] != -1 && $count < $nentries } { + # Re-initialize random string generator + randstring_init $ndups + + set dups "" + for { set i 1 } { $i <= $ndups } { incr i } { + set pref [randstring] + set dups $dups$pref + set datastr $pref:$str + if { $i == 2 } { + set nodupstr $datastr + } + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good put $ret 0 + } + + # Test DB_NODUPDATA using the DB handle + set ret [eval {$db put -nodupdata} \ + $txn $pflags {$str [chop_data $method $nodupstr]}] + error_check_good db_nodupdata [is_substr $ret "DB_KEYEXIST"] 1 + + set ret [eval {$check_db put} \ + $txn $pflags {$str [chop_data $method $dups]}] + error_check_good checkdb_put $ret 0 + + # Now retrieve all the keys matching this key + set x 0 + set lastdup "" + # Test DB_NODUPDATA using cursor handle + set ret [$dbc get -set $str] + error_check_bad dbc_get [llength $ret] 0 + set datastr [lindex [lindex $ret 0] 1] + error_check_bad dbc_data [string length $datastr] 0 + set ret [eval {$dbc put -nodupdata} \ + {$str [chop_data $method $datastr]}] + error_check_good dbc_nodupdata [is_substr $ret "DB_KEYEXIST"] 1 + + for {set ret [$dbc get -set $str]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -nextdup] } { + set k [lindex [lindex $ret 0] 0] + if { [string compare $k $str] != 0 } { + break + } + set datastr [lindex [lindex $ret 0] 1] + if {[string length $datastr] == 0} { + break + } + if {[string compare \ + $lastdup [pad_data $method $datastr]] > 0} { + error_check_good \ + sorted_dups($lastdup,$datastr) 0 1 + } + incr x + set lastdup $datastr + } + error_check_good "Test0$tnum:ndups:$str" $x $ndups + incr count + } + error_check_good cursor_close [$dbc close] 0 + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest0$tnum.b: Checking file for correct duplicates" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open(2) [is_substr $dbc $db] 1 + + set lastkey "THIS WILL NEVER BE A KEY VALUE" + # no need to delete $lastkey + set firsttimethru 1 + for {set ret [$dbc get -first]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -next] } { + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_bad data_check:$d [string length $d] 0 + + if { [string compare $k $lastkey] != 0 } { + # Remove last key from the checkdb + if { $firsttimethru != 1 } { + error_check_good check_db:del:$lastkey \ + [eval {$check_db del} $txn {$lastkey}] 0 + } + set firsttimethru 0 + set lastdup "" + set lastkey $k + set dups [lindex [lindex [eval {$check_db get} \ + $txn {$k}] 0] 1] + error_check_good check_db:get:$k \ + [string length $dups] [expr $ndups * 4] + } + + if { [string compare $lastdup $d] > 0 } { + error_check_good dup_check:$k:$d 0 1 + } + set lastdup $d + + set pref [string range $d 0 3] + set ndx [string first $pref $dups] + error_check_good valid_duplicate [expr $ndx >= 0] 1 + set a [string range $dups 0 [expr $ndx - 1]] + set b [string range $dups [expr $ndx + 4] end] + set dups $a$b + } + # Remove last key from the checkdb + if { [string length $lastkey] != 0 } { + error_check_good check_db:del:$lastkey \ + [eval {$check_db del} $txn {$lastkey}] 0 + } + + # Make sure there is nothing left in check_db + + set check_c [eval {$check_db cursor} $txn] + set ret [$check_c get -first] + error_check_good check_c:get:$ret [llength $ret] 0 + error_check_good check_c:close [$check_c close] 0 + error_check_good check_db:close [$check_db close] 0 + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test032.tcl b/bdb/test/test032.tcl new file mode 100644 index 00000000000..1504ec5cc2d --- /dev/null +++ b/bdb/test/test032.tcl @@ -0,0 +1,195 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test032.tcl,v 11.15 2000/08/25 14:21:55 sue Exp $ +# +# DB Test 32 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and "ndups" duplicates +# For the data field, prepend the letters of the alphabet +# in a random order so that we force the duplicate sorting +# code to do something. +# By setting ndups large, we can make this an off-page test +# After all are entered; test the DB_GET_BOTH functionality +# first by retrieving each dup in the file explicitly. Then +# test the failure case. +proc test032 { method {nentries 10000} {ndups 5} {tnum 32} args } { + global alphabet rand_init + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + berkdb srand $rand_init + + # Create the database and open the dictionary + 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/test0$tnum.db + set checkdb $testdir/checkdb.db + set env NULL + } else { + set testfile test0$tnum.db + set checkdb checkdb.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + puts "Test0$tnum:\ + $method ($args) $nentries small sorted dup key/data pairs" + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $omethod" + return + } + set db [eval {berkdb_open -create -truncate -mode 0644 \ + $omethod -dup -dupsort} $args {$testfile} ] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set check_db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {-hash $checkdb}] + error_check_good dbopen:check_db [is_valid_db $check_db] TRUE + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put and get each key/data pair + puts "\tTest0$tnum.a: Put/get loop" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + while { [gets $did str] != -1 && $count < $nentries } { + # Re-initialize random string generator + randstring_init $ndups + + set dups "" + for { set i 1 } { $i <= $ndups } { incr i } { + set pref [randstring] + set dups $dups$pref + set datastr $pref:$str + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good put $ret 0 + } + set ret [eval {$check_db put} \ + $txn $pflags {$str [chop_data $method $dups]}] + error_check_good checkdb_put $ret 0 + + # Now retrieve all the keys matching this key + set x 0 + set lastdup "" + for {set ret [$dbc get -set $str]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -nextdup] } { + set k [lindex [lindex $ret 0] 0] + if { [string compare $k $str] != 0 } { + break + } + set datastr [lindex [lindex $ret 0] 1] + if {[string length $datastr] == 0} { + break + } + if {[string compare $lastdup $datastr] > 0} { + error_check_good sorted_dups($lastdup,$datastr)\ + 0 1 + } + incr x + set lastdup $datastr + } + + error_check_good "Test0$tnum:ndups:$str" $x $ndups + incr count + } + error_check_good cursor_close [$dbc close] 0 + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest0$tnum.b: Checking file for correct duplicates (no cursor)" + set check_c [eval {$check_db cursor} $txn] + error_check_good check_c_open(2) \ + [is_substr $check_c $check_db] 1 + + for {set ndx 0} {$ndx < [expr 4 * $ndups]} {incr ndx 4} { + for {set ret [$check_c get -first]} \ + {[llength $ret] != 0} \ + {set ret [$check_c get -next] } { + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_bad data_check:$d [string length $d] 0 + + set pref [string range $d $ndx [expr $ndx + 3]] + set data $pref:$k + set ret [eval {$db get} $txn {-get_both $k $data}] + error_check_good \ + get_both_data:$k $ret [list [list $k $data]] + } + } + + $db sync + # Now repeat the above test using cursor ops + puts "\tTest0$tnum.c: Checking file for correct duplicates (cursor)" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + + for {set ndx 0} {$ndx < [expr 4 * $ndups]} {incr ndx 4} { + for {set ret [$check_c get -first]} \ + {[llength $ret] != 0} \ + {set ret [$check_c get -next] } { + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_bad data_check:$d [string length $d] 0 + + set pref [string range $d $ndx [expr $ndx + 3]] + set data $pref:$k + set ret [eval {$dbc get} {-get_both $k $data}] + error_check_good \ + get_both_key:$k $ret [list [list $k $data]] + } + } + + # Now check the error case + puts "\tTest0$tnum.d: Check error case (no cursor)" + for {set ret [$check_c get -first]} \ + {[llength $ret] != 0} \ + {set ret [$check_c get -next] } { + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_bad data_check:$d [string length $d] 0 + + set data XXX$k + set ret [eval {$db get} $txn {-get_both $k $data}] + error_check_good error_case:$k [llength $ret] 0 + } + + # Now check the error case + puts "\tTest0$tnum.e: Check error case (cursor)" + for {set ret [$check_c get -first]} \ + {[llength $ret] != 0} \ + {set ret [$check_c get -next] } { + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_bad data_check:$d [string length $d] 0 + + set data XXX$k + set ret [eval {$dbc get} {-get_both $k $data}] + error_check_good error_case:$k [llength $ret] 0 + } + + error_check_good check_c:close [$check_c close] 0 + error_check_good check_db:close [$check_db close] 0 + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test033.tcl b/bdb/test/test033.tcl new file mode 100644 index 00000000000..ed46e6bda04 --- /dev/null +++ b/bdb/test/test033.tcl @@ -0,0 +1,103 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test033.tcl,v 11.11 2000/10/25 15:45:20 sue Exp $ +# +# DB Test 33 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and data; add duplicate +# records for each. +# After all are entered, retrieve all; verify output by doing +# DB_GET_BOTH on existing and non-existing keys. +# This does not work for recno +proc test033 { method {nentries 10000} {ndups 5} {tnum 33} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test0$tnum: $method ($args) $nentries small dup key/data pairs" + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $omethod" + return + } + + # Create the database and open the dictionary + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + set db [eval {berkdb_open -create -truncate -mode 0644 \ + $omethod -dup} $args {$testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + puts "\tTest0$tnum.a: Put/get loop." + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + for { set i 1 } { $i <= $ndups } { incr i } { + set datastr $i:$str + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good db_put $ret 0 + } + + # Now retrieve all the keys matching this key and dup + for {set i 1} {$i <= $ndups } { incr i } { + set datastr $i:$str + set ret [eval {$db get} $txn {-get_both $str $datastr}] + error_check_good "Test0$tnum:dup#" [lindex \ + [lindex $ret 0] 1] [pad_data $method $datastr] + } + + # Now retrieve non-existent dup (i is ndups + 1) + set datastr $i:$str + set ret [eval {$db get} $txn {-get_both $str $datastr}] + error_check_good Test0$tnum:dupfailure [llength $ret] 0 + incr count + } + close $did + + set did [open $dict] + set count 0 + puts "\tTest0$tnum.b: Verifying DB_GET_BOTH after creation." + while { [gets $did str] != -1 && $count < $nentries } { + # Now retrieve all the keys matching this key and dup + for {set i 1} {$i <= $ndups } { incr i } { + set datastr $i:$str + set ret [eval {$db get} $txn {-get_both $str $datastr}] + error_check_good "Test0$tnum:dup#" \ + [lindex [lindex $ret 0] 1] $datastr + } + + # Now retrieve non-existent dup (i is ndups + 1) + set datastr $i:$str + set ret [eval {$db get} $txn {-get_both $str $datastr}] + error_check_good Test0$tnum:dupfailure [llength $ret] 0 + incr count + } + close $did + + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test034.tcl b/bdb/test/test034.tcl new file mode 100644 index 00000000000..b82f369f791 --- /dev/null +++ b/bdb/test/test034.tcl @@ -0,0 +1,16 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test034.tcl,v 11.4 2000/02/14 03:00:19 bostic Exp $ +# +# DB Test 34 {access method} +# DB_GET_BOTH functionality with off-page duplicates. +proc test034 { method {nentries 10000} args} { + # Test with off-page duplicates + eval {test032 $method $nentries 20 34 -pagesize 512} $args + + # Test with multiple pages of off-page duplicates + eval {test032 $method [expr $nentries / 10] 100 34 -pagesize 512} $args +} diff --git a/bdb/test/test035.tcl b/bdb/test/test035.tcl new file mode 100644 index 00000000000..e2afef4afb3 --- /dev/null +++ b/bdb/test/test035.tcl @@ -0,0 +1,16 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test035.tcl,v 11.3 2000/02/14 03:00:19 bostic Exp $ +# +# DB Test 35 {access method} +# DB_GET_BOTH functionality with off-page duplicates. +proc test035 { method {nentries 10000} args} { + # Test with off-page duplicates + eval {test033 $method $nentries 20 35 -pagesize 512} $args + + # Test with multiple pages of off-page duplicates + eval {test033 $method [expr $nentries / 10] 100 35 -pagesize 512} $args +} diff --git a/bdb/test/test036.tcl b/bdb/test/test036.tcl new file mode 100644 index 00000000000..4d859c0652a --- /dev/null +++ b/bdb/test/test036.tcl @@ -0,0 +1,135 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test036.tcl,v 11.13 2000/08/25 14:21:55 sue Exp $ +# +# DB Test 36 {access method} +# Put nentries key/data pairs (from the dictionary) using a cursor +# and KEYFIRST and KEYLAST (this tests the case where use use cursor +# put for non-existent keys). +proc test036 { method {nentries 10000} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test036: $method ($args) $nentries equal key/data pairs" + if { [is_record_based $method] == 1 } { + puts "Test036 skipping for method recno" + return + } + + # Create the database and open the dictionary + 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/test036.db + set env NULL + } else { + set testfile test036.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + set checkfunc test036_recno.check + append gflags " -recno" + } else { + set checkfunc test036.check + } + puts "\tTest036.a: put/get loop KEYFIRST" + # Here is the loop where we put and get each key/data pair + set dbc [eval {$db cursor} $txn] + error_check_good cursor [is_substr $dbc $db] 1 + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) $str + } else { + set key $str + } + set ret [eval {$dbc put} $txn $pflags {-keyfirst $key $str}] + error_check_good put $ret 0 + + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good get [lindex [lindex $ret 0] 1] $str + incr count + } + error_check_good dbc_close [$dbc close] 0 + + puts "\tTest036.a: put/get loop KEYLAST" + set dbc [eval {$db cursor} $txn] + error_check_good cursor [is_substr $dbc $db] 1 + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) $str + } else { + set key $str + } + set ret [eval {$dbc put} $txn $pflags {-keylast $key $str}] + error_check_good put $ret 0 + + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good get [lindex [lindex $ret 0] 1] $str + incr count + } + error_check_good dbc_close [$dbc close] 0 + close $did + + # Now we will get each key from the DB and compare the results + # to the original. + puts "\tTest036.c: dump file" + dump_file $db $txn $t1 $checkfunc + error_check_good db_close [$db close] 0 + + # Now compare the keys to see if they match the dictionary (or ints) + if { [is_record_based $method] == 1 } { + set oid [open $t2 w] + for {set i 1} {$i <= $nentries} {set i [incr i]} { + puts $oid $i + } + close $oid + file rename -force $t1 $t3 + } else { + set q q + filehead $nentries $dict $t3 + filesort $t3 $t2 + filesort $t1 $t3 + } + +} + +# Check function for test036; keys and data are identical +proc test036.check { key data } { + error_check_good "key/data mismatch" $data $key +} + +proc test036_recno.check { key data } { + global dict + global kvals + + error_check_good key"$key"_exists [info exists kvals($key)] 1 + error_check_good "key/data mismatch, key $key" $data $kvals($key) +} diff --git a/bdb/test/test037.tcl b/bdb/test/test037.tcl new file mode 100644 index 00000000000..31528c6ee54 --- /dev/null +++ b/bdb/test/test037.tcl @@ -0,0 +1,191 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test037.tcl,v 11.11 2000/08/25 14:21:55 sue Exp $ +# +# Test037: RMW functionality. +proc test037 { method {nentries 100} args } { + source ./include.tcl + set eindex [lsearch -exact $args "-env"] + # + # If we are using an env, then skip this test. It needs its own. + if { $eindex != -1 } { + incr eindex + set env [lindex $args $eindex] + puts "Test037 skipping for env $env" + return + } + + puts "Test037: RMW $method" + + set args [convert_args $method $args] + set omethod [convert_method $method] + + # Create the database + env_cleanup $testdir + set testfile test037.db + + set local_env \ + [berkdb env -create -mode 0644 -txn -home $testdir] + error_check_good dbenv [is_valid_env $local_env] TRUE + + set db [eval {berkdb_open \ + -env $local_env -create -mode 0644 $omethod} $args {$testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set did [open $dict] + set count 0 + + set pflags "" + set gflags "" + set txn "" + + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + + puts "\tTest037.a: Creating database" + # Here is the loop where we put and get each key/data pair + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + global kvals + + set key [expr $count + 1] + set kvals($key) [pad_data $method $str] + } else { + set key $str + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $str]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $txn $gflags {$key}] + error_check_good get \ + [lindex [lindex $ret 0] 1] [pad_data $method $str] + incr count + } + close $did + error_check_good dbclose [$db close] 0 + error_check_good envclode [$local_env close] 0 + + puts "\tTest037.b: Setting up environments" + + # Open local environment + set env_cmd [concat berkdb env -create -txn -home $testdir] + set local_env [eval $env_cmd] + error_check_good dbenv [is_valid_widget $local_env env] TRUE + + # Open local transaction + set local_txn [$local_env txn] + error_check_good txn_open [is_valid_txn $local_txn $local_env] TRUE + + # Open remote environment + set f1 [open |$tclsh_path r+] + puts $f1 "source $test_path/test.tcl" + + set remote_env [send_cmd $f1 $env_cmd] + error_check_good remote:env_open [is_valid_env $remote_env] TRUE + + # Open remote transaction + set remote_txn [send_cmd $f1 "$remote_env txn"] + error_check_good \ + remote:txn_open [is_valid_txn $remote_txn $remote_env] TRUE + + # Now try put test without RMW. Gets on one site should not + # lock out gets on another. + + # Open databases and dictionary + puts "\tTest037.c: Opening databases" + set did [open $dict] + set rkey 0 + + set db [berkdb_open -env $local_env $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + set rdb [send_cmd $f1 \ + "berkdb_open -env $remote_env -mode 0644 $testfile"] + error_check_good remote:dbopen [is_valid_widget $rdb db] TRUE + + puts "\tTest037.d: Testing without RMW" + + # Now, get a key and try to "get" it from both DBs. + error_check_bad "gets on new open" [gets $did str] -1 + incr rkey + if { [is_record_based $method] == 1 } { + set key $rkey + } else { + set key $str + } + + set rec [eval {$db get -txn $local_txn} $gflags {$key}] + error_check_good local_get [lindex [lindex $rec 0] 1] \ + [pad_data $method $str] + + set r [send_timed_cmd $f1 0 "$rdb get -txn $remote_txn $gflags $key"] + error_check_good remote_send $r 0 + + # Now sleep before releasing local record lock + tclsleep 5 + error_check_good local_commit [$local_txn commit] 0 + + # Now get the remote result + set remote_time [rcv_result $f1] + error_check_good no_rmw_get:remote_time [expr $remote_time <= 1] 1 + + # Commit the remote + set r [send_cmd $f1 "$remote_txn commit"] + error_check_good remote_commit $r 0 + + puts "\tTest037.e: Testing with RMW" + + # Open local transaction + set local_txn [$local_env txn] + error_check_good \ + txn_open [is_valid_widget $local_txn $local_env.txn] TRUE + + # Open remote transaction + set remote_txn [send_cmd $f1 "$remote_env txn"] + error_check_good remote:txn_open \ + [is_valid_widget $remote_txn $remote_env.txn] TRUE + + # Now, get a key and try to "get" it from both DBs. + error_check_bad "gets on new open" [gets $did str] -1 + incr rkey + if { [is_record_based $method] == 1 } { + set key $rkey + } else { + set key $str + } + + set rec [eval {$db get -txn $local_txn -rmw} $gflags {$key}] + error_check_good \ + local_get [lindex [lindex $rec 0] 1] [pad_data $method $str] + + set r [send_timed_cmd $f1 0 "$rdb get -txn $remote_txn $gflags $key"] + error_check_good remote_send $r 0 + + # Now sleep before releasing local record lock + tclsleep 5 + error_check_good local_commit [$local_txn commit] 0 + + # Now get the remote result + set remote_time [rcv_result $f1] + error_check_good rmw_get:remote_time [expr $remote_time > 4] 1 + + # Commit the remote + set r [send_cmd $f1 "$remote_txn commit"] + error_check_good remote_commit $r 0 + + # Close everything up: remote first + set r [send_cmd $f1 "$rdb close"] + error_check_good remote_db_close $r 0 + + set r [send_cmd $f1 "$remote_env close"] + + # Close locally + error_check_good db_close [$db close] 0 + $local_env close + close $did + close $f1 +} diff --git a/bdb/test/test038.tcl b/bdb/test/test038.tcl new file mode 100644 index 00000000000..2a726f1bcd9 --- /dev/null +++ b/bdb/test/test038.tcl @@ -0,0 +1,174 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test038.tcl,v 11.12 2000/08/25 14:21:56 sue Exp $ +# +# DB Test 38 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and "ndups" duplicates +# For the data field, prepend the letters of the alphabet +# in a random order so that we force the duplicate sorting +# code to do something. +# By setting ndups large, we can make this an off-page test +# After all are entered; test the DB_GET_BOTH functionality +# first by retrieving each dup in the file explicitly. Then +# remove each duplicate and try DB_GET_BOTH again. +proc test038 { method {nentries 10000} {ndups 5} {tnum 38} args } { + global alphabet + global rand_init + source ./include.tcl + + berkdb srand $rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + # Create the database and open the dictionary + 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/test0$tnum.db + set checkdb $testdir/checkdb.db + set env NULL + } else { + set testfile test0$tnum.db + set checkdb checkdb.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + puts "Test0$tnum: \ + $method ($args) $nentries small sorted dup key/data pairs" + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $method" + return + } + set db [eval {berkdb_open -create -truncate -mode 0644 \ + $omethod -dup -dupsort} $args {$testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set check_db [berkdb_open \ + -create -truncate -mode 0644 -hash $checkdb] + error_check_good dbopen:check_db [is_valid_db $check_db] TRUE + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put and get each key/data pair + puts "\tTest0$tnum.a: Put/get loop" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + while { [gets $did str] != -1 && $count < $nentries } { + set dups "" + for { set i 1 } { $i <= $ndups } { incr i } { + set pref \ + [string index $alphabet [berkdb random_int 0 25]] + set pref $pref[string \ + index $alphabet [berkdb random_int 0 25]] + while { [string first $pref $dups] != -1 } { + set pref [string toupper $pref] + if { [string first $pref $dups] != -1 } { + set pref [string index $alphabet \ + [berkdb random_int 0 25]] + set pref $pref[string index $alphabet \ + [berkdb random_int 0 25]] + } + } + if { [string length $dups] == 0 } { + set dups $pref + } else { + set dups "$dups $pref" + } + set datastr $pref:$str + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good put $ret 0 + } + set ret [eval {$check_db put} \ + $txn $pflags {$str [chop_data $method $dups]}] + error_check_good checkdb_put $ret 0 + + # Now retrieve all the keys matching this key + set x 0 + set lastdup "" + for {set ret [$dbc get -set $str]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -nextdup] } { + set k [lindex [lindex $ret 0] 0] + if { [string compare $k $str] != 0 } { + break + } + set datastr [lindex [lindex $ret 0] 1] + if {[string length $datastr] == 0} { + break + } + if {[string compare $lastdup $datastr] > 0} { + error_check_good sorted_dups($lastdup,$datastr)\ + 0 1 + } + incr x + set lastdup $datastr + } + error_check_good "Test0$tnum:ndups:$str" $x $ndups + incr count + } + error_check_good cursor_close [$dbc close] 0 + close $did + + # Now check the duplicates, then delete then recheck + puts "\tTest0$tnum.b: Checking and Deleting duplicates" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + set check_c [eval {$check_db cursor} $txn] + error_check_good cursor_open [is_substr $check_c $check_db] 1 + + for {set ndx 0} {$ndx < $ndups} {incr ndx} { + for {set ret [$check_c get -first]} \ + {[llength $ret] != 0} \ + {set ret [$check_c get -next] } { + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_bad data_check:$d [string length $d] 0 + + set nn [expr $ndx * 3] + set pref [string range $d $nn [expr $nn + 1]] + set data $pref:$k + set ret [eval {$dbc get} $txn {-get_both $k $data}] + error_check_good \ + get_both_key:$k [lindex [lindex $ret 0] 0] $k + error_check_good \ + get_both_data:$k [lindex [lindex $ret 0] 1] $data + set ret [$dbc del] + error_check_good del $ret 0 + set ret [eval {$db get} $txn {-get_both $k $data}] + error_check_good error_case:$k [llength $ret] 0 + + if {$ndx != 0} { + set n [expr ($ndx - 1) * 3] + set pref [string range $d $n [expr $n + 1]] + set data $pref:$k + set ret \ + [eval {$db get} $txn {-get_both $k $data}] + error_check_good error_case:$k [llength $ret] 0 + } + } + } + + error_check_good check_c:close [$check_c close] 0 + error_check_good check_db:close [$check_db close] 0 + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test039.tcl b/bdb/test/test039.tcl new file mode 100644 index 00000000000..957468ce542 --- /dev/null +++ b/bdb/test/test039.tcl @@ -0,0 +1,177 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test039.tcl,v 11.11 2000/08/25 14:21:56 sue Exp $ +# +# DB Test 39 {access method} +# Use the first 10,000 entries from the dictionary. +# Insert each with self as key and "ndups" duplicates +# For the data field, prepend the letters of the alphabet +# in a random order so that we force the duplicate sorting +# code to do something. +# By setting ndups large, we can make this an off-page test +# After all are entered; test the DB_GET_BOTH functionality +# first by retrieving each dup in the file explicitly. Then +# remove each duplicate and try DB_GET_BOTH again. +proc test039 { method {nentries 10000} {ndups 5} {tnum 39} args } { + global alphabet + global rand_init + source ./include.tcl + + berkdb srand $rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + # Create the database and open the dictionary + 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/test0$tnum.db + set checkdb $testdir/checkdb.db + set env NULL + } else { + set testfile test0$tnum.db + set checkdb checkdb.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + cleanup $testdir $env + + puts "Test0$tnum: $method $nentries small unsorted dup key/data pairs" + if { [is_record_based $method] == 1 || \ + [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $method" + return + } + + set db [eval {berkdb_open -create -truncate -mode 0644 \ + $omethod -dup} $args {$testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set check_db \ + [berkdb_open -create -truncate -mode 0644 -hash $checkdb] + error_check_good dbopen:check_db [is_valid_db $check_db] TRUE + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put and get each key/data pair + puts "\tTest0$tnum.a: Put/get loop" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + while { [gets $did str] != -1 && $count < $nentries } { + set dups "" + for { set i 1 } { $i <= $ndups } { incr i } { + set pref \ + [string index $alphabet [berkdb random_int 0 25]] + set pref $pref[string \ + index $alphabet [berkdb random_int 0 25]] + while { [string first $pref $dups] != -1 } { + set pref [string toupper $pref] + if { [string first $pref $dups] != -1 } { + set pref [string index $alphabet \ + [berkdb random_int 0 25]] + set pref $pref[string index $alphabet \ + [berkdb random_int 0 25]] + } + } + if { [string length $dups] == 0 } { + set dups $pref + } else { + set dups "$dups $pref" + } + set datastr $pref:$str + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good put $ret 0 + } + set ret [eval {$check_db put} \ + $txn $pflags {$str [chop_data $method $dups]}] + error_check_good checkdb_put $ret 0 + + # Now retrieve all the keys matching this key + set x 0 + set lastdup "" + for {set ret [$dbc get -set $str]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -nextdup] } { + set k [lindex [lindex $ret 0] 0] + if { [string compare $k $str] != 0 } { + break + } + set datastr [lindex [lindex $ret 0] 1] + if {[string length $datastr] == 0} { + break + } + set xx [expr $x * 3] + set check_data \ + [string range $dups $xx [expr $xx + 1]]:$k + error_check_good retrieve $datastr $check_data + incr x + } + error_check_good "Test0$tnum:ndups:$str" $x $ndups + incr count + } + error_check_good cursor_close [$dbc close] 0 + close $did + + # Now check the duplicates, then delete then recheck + puts "\tTest0$tnum.b: Checking and Deleting duplicates" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + set check_c [eval {$check_db cursor} $txn] + error_check_good cursor_open [is_substr $check_c $check_db] 1 + + for {set ndx 0} {$ndx < $ndups} {incr ndx} { + for {set ret [$check_c get -first]} \ + {[llength $ret] != 0} \ + {set ret [$check_c get -next] } { + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_bad data_check:$d [string length $d] 0 + + set nn [expr $ndx * 3] + set pref [string range $d $nn [expr $nn + 1]] + set data $pref:$k + set ret \ + [eval {$dbc get} $txn $gflags {-get_both $k $data}] + error_check_good \ + get_both_key:$k [lindex [lindex $ret 0] 0] $k + error_check_good \ + get_both_data:$k [lindex [lindex $ret 0] 1] $data + + set ret [$dbc del] + error_check_good del $ret 0 + + set ret \ + [eval {$dbc get} $txn $gflags {-get_both $k $data}] + error_check_good error_case:$k [llength $ret] 0 + + if {$ndx != 0} { + set n [expr ($ndx - 1) * 3] + set pref [string range $d $n [expr $n + 1]] + set data $pref:$k + set ret [eval {$dbc get} \ + $txn $gflags {-get_both $k $data}] + error_check_good error_case:$k [llength $ret] 0 + } + } + } + + error_check_good check_c:close [$check_c close] 0 + error_check_good check_db:close [$check_db close] 0 + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test040.tcl b/bdb/test/test040.tcl new file mode 100644 index 00000000000..912e1735d8e --- /dev/null +++ b/bdb/test/test040.tcl @@ -0,0 +1,16 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test040.tcl,v 11.3 2000/02/14 03:00:20 bostic Exp $ +# +# DB Test 40 {access method} +# DB_GET_BOTH functionality with off-page duplicates. +proc test040 { method {nentries 10000} args} { + # Test with off-page duplicates + eval {test038 $method $nentries 20 40 -pagesize 512} $args + + # Test with multiple pages of off-page duplicates + eval {test038 $method [expr $nentries / 10] 100 40 -pagesize 512} $args +} diff --git a/bdb/test/test041.tcl b/bdb/test/test041.tcl new file mode 100644 index 00000000000..bba89f49b5a --- /dev/null +++ b/bdb/test/test041.tcl @@ -0,0 +1,16 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test041.tcl,v 11.3 2000/02/14 03:00:20 bostic Exp $ +# +# DB Test 41 {access method} +# DB_GET_BOTH functionality with off-page duplicates. +proc test041 { method {nentries 10000} args} { + # Test with off-page duplicates + eval {test039 $method $nentries 20 41 -pagesize 512} $args + + # Test with multiple pages of off-page duplicates + eval {test039 $method [expr $nentries / 10] 100 41 -pagesize 512} $args +} diff --git a/bdb/test/test042.tcl b/bdb/test/test042.tcl new file mode 100644 index 00000000000..232cb3a6b0e --- /dev/null +++ b/bdb/test/test042.tcl @@ -0,0 +1,149 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test042.tcl,v 11.24 2000/08/25 14:21:56 sue Exp $ +# +# DB Test 42 {access method} +# +# Multiprocess DB test; verify that locking is working for the concurrent +# access method product. +# +# Use the first "nentries" words from the dictionary. Insert each with self +# as key and a fixed, medium length data string. Then fire off multiple +# processes that bang on the database. Each one should try to read and write +# random keys. When they rewrite, they'll append their pid to the data string +# (sometimes doing a rewrite sometimes doing a partial put). Some will use +# cursors to traverse through a few keys before finding one to write. + +set datastr abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz + +proc test042 { method {nentries 1000} args } { + global datastr + source ./include.tcl + + # + # If we are using an env, then skip this test. It needs its own. + set eindex [lsearch -exact $args "-env"] + if { $eindex != -1 } { + incr eindex + set env [lindex $args $eindex] + puts "Test042 skipping for env $env" + return + } + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test042: CDB Test $method $nentries" + + # Set initial parameters + set do_exit 0 + set iter 10000 + set procs 5 + + # Process arguments + set oargs "" + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -dir { incr i; set testdir [lindex $args $i] } + -iter { incr i; set iter [lindex $args $i] } + -procs { incr i; set procs [lindex $args $i] } + -exit { set do_exit 1 } + default { append oargs " " [lindex $args $i] } + } + } + + # Create the database and open the dictionary + set testfile test042.db + set t1 $testdir/t1 + set t2 $testdir/t2 + set t3 $testdir/t3 + + env_cleanup $testdir + + set env [berkdb env -create -cdb -home $testdir] + error_check_good dbenv [is_valid_widget $env env] TRUE + + set db [eval {berkdb_open -env $env -create -truncate \ + -mode 0644 $omethod} $oargs {$testfile}] + error_check_good dbopen [is_valid_widget $db db] TRUE + + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put each key/data pair + puts "\tTest042.a: put/get loop" + while { [gets $did str] != -1 && $count < $nentries } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + } else { + set key $str + } + set ret [eval {$db put} \ + $txn $pflags {$key [chop_data $method $datastr]}] + error_check_good put:$db $ret 0 + incr count + } + close $did + error_check_good close:$db [$db close] 0 + + # Database is created, now set up environment + + # Remove old mpools and Open/create the lock and mpool regions + error_check_good env:close:$env [$env close] 0 + set ret [berkdb envremove -home $testdir] + error_check_good env_remove $ret 0 + + set env [berkdb env -create -cdb -home $testdir] + error_check_good dbenv [is_valid_widget $env env] TRUE + + if { $do_exit == 1 } { + return + } + + # Now spawn off processes + berkdb debug_check + puts "\tTest042.b: forking off $procs children" + set pidlist {} + + for { set i 0 } {$i < $procs} {incr i} { + puts "exec $tclsh_path $test_path/wrap.tcl \ + mdbscript.tcl $testdir/test042.$i.log \ + $method $testdir $testfile $nentries $iter $i $procs &" + set p [exec $tclsh_path $test_path/wrap.tcl \ + mdbscript.tcl $testdir/test042.$i.log $method \ + $testdir $testfile $nentries $iter $i $procs &] + lappend pidlist $p + } + puts "Test042: $procs independent processes now running" + watch_procs + + # Check for test failure + set e [eval findfail [glob $testdir/test042.*.log]] + error_check_good "FAIL: error message(s) in log files" $e 0 + + # Test is done, blow away lock and mpool region + reset_env $env +} + +# If we are renumbering, then each time we delete an item, the number of +# items in the file is temporarily decreased, so the highest record numbers +# do not exist. To make sure this doesn't happen, we never generate the +# highest few record numbers as keys. +# +# For record-based methods, record numbers begin at 1, while for other keys, +# we begin at 0 to index into an array. +proc rand_key { method nkeys renum procs} { + if { $renum == 1 } { + return [berkdb random_int 1 [expr $nkeys - $procs]] + } elseif { [is_record_based $method] == 1 } { + return [berkdb random_int 1 $nkeys] + } else { + return [berkdb random_int 0 [expr $nkeys - 1]] + } +} diff --git a/bdb/test/test043.tcl b/bdb/test/test043.tcl new file mode 100644 index 00000000000..274ec1b7184 --- /dev/null +++ b/bdb/test/test043.tcl @@ -0,0 +1,162 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test043.tcl,v 11.12 2000/08/25 14:21:56 sue Exp $ +# +# DB Test 43 {method nentries} +# Test the Record number implicit creation and renumbering options. +proc test043 { method {nentries 10000} args} { + source ./include.tcl + + set do_renumber [is_rrecno $method] + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test043: $method ($args)" + + if { [is_record_based $method] != 1 } { + puts "Test043 skipping for method $method" + return + } + + # Create the database and open the dictionary + 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/test043.db + set env NULL + } else { + set testfile test043.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + # Create the database + set db [eval {berkdb_open -create -truncate -mode 0644} $args \ + {$omethod $testfile}] + error_check_good dbopen [is_valid_db $db] TRUE + + set pflags "" + set gflags " -recno" + set txn "" + + # First test implicit creation and retrieval + set count 1 + set interval 5 + if { $nentries < $interval } { + set nentries [expr $interval + 1] + } + puts "\tTest043.a: insert keys at $interval record intervals" + while { $count <= $nentries } { + set ret [eval {$db put} \ + $txn $pflags {$count [chop_data $method $count]}] + error_check_good "$db put $count" $ret 0 + set last $count + incr count $interval + } + + puts "\tTest043.b: get keys using DB_FIRST/DB_NEXT" + set dbc [eval {$db cursor} $txn] + error_check_good "$db cursor" [is_substr $dbc $db] 1 + + set check 1 + for { set rec [$dbc get -first] } { [llength $rec] != 0 } { + set rec [$dbc get -next] } { + set k [lindex [lindex $rec 0] 0] + set d [pad_data $method [lindex [lindex $rec 0] 1]] + error_check_good "$dbc get key==data" [pad_data $method $k] $d + error_check_good "$dbc get sequential" $k $check + if { $k > $nentries } { + error_check_good "$dbc get key too large" $k $nentries + } + incr check $interval + } + + # Now make sure that we get DB_KEYEMPTY for non-existent keys + puts "\tTest043.c: Retrieve non-existent keys" + global errorInfo + + set check 1 + for { set rec [$dbc get -first] } { [llength $rec] != 0 } { + set rec [$dbc get -next] } { + set k [lindex [lindex $rec 0] 0] + + set ret [eval {$db get} $txn $gflags {[expr $k + 1]}] + error_check_good "$db \ + get [expr $k + 1]" $ret [list] + + incr check $interval + # Make sure we don't do a retrieve past the end of file + if { $check >= $last } { + break + } + } + + # Now try deleting and make sure the right thing happens. + puts "\tTest043.d: Delete tests" + set rec [$dbc get -first] + error_check_bad "$dbc get -first" [llength $rec] 0 + error_check_good "$dbc get -first key" [lindex [lindex $rec 0] 0] 1 + error_check_good "$dbc get -first data" \ + [lindex [lindex $rec 0] 1] [pad_data $method 1] + + # Delete the first item + error_check_good "$dbc del" [$dbc del] 0 + + # Retrieving 1 should always fail + set ret [eval {$db get} $txn $gflags {1}] + error_check_good "$db get 1" $ret [list] + + # Now, retrieving other keys should work; keys will vary depending + # upon renumbering. + if { $do_renumber == 1 } { + set count [expr 0 + $interval] + set max [expr $nentries - 1] + } else { + set count [expr 1 + $interval] + set max $nentries + } + + while { $count <= $max } { + set rec [eval {$db get} $txn $gflags {$count}] + if { $do_renumber == 1 } { + set data [expr $count + 1] + } else { + set data $count + } + error_check_good "$db get $count" \ + [pad_data $method $data] [lindex [lindex $rec 0] 1] + incr count $interval + } + set max [expr $count - $interval] + + puts "\tTest043.e: Verify LAST/PREV functionality" + set count $max + for { set rec [$dbc get -last] } { [llength $rec] != 0 } { + set rec [$dbc get -prev] } { + set k [lindex [lindex $rec 0] 0] + set d [lindex [lindex $rec 0] 1] + if { $do_renumber == 1 } { + set data [expr $k + 1] + } else { + set data $k + } + error_check_good \ + "$dbc get key==data" [pad_data $method $data] $d + error_check_good "$dbc get sequential" $k $count + if { $k > $nentries } { + error_check_good "$dbc get key too large" $k $nentries + } + set count [expr $count - $interval] + if { $count < 1 } { + break + } + } + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test044.tcl b/bdb/test/test044.tcl new file mode 100644 index 00000000000..0be7a704961 --- /dev/null +++ b/bdb/test/test044.tcl @@ -0,0 +1,243 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test044.tcl,v 11.26 2000/10/27 13:23:56 sue Exp $ +# +# DB Test 44 {access method} +# System integration DB test: verify that locking, recovery, checkpoint, +# and all the other utilities basically work. +# +# The test consists of $nprocs processes operating on $nfiles files. A +# transaction consists of adding the same key/data pair to some random +# number of these files. We generate a bimodal distribution in key +# size with 70% of the keys being small (1-10 characters) and the +# remaining 30% of the keys being large (uniform distribution about +# mean $key_avg). If we generate a key, we first check to make sure +# that the key is not already in the dataset. If it is, we do a lookup. +# +# XXX This test uses grow-only files currently! +proc test044 { method {nprocs 5} {nfiles 10} {cont 0} args } { + source ./include.tcl + global rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + berkdb srand $rand_init + + # If we are using an env, then skip this test. It needs its own. + set eindex [lsearch -exact $args "-env"] + if { $eindex != -1 } { + incr eindex + set env [lindex $args $eindex] + puts "Test044 skipping for env $env" + return + } + + puts "Test044: system integration test db $method $nprocs processes \ + on $nfiles files" + + # Parse options + set otherargs "" + set key_avg 10 + set data_avg 20 + set do_exit 0 + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -key_avg { incr i; set key_avg [lindex $args $i] } + -data_avg { incr i; set data_avg [lindex $args $i] } + -testdir { incr i; set testdir [lindex $args $i] } + -x.* { set do_exit 1 } + default { + lappend otherargs [lindex $args $i] + } + } + } + + if { $cont == 0 } { + # Create the database and open the dictionary + env_cleanup $testdir + + # Create an environment + puts "\tTest044.a: creating environment and $nfiles files" + set dbenv [berkdb env -create -txn -home $testdir] + error_check_good env_open [is_valid_env $dbenv] TRUE + + # Create a bunch of files + set m $method + + for { set i 0 } { $i < $nfiles } { incr i } { + if { $method == "all" } { + switch [berkdb random_int 1 2] { + 1 { set m -btree } + 2 { set m -hash } + } + } else { + set m $omethod + } + + set db [eval {berkdb_open -env $dbenv -create \ + -mode 0644 $m} $otherargs {test044.$i.db}] + error_check_good dbopen [is_valid_db $db] TRUE + error_check_good db_close [$db close] 0 + } + } + + # Close the environment + $dbenv close + + if { $do_exit == 1 } { + return + } + + # Database is created, now fork off the kids. + puts "\tTest044.b: forking off $nprocs processes and utilities" + set cycle 1 + set ncycles 3 + while { $cycle <= $ncycles } { + set dbenv [berkdb env -create -txn -home $testdir] + error_check_good env_open [is_valid_env $dbenv] TRUE + + # Fire off deadlock detector and checkpointer + puts "Beginning cycle $cycle" + set ddpid [exec $util_path/db_deadlock -h $testdir -t 5 &] + set cppid [exec $util_path/db_checkpoint -h $testdir -p 2 &] + puts "Deadlock detector: $ddpid Checkpoint daemon $cppid" + + set pidlist {} + for { set i 0 } {$i < $nprocs} {incr i} { + set p [exec $tclsh_path \ + $test_path/sysscript.tcl $testdir \ + $nfiles $key_avg $data_avg $omethod \ + >& $testdir/test044.$i.log &] + lappend pidlist $p + } + set sleep [berkdb random_int 300 600] + puts \ +"[timestamp] $nprocs processes running $pidlist for $sleep seconds" + tclsleep $sleep + + # Now simulate a crash + puts "[timestamp] Crashing" + + # + # The environment must remain open until this point to get + # proper sharing (using the paging file) on Win/9X. [#2342] + # + error_check_good env_close [$dbenv close] 0 + + exec $KILL -9 $ddpid + exec $KILL -9 $cppid + # + # Use catch so that if any of the children died, we don't + # stop the script + # + foreach p $pidlist { + set e [catch {eval exec \ + [concat $KILL -9 $p]} res] + } + # Check for test failure + set e [eval findfail [glob $testdir/test044.*.log]] + error_check_good "FAIL: error message(s) in log files" $e 0 + + # Now run recovery + test044_verify $testdir $nfiles + incr cycle + } +} + +proc test044_usage { } { + puts -nonewline "test044 method nentries [-d directory] [-i iterations]" + puts " [-p procs] -x" +} + +proc test044_verify { dir nfiles } { + source ./include.tcl + + # Save everything away in case something breaks +# for { set f 0 } { $f < $nfiles } {incr f} { +# file copy -force $dir/test044.$f.db $dir/test044.$f.save1 +# } +# foreach f [glob $dir/log.*] { +# if { [is_substr $f save] == 0 } { +# file copy -force $f $f.save1 +# } +# } + + # Run recovery and then read through all the database files to make + # sure that they all look good. + + puts "\tTest044.verify: Running recovery and verifying file contents" + set stat [catch {exec $util_path/db_recover -h $dir} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + } + + # Save everything away in case something breaks +# for { set f 0 } { $f < $nfiles } {incr f} { +# file copy -force $dir/test044.$f.db $dir/test044.$f.save2 +# } +# foreach f [glob $dir/log.*] { +# if { [is_substr $f save] == 0 } { +# file copy -force $f $f.save2 +# } +# } + + for { set f 0 } { $f < $nfiles } { incr f } { + set db($f) [berkdb_open $dir/test044.$f.db] + error_check_good $f:dbopen [is_valid_db $db($f)] TRUE + + set cursors($f) [$db($f) cursor] + error_check_bad $f:cursor_open $cursors($f) NULL + error_check_good \ + $f:cursor_open [is_substr $cursors($f) $db($f)] 1 + } + + for { set f 0 } { $f < $nfiles } { incr f } { + for {set d [$cursors($f) get -first] } \ + { [string length $d] != 0 } \ + { set d [$cursors($f) get -next] } { + + set k [lindex [lindex $d 0] 0] + set d [lindex [lindex $d 0] 1] + + set flist [zero_list $nfiles] + set r $d + while { [set ndx [string first : $r]] != -1 } { + set fnum [string range $r 0 [expr $ndx - 1]] + if { [lindex $flist $fnum] == 0 } { + set fl "-set" + } else { + set fl "-next" + } + + if { $fl != "-set" || $fnum != $f } { + if { [string compare $fl "-set"] == 0} { + set full [$cursors($fnum) \ + get -set $k] + } else { + set full [$cursors($fnum) \ + get -next] + } + set key [lindex [lindex $full 0] 0] + set rec [lindex [lindex $full 0] 1] + error_check_good \ + $f:dbget_$fnum:key $key $k + error_check_good \ + $f:dbget_$fnum:data $rec $d + } + + set flist [lreplace $flist $fnum $fnum 1] + incr ndx + set r [string range $r $ndx end] + } + } + } + + for { set f 0 } { $f < $nfiles } { incr f } { + error_check_good $cursors($f) [$cursors($f) close] 0 + error_check_good db_close:$f [$db($f) close] 0 + } +} diff --git a/bdb/test/test045.tcl b/bdb/test/test045.tcl new file mode 100644 index 00000000000..65f031d0290 --- /dev/null +++ b/bdb/test/test045.tcl @@ -0,0 +1,117 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test045.tcl,v 11.17 2000/10/19 23:15:22 ubell Exp $ +# +# DB Test 45 Run the random db tester on the specified access method. +# Options are: +# -adds <maximum number of keys before you disable adds> +# -cursors <number of cursors> +# -dataavg <average data size> +# -delete <minimum number of keys before you disable deletes> +# -dups <allow duplicates in file> +# -errpct <Induce errors errpct of the time> +# -init <initial number of entries in database> +# -keyavg <average key size> +proc test045 { method {nops 10000} args } { + source ./include.tcl + + if { [is_frecno $method] == 1 } { + puts "\tSkipping Test045 for method $method." + return + } + + # + # If we are using an env, then skip this test. It needs its own. + set eindex [lsearch -exact $args "-env"] + if { $eindex != -1 } { + incr eindex + set env [lindex $args $eindex] + puts "Test045 skipping for env $env" + return + } + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test045: Random tester on $method for $nops operations" + + # Set initial parameters + set adds [expr $nops * 10] + set cursors 5 + set dataavg 40 + set delete $nops + set dups 0 + set errpct 0 + set init 0 + if { [is_record_based $method] == 1 } { + set keyavg 10 + } else { + set keyavg 25 + } + + # Process arguments + set oargs "" + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -adds { incr i; set adds [lindex $args $i] } + -cursors { incr i; set cursors [lindex $args $i] } + -dataavg { incr i; set dataavg [lindex $args $i] } + -delete { incr i; set delete [lindex $args $i] } + -dups { incr i; set dups [lindex $args $i] } + -errpct { incr i; set errpct [lindex $args $i] } + -init { incr i; set init [lindex $args $i] } + -keyavg { incr i; set keyavg [lindex $args $i] } + -extent { incr i; + lappend oargs "-extent" "100" } + default { lappend oargs [lindex $args $i] } + } + } + + # Create the database and and initialize it. + set root $testdir/test045 + set f $root.db + env_cleanup $testdir + + # Run the script with 3 times the number of initial elements to + # set it up. + set db [eval {berkdb_open \ + -create -truncate -mode 0644 $omethod} $oargs {$f}] + error_check_good dbopen:$f [is_valid_db $db] TRUE + + set r [$db close] + error_check_good dbclose:$f $r 0 + + # We redirect standard out, but leave standard error here so we + # can see errors. + + puts "\tTest045.a: Initializing database" + if { $init != 0 } { + set n [expr 3 * $init] + exec $tclsh_path \ + $test_path/dbscript.tcl $f $n \ + 1 $init $n $keyavg $dataavg $dups 0 -1 \ + > $testdir/test045.init + } + # Check for test failure + set e [findfail $testdir/test045.init] + error_check_good "FAIL: error message(s) in init file" $e 0 + + puts "\tTest045.b: Now firing off berkdb rand dbscript, running: " + # Now the database is initialized, run a test + puts "$tclsh_path\ + $test_path/dbscript.tcl $f $nops $cursors $delete $adds \ + $keyavg $dataavg $dups $errpct > $testdir/test045.log" + + exec $tclsh_path \ + $test_path/dbscript.tcl $f \ + $nops $cursors $delete $adds $keyavg \ + $dataavg $dups $errpct \ + > $testdir/test045.log + + # Check for test failure + set e [findfail $testdir/test045.log] + error_check_good "FAIL: error message(s) in log file" $e 0 + +} diff --git a/bdb/test/test046.tcl b/bdb/test/test046.tcl new file mode 100644 index 00000000000..3bfed3ef5d8 --- /dev/null +++ b/bdb/test/test046.tcl @@ -0,0 +1,717 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test046.tcl,v 11.26 2000/08/25 14:21:56 sue Exp $ +# +# DB Test 46: Overwrite test of small/big key/data with cursor checks. +proc test046 { method args } { + global alphabet + global errorInfo + global errorCode + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "\tTest046: Overwrite test with cursor and small/big key/data." + puts "\tTest046:\t$method $args" + + if { [is_rrecno $method] == 1} { + puts "\tTest046: skipping for method $method." + return + } + + set key "key" + set data "data" + set txn "" + set flags "" + + if { [is_record_based $method] == 1} { + set key "" + } + + puts "\tTest046: Create $method database." + 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/test046.db + set env NULL + } else { + set testfile test046.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + + set oflags "-create -mode 0644 $args $omethod" + set db [eval {berkdb_open} $oflags $testfile.a] + error_check_good dbopen [is_valid_db $db] TRUE + + # open curs to db + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + + # keep nkeys even + set nkeys 20 + + # Fill page w/ small key/data pairs + puts "\tTest046: Fill page with $nkeys small key/data pairs." + for { set i 1 } { $i <= $nkeys } { incr i } { + if { [is_record_based $method] == 1} { + set ret [$db put $i $data$i] + } elseif { $i < 10 } { + set ret [$db put [set key]00$i [set data]00$i] + } elseif { $i < 100 } { + set ret [$db put [set key]0$i [set data]0$i] + } else { + set ret [$db put $key$i $data$i] + } + error_check_good dbput $ret 0 + } + + # get db order of keys + for {set i 1; set ret [$dbc get -first]} { [llength $ret] != 0} { \ + set ret [$dbc get -next]} { + set key_set($i) [lindex [lindex $ret 0] 0] + set data_set($i) [lindex [lindex $ret 0] 1] + incr i + } + + puts "\tTest046.a: Deletes by key." + puts "\t\tTest046.a.1: Get data with SET, then delete before cursor." + # get key in middle of page, call this the nth set curr to it + set i [expr $nkeys/2] + set ret [$dbc get -set $key_set($i)] + error_check_bad dbc_get:set [llength $ret] 0 + set curr $ret + + # delete before cursor(n-1), make sure it is gone + set i [expr $i - 1] + error_check_good db_del [$db del $key_set($i)] 0 + + # use set_range to get first key starting at n-1, should + # give us nth--but only works for btree + if { [is_btree $method] == 1 } { + set ret [$dbc get -set_range $key_set($i)] + } else { + if { [is_record_based $method] == 1 } { + set ret [$dbc get -set $key_set($i)] + error_check_good \ + dbc_get:deleted(recno) [llength [lindex $ret 1]] 0 + #error_check_good \ + # catch:get [catch {$dbc get -set $key_set($i)} ret] 1 + #error_check_good \ + # dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1 + } else { + set ret [$dbc get -set $key_set($i)] + error_check_good dbc_get:deleted [llength $ret] 0 + } + set ret [$dbc get -set $key_set([incr i])] + incr i -1 + } + error_check_bad dbc_get:set(R)(post-delete) [llength $ret] 0 + error_check_good dbc_get(match):set $ret $curr + + puts "\t\tTest046.a.2: Delete cursor item by key." + # nth key, which cursor should be on now + set i [incr i] + set ret [$db del $key_set($i)] + error_check_good db_del $ret 0 + + # this should return n+1 key/data, curr has nth key/data + if { [string compare $omethod "-btree"] == 0 } { + set ret [$dbc get -set_range $key_set($i)] + } else { + if { [is_record_based $method] == 1 } { + set ret [$dbc get -set $key_set($i)] + error_check_good \ + dbc_get:deleted(recno) [llength [lindex $ret 1]] 0 + #error_check_good \ + # catch:get [catch {$dbc get -set $key_set($i)} ret] 1 + #error_check_good \ + # dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1 + } else { + set ret [$dbc get -set $key_set($i)] + error_check_good dbc_get:deleted [llength $ret] 0 + } + set ret [$dbc get -set $key_set([expr $i+1])] + } + error_check_bad dbc_get(post-delete):set_range [llength $ret] 0 + error_check_bad dbc_get(no-match):set_range $ret $curr + + puts "\t\tTest046.a.3: Delete item after cursor." + # we'll delete n+2, since we have deleted n-1 and n + # i still equal to nth, cursor on n+1 + set i [incr i] + set ret [$dbc get -set $key_set($i)] + error_check_bad dbc_get:set [llength $ret] 0 + set curr [$dbc get -next] + error_check_bad dbc_get:next [llength $curr] 0 + set ret [$dbc get -prev] + error_check_bad dbc_get:prev [llength $curr] 0 + # delete *after* cursor pos. + error_check_good db:del [$db del $key_set([incr i])] 0 + + # make sure item is gone, try to get it + if { [string compare $omethod "-btree"] == 0} { + set ret [$dbc get -set_range $key_set($i)] + } else { + if { [is_record_based $method] == 1 } { + set ret [$dbc get -set $key_set($i)] + error_check_good \ + dbc_get:deleted(recno) [llength [lindex $ret 1]] 0 + #error_check_good \ + # catch:get [catch {$dbc get -set $key_set($i)} ret] 1 + #error_check_good \ + # dbc_get:deleted(recno) [is_substr $ret "KEYEMPTY"] 1 + } else { + set ret [$dbc get -set $key_set($i)] + error_check_good dbc_get:deleted [llength $ret] 0 + } + set ret [$dbc get -set $key_set([expr $i +1])] + } + error_check_bad dbc_get:set(_range) [llength $ret] 0 + error_check_bad dbc_get:set(_range) $ret $curr + error_check_good dbc_get:set [lindex [lindex $ret 0] 0] \ + $key_set([expr $i+1]) + + puts "\tTest046.b: Deletes by cursor." + puts "\t\tTest046.b.1: Delete, do DB_NEXT." + error_check_good dbc:del [$dbc del] 0 + set ret [$dbc get -next] + error_check_bad dbc_get:next [llength $ret] 0 + set i [expr $i+2] + # i = n+4 + error_check_good dbc_get:next(match) \ + [lindex [lindex $ret 0] 0] $key_set($i) + + puts "\t\tTest046.b.2: Delete, do DB_PREV." + error_check_good dbc:del [$dbc del] 0 + set ret [$dbc get -prev] + error_check_bad dbc_get:prev [llength $ret] 0 + set i [expr $i-3] + # i = n+1 (deleted all in between) + error_check_good dbc_get:prev(match) \ + [lindex [lindex $ret 0] 0] $key_set($i) + + puts "\t\tTest046.b.3: Delete, do DB_CURRENT." + error_check_good dbc:del [$dbc del] 0 + # we just deleted, so current item should be KEYEMPTY, throws err + set ret [$dbc get -current] + error_check_good dbc_get:curr:deleted [llength [lindex $ret 1]] 0 + #error_check_good catch:get:current [catch {$dbc get -current} ret] 1 + #error_check_good dbc_get:curr:deleted [is_substr $ret "DB_KEYEMPTY"] 1 + + puts "\tTest046.c: Inserts (before/after), by key then cursor." + puts "\t\tTest046.c.1: Insert by key before the cursor." + # i is at curs pos, i=n+1, we want to go BEFORE + set i [incr i -1] + set ret [$db put $key_set($i) $data_set($i)] + error_check_good db_put:before $ret 0 + + puts "\t\tTest046.c.2: Insert by key after the cursor." + set i [incr i +2] + set ret [$db put $key_set($i) $data_set($i)] + error_check_good db_put:after $ret 0 + + puts "\t\tTest046.c.3: Insert by curs with deleted curs (should fail)." + # cursor is on n+1, we'll change i to match + set i [incr i -1] + + error_check_good dbc:close [$dbc close] 0 + error_check_good db:close [$db close] 0 + if { [is_record_based $method] == 1} { + puts "\t\tSkipping the rest of test for method $method." + puts "\tTest046 ($method) complete." + return + } else { + # Reopen without printing __db_errs. + set db [eval {berkdb_open_noerr} $oflags $testfile.a] + error_check_good dbopen [is_valid_db $db] TRUE + set dbc [$db cursor] + error_check_good cursor [is_valid_cursor $dbc $db] TRUE + + # should fail with EINVAL (deleted cursor) + set errorCode NONE + error_check_good catch:put:before 1 \ + [catch {$dbc put -before $data_set($i)} ret] + error_check_good dbc_put:deleted:before \ + [is_substr $errorCode "EINVAL"] 1 + + # should fail with EINVAL + set errorCode NONE + error_check_good catch:put:after 1 \ + [catch {$dbc put -after $data_set($i)} ret] + error_check_good dbc_put:deleted:after \ + [is_substr $errorCode "EINVAL"] 1 + + puts "\t\tTest046.c.4:\ + Insert by cursor before/after existent cursor." + # can't use before after w/o dup except renumber in recno + # first, restore an item so they don't fail + #set ret [$db put $key_set($i) $data_set($i)] + #error_check_good db_put $ret 0 + + #set ret [$dbc get -set $key_set($i)] + #error_check_bad dbc_get:set [llength $ret] 0 + #set i [incr i -2] + # i = n - 1 + #set ret [$dbc get -prev] + #set ret [$dbc put -before $key_set($i) $data_set($i)] + #error_check_good dbc_put:before $ret 0 + # cursor pos is adjusted to match prev, recently inserted + #incr i + # i = n + #set ret [$dbc put -after $key_set($i) $data_set($i)] + #error_check_good dbc_put:after $ret 0 + } + + # For the next part of the test, we need a db with no dups to test + # overwrites + puts "\tTest046.d.0: Cleanup, close db, open new db with no dups." + error_check_good dbc:close [$dbc close] 0 + error_check_good db:close [$db close] 0 + + set db [eval {berkdb_open} $oflags $testfile.d] + error_check_good dbopen [is_valid_db $db] TRUE + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + set nkeys 20 + + # Fill page w/ small key/data pairs + puts "\tTest046.d.0: Fill page with $nkeys small key/data pairs." + for { set i 1 } { $i < $nkeys } { incr i } { + set ret [$db put $key$i $data$i] + error_check_good dbput $ret 0 + } + + # Prepare cursor on item + set ret [$dbc get -first] + error_check_bad dbc_get:first [llength $ret] 0 + + # Prepare unique big/small values for an initial + # and an overwrite set of key/data + foreach ptype {init over} { + foreach size {big small} { + if { [string compare $size big] == 0 } { + set key_$ptype$size \ + KEY_$size[repeat alphabet 250] + set data_$ptype$size \ + DATA_$size[repeat alphabet 250] + } else { + set key_$ptype$size \ + KEY_$size[repeat alphabet 10] + set data_$ptype$size \ + DATA_$size[repeat alphabet 10] + } + } + } + + set i 0 + # Do all overwrites for key and cursor + foreach type {key_over curs_over} { + # Overwrite (i=initial) four different kinds of pairs + incr i + puts "\tTest046.d: Overwrites $type." + foreach i_pair {\ + {small small} {big small} {small big} {big big} } { + # Overwrite (w=write) with four different kinds of data + foreach w_pair {\ + {small small} {big small} {small big} {big big} } { + + # we can only overwrite if key size matches + if { [string compare [lindex \ + $i_pair 0] [lindex $w_pair 0]] != 0} { + continue + } + + # first write the initial key/data + set ret [$dbc put -keyfirst \ + key_init[lindex $i_pair 0] \ + data_init[lindex $i_pair 1]] + error_check_good \ + dbc_put:curr:init:$i_pair $ret 0 + set ret [$dbc get -current] + error_check_bad dbc_get:curr [llength $ret] 0 + error_check_good dbc_get:curr:data \ + [lindex [lindex $ret 0] 1] \ + data_init[lindex $i_pair 1] + + # Now, try to overwrite: dups not supported in + # this db + if { [string compare $type key_over] == 0 } { + puts "\t\tTest046.d.$i: Key\ + Overwrite:($i_pair) by ($w_pair)." + set ret [$db put \ + $"key_init[lindex $i_pair 0]" \ + $"data_over[lindex $w_pair 1]"] + error_check_good \ + dbput:over:i($i_pair):o($w_pair) $ret 0 + # check value + set ret [$db \ + get $"key_init[lindex $i_pair 0]"] + error_check_bad \ + db:get:check [llength $ret] 0 + error_check_good db:get:compare_data \ + [lindex [lindex $ret 0] 1] \ + $"data_over[lindex $w_pair 1]" + } else { + # This is a cursor overwrite + puts \ + "\t\tTest046.d.$i:Curs Overwrite:($i_pair) by ($w_pair)." + set ret [$dbc put -current \ + $"data_over[lindex $w_pair 1]"] + error_check_good \ + dbcput:over:i($i_pair):o($w_pair) $ret 0 + # check value + set ret [$dbc get -current] + error_check_bad \ + dbc_get:curr [llength $ret] 0 + error_check_good dbc_get:curr:data \ + [lindex [lindex $ret 0] 1] \ + $"data_over[lindex $w_pair 1]" + } + } ;# foreach write pair + } ;# foreach initial pair + } ;# foreach type big/small + + puts "\tTest046.d.3: Cleanup for next part of test." + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + if { [is_rbtree $method] == 1} { + puts "\tSkipping the rest of Test046 for method $method." + puts "\tTest046 complete." + return + } + + puts "\tTest046.e.1: Open db with sorted dups." + set db [eval {berkdb_open_noerr} $oflags -dup -dupsort $testfile.e] + error_check_good dbopen [is_valid_db $db] TRUE + + # open curs to db + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + + # keep nkeys even + set nkeys 20 + set ndups 20 + + # Fill page w/ small key/data pairs + puts "\tTest046.e.2:\ + Put $nkeys small key/data pairs and $ndups sorted dups." + for { set i 0 } { $i < $nkeys } { incr i } { + if { $i < 10 } { + set ret [$db put [set key]0$i [set data]0$i] + } else { + set ret [$db put $key$i $data$i] + } + error_check_good dbput $ret 0 + } + + # get db order of keys + for {set i 0; set ret [$dbc get -first]} { [llength $ret] != 0} { \ + set ret [$dbc get -next]} { + set key_set($i) [lindex [lindex $ret 0] 0] + set data_set($i) [lindex [lindex $ret 0] 1] + incr i + } + + # put 20 sorted duplicates on key in middle of page + set i [expr $nkeys/2] + set ret [$dbc get -set $key_set($i)] + error_check_bad dbc_get:set [llength $ret] 0 + + set keym $key_set($i) + + for { set i 0 } { $i < $ndups } { incr i } { + if { $i < 10 } { + set ret [$db put $keym DUPLICATE_0$i] + } else { + set ret [$db put $keym DUPLICATE_$i] + } + error_check_good db_put:DUP($i) $ret 0 + } + + puts "\tTest046.e.3: Check duplicate duplicates" + set ret [$db put $keym DUPLICATE_00] + error_check_good dbput:dupdup [is_substr $ret "DB_KEYEXIST"] 1 + + # get dup ordering + for {set i 0; set ret [$dbc get -set $keym]} { [llength $ret] != 0} {\ + set ret [$dbc get -nextdup] } { + set dup_set($i) [lindex [lindex $ret 0] 1] + incr i + } + + # put cursor on item in middle of dups + set i [expr $ndups/2] + set ret [$dbc get -get_both $keym $dup_set($i)] + error_check_bad dbc_get:get_both [llength $ret] 0 + + puts "\tTest046.f: Deletes by cursor." + puts "\t\tTest046.f.1: Delete by cursor, do a DB_NEXT, check cursor." + set ret [$dbc get -current] + error_check_bad dbc_get:current [llength $ret] 0 + error_check_good dbc:del [$dbc del] 0 + set ret [$dbc get -next] + error_check_bad dbc_get:next [llength $ret] 0 + error_check_good \ + dbc_get:nextdup [lindex [lindex $ret 0] 1] $dup_set([incr i]) + + puts "\t\tTest046.f.2: Delete by cursor, do DB_PREV, check cursor." + error_check_good dbc:del [$dbc del] 0 + set ret [$dbc get -prev] + error_check_bad dbc_get:prev [llength $ret] 0 + set i [incr i -2] + error_check_good dbc_get:prev [lindex [lindex $ret 0] 1] $dup_set($i) + + puts "\t\tTest046.f.3: Delete by cursor, do DB_CURRENT, check cursor." + error_check_good dbc:del [$dbc del] 0 + set ret [$dbc get -current] + error_check_good dbc_get:current:deleted [llength [lindex $ret 1]] 0 + #error_check_good catch:dbc_get:curr [catch {$dbc get -current} ret] 1 + #error_check_good \ + # dbc_get:current:deleted [is_substr $ret "DB_KEYEMPTY"] 1 + error_check_good dbc_close [$dbc close] 0 + + # restore deleted keys + error_check_good db_put:1 [$db put $keym $dup_set($i)] 0 + error_check_good db_put:2 [$db put $keym $dup_set([incr i])] 0 + error_check_good db_put:3 [$db put $keym $dup_set([incr i])] 0 + + # tested above + + # Reopen database without __db_err, reset cursor + error_check_good dbclose [$db close] 0 + set db [eval {berkdb_open_noerr} $oflags -dup -dupsort $testfile.e] + error_check_good dbopen [is_valid_db $db] TRUE + error_check_good db_cursor [is_substr [set dbc [$db cursor]] $db] 1 + + set ret [$dbc get -set $keym] + error_check_bad dbc_get:set [llength $ret] 0 + set ret2 [$dbc get -current] + error_check_bad dbc_get:current [llength $ret2] 0 + # match + error_check_good dbc_get:current/set(match) $ret $ret2 + # right one? + error_check_good \ + dbc_get:curr/set(matchdup) [lindex [lindex $ret 0] 1] $dup_set(0) + + # cursor is on first dup + set ret [$dbc get -next] + error_check_bad dbc_get:next [llength $ret] 0 + # now on second dup + error_check_good dbc_get:next [lindex [lindex $ret 0] 1] $dup_set(1) + # check cursor + set ret [$dbc get -current] + error_check_bad dbc_get:curr [llength $ret] 0 + error_check_good \ + dbcget:curr(compare) [lindex [lindex $ret 0] 1] $dup_set(1) + + puts "\tTest046.g: Inserts." + puts "\t\tTest046.g.1: Insert by key before cursor." + set i 0 + + # use "spam" to prevent a duplicate duplicate. + set ret [$db put $keym $dup_set($i)spam] + error_check_good db_put:before $ret 0 + # make sure cursor was maintained + set ret [$dbc get -current] + error_check_bad dbc_get:curr [llength $ret] 0 + error_check_good \ + dbc_get:current(post-put) [lindex [lindex $ret 0] 1] $dup_set(1) + + puts "\t\tTest046.g.2: Insert by key after cursor." + set i [expr $i + 2] + # use "eggs" to prevent a duplicate duplicate + set ret [$db put $keym $dup_set($i)eggs] + error_check_good db_put:after $ret 0 + # make sure cursor was maintained + set ret [$dbc get -current] + error_check_bad dbc_get:curr [llength $ret] 0 + error_check_good \ + dbc_get:curr(post-put,after) [lindex [lindex $ret 0] 1] $dup_set(1) + + puts "\t\tTest046.g.3: Insert by curs before/after curs (should fail)." + # should return EINVAL (dupsort specified) + error_check_good dbc_put:before:catch \ + [catch {$dbc put -before $dup_set([expr $i -1])} ret] 1 + error_check_good \ + dbc_put:before:deleted [is_substr $errorCode "EINVAL"] 1 + error_check_good dbc_put:after:catch \ + [catch {$dbc put -after $dup_set([expr $i +2])} ret] 1 + error_check_good \ + dbc_put:after:deleted [is_substr $errorCode "EINVAL"] 1 + + puts "\tTest046.h: Cursor overwrites." + puts "\t\tTest046.h.1: Test that dupsort disallows current overwrite." + set ret [$dbc get -set $keym] + error_check_bad dbc_get:set [llength $ret] 0 + error_check_good \ + catch:dbc_put:curr [catch {$dbc put -current DATA_OVERWRITE} ret] 1 + error_check_good dbc_put:curr:dupsort [is_substr $errorCode EINVAL] 1 + + puts "\t\tTest046.h.2: New db (no dupsort)." + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + set db [berkdb_open \ + -create -dup $omethod -mode 0644 -truncate $testfile.h] + error_check_good db_open [is_valid_db $db] TRUE + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + + for {set i 0} {$i < $nkeys} {incr i} { + if { $i < 10 } { + error_check_good db_put [$db put key0$i datum0$i] 0 + } else { + error_check_good db_put [$db put key$i datum$i] 0 + } + if { $i == 0 } { + for {set j 0} {$j < $ndups} {incr j} { + if { $i < 10 } { + set keyput key0$i + } else { + set keyput key$i + } + if { $j < 10 } { + set ret [$db put $keyput DUP_datum0$j] + } else { + set ret [$db put $keyput DUP_datum$j] + } + error_check_good dbput:dup $ret 0 + } + } + } + + for {set i 0; set ret [$dbc get -first]} { [llength $ret] != 0} { \ + set ret [$dbc get -next]} { + set key_set($i) [lindex [lindex $ret 0] 0] + set data_set($i) [lindex [lindex $ret 0] 1] + incr i + } + + for {set i 0; set ret [$dbc get -set key00]} {\ + [llength $ret] != 0} {set ret [$dbc get -nextdup]} { + set dup_set($i) [lindex [lindex $ret 0] 1] + incr i + } + set i 0 + set keym key0$i + set ret [$dbc get -set $keym] + error_check_bad dbc_get:set [llength $ret] 0 + error_check_good \ + dbc_get:set(match) [lindex [lindex $ret 0] 1] $dup_set($i) + + set ret [$dbc get -nextdup] + error_check_bad dbc_get:nextdup [llength $ret] 0 + error_check_good dbc_get:nextdup(match) \ + [lindex [lindex $ret 0] 1] $dup_set([expr $i + 1]) + + puts "\t\tTest046.h.3: Insert by cursor before cursor (DB_BEFORE)." + set ret [$dbc put -before BEFOREPUT] + error_check_good dbc_put:before $ret 0 + set ret [$dbc get -current] + error_check_bad dbc_get:curr [llength $ret] 0 + error_check_good \ + dbc_get:curr:match [lindex [lindex $ret 0] 1] BEFOREPUT + # make sure that this is actually a dup w/ dup before + set ret [$dbc get -prev] + error_check_bad dbc_get:prev [llength $ret] 0 + error_check_good dbc_get:prev:match \ + [lindex [lindex $ret 0] 1] $dup_set($i) + set ret [$dbc get -prev] + # should not be a dup + error_check_bad dbc_get:prev(no_dup) \ + [lindex [lindex $ret 0] 0] $keym + + puts "\t\tTest046.h.4: Insert by cursor after cursor (DB_AFTER)." + set ret [$dbc get -set $keym] + + # delete next 3 when fix + #puts "[$dbc get -current]\ + # [$dbc get -next] [$dbc get -next] [$dbc get -next] [$dbc get -next]" + #set ret [$dbc get -set $keym] + + error_check_bad dbc_get:set [llength $ret] 0 + set ret [$dbc put -after AFTERPUT] + error_check_good dbc_put:after $ret 0 + #puts [$dbc get -current] + + # delete next 3 when fix + #set ret [$dbc get -set $keym] + #puts "[$dbc get -current] next: [$dbc get -next] [$dbc get -next]" + #set ret [$dbc get -set AFTERPUT] + #set ret [$dbc get -set $keym] + #set ret [$dbc get -next] + #puts $ret + + set ret [$dbc get -current] + error_check_bad dbc_get:curr [llength $ret] 0 + error_check_good dbc_get:curr:match [lindex [lindex $ret 0] 1] AFTERPUT + set ret [$dbc get -prev] + # now should be on first item (non-dup) of keym + error_check_bad dbc_get:prev1 [llength $ret] 0 + error_check_good \ + dbc_get:match [lindex [lindex $ret 0] 1] $dup_set($i) + set ret [$dbc get -next] + error_check_bad dbc_get:next [llength $ret] 0 + error_check_good \ + dbc_get:match2 [lindex [lindex $ret 0] 1] AFTERPUT + set ret [$dbc get -next] + error_check_bad dbc_get:next [llength $ret] 0 + # this is the dup we added previously + error_check_good \ + dbc_get:match3 [lindex [lindex $ret 0] 1] BEFOREPUT + + # now get rid of the dups we added + error_check_good dbc_del [$dbc del] 0 + set ret [$dbc get -prev] + error_check_bad dbc_get:prev2 [llength $ret] 0 + error_check_good dbc_del2 [$dbc del] 0 + # put cursor on first dup item for the rest of test + set ret [$dbc get -set $keym] + error_check_bad dbc_get:first [llength $ret] 0 + error_check_good \ + dbc_get:first:check [lindex [lindex $ret 0] 1] $dup_set($i) + + puts "\t\tTest046.h.5: Overwrite small by small." + set ret [$dbc put -current DATA_OVERWRITE] + error_check_good dbc_put:current:overwrite $ret 0 + set ret [$dbc get -current] + error_check_good dbc_get:current(put,small/small) \ + [lindex [lindex $ret 0] 1] DATA_OVERWRITE + + puts "\t\tTest046.h.6: Overwrite small with big." + set ret [$dbc put -current DATA_BIG_OVERWRITE[repeat $alphabet 200]] + error_check_good dbc_put:current:overwrite:big $ret 0 + set ret [$dbc get -current] + error_check_good dbc_get:current(put,small/big) \ + [is_substr [lindex [lindex $ret 0] 1] DATA_BIG_OVERWRITE] 1 + + puts "\t\tTest046.h.7: Overwrite big with big." + set ret [$dbc put -current DATA_BIG_OVERWRITE2[repeat $alphabet 200]] + error_check_good dbc_put:current:overwrite(2):big $ret 0 + set ret [$dbc get -current] + error_check_good dbc_get:current(put,big/big) \ + [is_substr [lindex [lindex $ret 0] 1] DATA_BIG_OVERWRITE2] 1 + + puts "\t\tTest046.h.8: Overwrite big with small." + set ret [$dbc put -current DATA_OVERWRITE2] + error_check_good dbc_put:current:overwrite:small $ret 0 + set ret [$dbc get -current] + error_check_good dbc_get:current(put,big/small) \ + [is_substr [lindex [lindex $ret 0] 1] DATA_OVERWRITE2] 1 + + puts "\tTest046.i: Cleaning up from test." + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + puts "\tTest046 complete." +} diff --git a/bdb/test/test047.tcl b/bdb/test/test047.tcl new file mode 100644 index 00000000000..9d11cd3db83 --- /dev/null +++ b/bdb/test/test047.tcl @@ -0,0 +1,192 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test047.tcl,v 11.10 2000/08/25 14:21:56 sue Exp $ +# +# DB Test 47: test of the SET_RANGE interface to DB->c_get. +proc test047 { method args } { + source ./include.tcl + + set tstn 047 + + if { [is_btree $method] != 1 } { + puts "Test$tstn skipping for method $method" + return + } + + set method "-btree" + + puts "\tTest$tstn: Test of SET_RANGE interface to DB->c_get ($method)." + + set key "key" + set data "data" + set txn "" + set flags "" + + puts "\tTest$tstn.a: Create $method database." + 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/test0$tstn.db + set testfile1 $testdir/test0$tstn.a.db + set testfile2 $testdir/test0$tstn.b.db + set env NULL + } else { + set testfile test0$tstn.db + set testfile1 test0$tstn.a.db + set testfile2 test0$tstn.b.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + + set oflags "-create -truncate -mode 0644 -dup $args $method" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # open curs to db + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + + set nkeys 20 + # Fill page w/ small key/data pairs + # + puts "\tTest$tstn.b: Fill page with $nkeys small key/data pairs." + for { set i 0 } { $i < $nkeys } { incr i } { + set ret [$db put $key$i $data$i] + error_check_good dbput $ret 0 + } + + puts "\tTest$tstn.c: Get data with SET_RANGE, then delete by cursor." + set i 0 + set ret [$dbc get -set_range $key$i] + error_check_bad dbc_get:set_range [llength $ret] 0 + set curr $ret + + # delete by cursor, make sure it is gone + error_check_good dbc_del [$dbc del] 0 + + set ret [$dbc get -set_range $key$i] + error_check_bad dbc_get(post-delete):set_range [llength $ret] 0 + error_check_bad dbc_get(no-match):set_range $ret $curr + + puts "\tTest$tstn.d: \ + Use another cursor to fix item on page, delete by db." + set dbcurs2 [$db cursor] + error_check_good db:cursor2 [is_substr $dbcurs2 $db] 1 + + set ret [$dbcurs2 get -set [lindex [lindex $ret 0] 0]] + error_check_bad dbc_get(2):set [llength $ret] 0 + set curr $ret + error_check_good db:del [$db del [lindex [lindex $ret 0] 0]] 0 + + # make sure item is gone + set ret [$dbcurs2 get -set_range [lindex [lindex $curr 0] 0]] + error_check_bad dbc2_get:set_range [llength $ret] 0 + error_check_bad dbc2_get:set_range $ret $curr + + puts "\tTest$tstn.e: Close for second part of test, close db/cursors." + error_check_good dbc:close [$dbc close] 0 + error_check_good dbc2:close [$dbcurs2 close] 0 + error_check_good dbclose [$db close] 0 + + # open db + set db [eval {berkdb_open} $oflags $testfile1] + error_check_good dbopen2 [is_valid_db $db] TRUE + + set nkeys 10 + puts "\tTest$tstn.f: Fill page with $nkeys pairs, one set of dups." + for {set i 0} { $i < $nkeys } {incr i} { + # a pair + set ret [$db put $key$i $data$i] + error_check_good dbput($i) $ret 0 + } + + set j 0 + for {set i 0} { $i < $nkeys } {incr i} { + # a dup set for same 1 key + set ret [$db put $key$i DUP_$data$i] + error_check_good dbput($i):dup $ret 0 + } + + puts "\tTest$tstn.g: \ + Get dups key w/ SET_RANGE, pin onpage with another cursor." + set i 0 + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + set ret [$dbc get -set_range $key$i] + error_check_bad dbc_get:set_range [llength $ret] 0 + + set dbc2 [$db cursor] + error_check_good db_cursor2 [is_substr $dbc2 $db] 1 + set ret2 [$dbc2 get -set_range $key$i] + error_check_bad dbc2_get:set_range [llength $ret] 0 + + error_check_good dbc_compare $ret $ret2 + puts "\tTest$tstn.h: \ + Delete duplicates' key, use SET_RANGE to get next dup." + set ret [$dbc2 del] + error_check_good dbc2_del $ret 0 + set ret [$dbc get -set_range $key$i] + error_check_bad dbc_get:set_range [llength $ret] 0 + error_check_bad dbc_get:set_range $ret $ret2 + + error_check_good dbc_close [$dbc close] 0 + error_check_good dbc2_close [$dbc2 close] 0 + error_check_good db_close [$db close] 0 + + set db [eval {berkdb_open} $oflags $testfile2] + error_check_good dbopen [is_valid_db $db] TRUE + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + set dbc2 [$db cursor] + error_check_good db_cursor2 [is_substr $dbc2 $db] 1 + + set nkeys 10 + set ndups 1000 + + puts "\tTest$tstn.i: Fill page with $nkeys pairs and $ndups dups." + for {set i 0} { $i < $nkeys } { incr i} { + # a pair + set ret [$db put $key$i $data$i] + error_check_good dbput $ret 0 + + # dups for single pair + if { $i == 0} { + for {set j 0} { $j < $ndups } { incr j } { + set ret [$db put $key$i DUP_$data$i:$j] + error_check_good dbput:dup $ret 0 + } + } + } + set i 0 + puts "\tTest$tstn.j: \ + Get key of first dup with SET_RANGE, fix with 2 curs." + set ret [$dbc get -set_range $key$i] + error_check_bad dbc_get:set_range [llength $ret] 0 + + set ret2 [$dbc2 get -set_range $key$i] + error_check_bad dbc2_get:set_range [llength $ret] 0 + set curr $ret2 + + error_check_good dbc_compare $ret $ret2 + + puts "\tTest$tstn.k: Delete item by cursor, use SET_RANGE to verify." + set ret [$dbc2 del] + error_check_good dbc2_del $ret 0 + set ret [$dbc get -set_range $key$i] + error_check_bad dbc_get:set_range [llength $ret] 0 + error_check_bad dbc_get:set_range $ret $curr + + puts "\tTest$tstn.l: Cleanup." + error_check_good dbc_close [$dbc close] 0 + error_check_good dbc2_close [$dbc2 close] 0 + error_check_good db_close [$db close] 0 + + puts "\tTest$tstn complete." +} diff --git a/bdb/test/test048.tcl b/bdb/test/test048.tcl new file mode 100644 index 00000000000..84c7c47b721 --- /dev/null +++ b/bdb/test/test048.tcl @@ -0,0 +1,139 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test048.tcl,v 11.11 2000/12/11 17:42:18 sue Exp $ +# +# Test048: Cursor stability across btree splits. +proc test048 { method args } { + global errorCode + source ./include.tcl + + set tstn 048 + + if { [is_btree $method] != 1 } { + puts "Test$tstn skipping for method $method." + return + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + incr pgindex + if { [lindex $args $pgindex] > 8192 } { + puts "Test048: Skipping for large pagesizes" + return + } + } + + set method "-btree" + + puts "\tTest$tstn: Test of cursor stability across btree splits." + + set key "key" + set data "data" + set txn "" + set flags "" + + puts "\tTest$tstn.a: Create $method database." + 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/test0$tstn.db + set env NULL + } else { + set testfile test0$tstn.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + + set oflags "-create -truncate -mode 0644 $args $method" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set nkeys 5 + # Fill page w/ small key/data pairs, keep at leaf + # + puts "\tTest$tstn.b: Fill page with $nkeys small key/data pairs." + for { set i 0 } { $i < $nkeys } { incr i } { + set ret [$db put key000$i $data$i] + error_check_good dbput $ret 0 + } + + # get db ordering, set cursors + puts "\tTest$tstn.c: Set cursors on each of $nkeys pairs." + for {set i 0; set ret [$db get key000$i]} {\ + $i < $nkeys && [llength $ret] != 0} {\ + incr i; set ret [$db get key000$i]} { + set key_set($i) [lindex [lindex $ret 0] 0] + set data_set($i) [lindex [lindex $ret 0] 1] + set dbc [$db cursor] + set dbc_set($i) $dbc + error_check_good db_cursor:$i [is_substr $dbc_set($i) $db] 1 + set ret [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc_set($i)_get:set [llength $ret] 0 + } + + # if mkeys is above 1000, need to adjust below for lexical order + set mkeys 1000 + puts "\tTest$tstn.d: Add $mkeys pairs to force split." + for {set i $nkeys} { $i < $mkeys } { incr i } { + if { $i >= 100 } { + set ret [$db put key0$i $data$i] + } elseif { $i >= 10 } { + set ret [$db put key00$i $data$i] + } else { + set ret [$db put key000$i $data$i] + } + error_check_good dbput:more $ret 0 + } + + puts "\tTest$tstn.e: Make sure split happened." + error_check_bad stat:check-split [is_substr [$db stat] \ + "{{Internal pages} 0}"] 1 + + puts "\tTest$tstn.f: Check to see that cursors maintained reference." + for {set i 0} { $i < $nkeys } {incr i} { + set ret [$dbc_set($i) get -current] + error_check_bad dbc$i:get:current [llength $ret] 0 + set ret2 [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc$i:get:set [llength $ret2] 0 + error_check_good dbc$i:get(match) $ret $ret2 + } + + puts "\tTest$tstn.g: Delete added keys to force reverse split." + for {set i $nkeys} { $i < $mkeys } { incr i } { + if { $i >= 100 } { + error_check_good db_del:$i [$db del key0$i] 0 + } elseif { $i >= 10 } { + error_check_good db_del:$i [$db del key00$i] 0 + } else { + error_check_good db_del:$i [$db del key000$i] 0 + } + } + + puts "\tTest$tstn.h: Verify reverse split." + error_check_good stat:check-reverse_split [is_substr [$db stat] \ + "{{Internal pages} 0}"] 1 + + puts "\tTest$tstn.i: Verify cursor reference." + for {set i 0} { $i < $nkeys } {incr i} { + set ret [$dbc_set($i) get -current] + error_check_bad dbc$i:get:current [llength $ret] 0 + set ret2 [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc$i:get:set [llength $ret2] 0 + error_check_good dbc$i:get(match) $ret $ret2 + } + + puts "\tTest$tstn.j: Cleanup." + # close cursors + for {set i 0} { $i < $nkeys } {incr i} { + error_check_good dbc_close:$i [$dbc_set($i) close] 0 + } + error_check_good dbclose [$db close] 0 + + puts "\tTest$tstn complete." +} diff --git a/bdb/test/test049.tcl b/bdb/test/test049.tcl new file mode 100644 index 00000000000..aaea3b200bf --- /dev/null +++ b/bdb/test/test049.tcl @@ -0,0 +1,160 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test049.tcl,v 11.15 2000/08/25 14:21:56 sue Exp $ +# +# Test 049: Test of each cursor routine with unitialized cursors +proc test049 { method args } { + global errorInfo + global errorCode + source ./include.tcl + + set tstn 049 + set renum [is_rrecno $method] + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "\tTest$tstn: Test of cursor routines with unitialized cursors." + + set key "key" + set data "data" + set txn "" + set flags "" + set rflags "" + + if { [is_record_based $method] == 1 } { + set key "" + } + + puts "\tTest$tstn.a: Create $method database." + 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/test0$tstn.db + set env NULL + } else { + set testfile test0$tstn.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + + set oflags "-create -truncate -mode 0644 $rflags $omethod $args" + if { [is_record_based $method] == 0 && [is_rbtree $method] != 1 } { + append oflags " -dup" + } + set db [eval {berkdb_open_noerr} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set dbc_u [$db cursor] + error_check_good db:cursor [is_substr $dbc_u $db] 1 + + set nkeys 10 + puts "\tTest$tstn.b: Fill page with $nkeys small key/data pairs." + for { set i 1 } { $i <= $nkeys } { incr i } { + set ret [$db put $key$i $data$i] + error_check_good dbput:$i $ret 0 + if { $i == 1 } { + for {set j 0} { $j < [expr $nkeys / 2]} {incr j} { + set ret [$db put $key$i DUPLICATE$j] + error_check_good dbput:dup:$j $ret 0 + } + } + } + + # DBC GET + puts "\tTest$tstn.c: Test dbc->get interfaces..." + set i 0 + foreach flag { current first last next prev nextdup} { + puts "\t\t...dbc->get($flag)" + catch {$dbc_u get -$flag} ret + error_check_good dbc:get:$flag [is_substr $errorCode EINVAL] 1 + } + + foreach flag { set set_range get_both} { + puts "\t\t...dbc->get($flag)" + if { [string compare $flag get_both] == 0} { + catch {$dbc_u get -$flag $key$i data0} ret + } else { + catch {$dbc_u get -$flag $key$i} ret + } + error_check_good dbc:get:$flag [is_substr $errorCode EINVAL] 1 + } + + puts "\t\t...dbc->get(current, partial)" + catch {$dbc_u get -current -partial {0 0}} ret + error_check_good dbc:get:partial [is_substr $errorCode EINVAL] 1 + + puts "\t\t...dbc->get(current, rmw)" + catch {$dbc_u get -rmw -current } ret + error_check_good dbc_get:rmw [is_substr $errorCode EINVAL] 1 + + puts "\tTest$tstn.d: Test dbc->put interface..." + # partial...depends on another + foreach flag { after before current keyfirst keylast } { + puts "\t\t...dbc->put($flag)" + if { [string match key* $flag] == 1 } { + if { [is_record_based $method] == 1 } { + # keyfirst/keylast not allowed in recno + puts "\t\t...Skipping dbc->put($flag) for $method." + continue + } else { + # keyfirst/last should succeed + puts "\t\t...dbc->put($flag)...should succeed for $method" + error_check_good dbcput:$flag \ + [$dbc_u put -$flag $key$i data0] 0 + + # now uninitialize cursor + error_check_good dbc_close [$dbc_u close] 0 + set dbc_u [$db cursor] + error_check_good \ + db_cursor [is_substr $dbc_u $db] 1 + } + } elseif { [string compare $flag before ] == 0 || + [string compare $flag after ] == 0 } { + if { [is_record_based $method] == 0 && + [is_rbtree $method] == 0} { + set ret [$dbc_u put -$flag data0] + error_check_good "$dbc_u:put:-$flag" $ret 0 + } elseif { $renum == 1 } { + # Renumbering recno will return a record number + set currecno \ + [lindex [lindex [$dbc_u get -current] 0] 0] + set ret [$dbc_u put -$flag data0] + if { [string compare $flag after] == 0 } { + error_check_good "$dbc_u put $flag" \ + $ret [expr $currecno + 1] + } else { + error_check_good "$dbc_u put $flag" \ + $ret $currecno + } + } else { + puts "\t\tSkipping $flag for $method" + } + } else { + set ret [$dbc_u put -$flag data0] + error_check_good "$dbc_u:put:-$flag" $ret 0 + } + } + # and partial + puts "\t\t...dbc->put(partial)" + catch {$dbc_u put -partial {0 0} $key$i $data$i} ret + error_check_good dbc_put:partial [is_substr $errorCode EINVAL] 1 + + # XXX dbc->dup, db->join (dbc->get join_item) + # dbc del + puts "\tTest$tstn.e: Test dbc->del interface." + catch {$dbc_u del} ret + error_check_good dbc_del [is_substr $errorCode EINVAL] 1 + + error_check_good dbc_close [$dbc_u close] 0 + error_check_good db_close [$db close] 0 + + puts "\tTest$tstn complete." +} diff --git a/bdb/test/test050.tcl b/bdb/test/test050.tcl new file mode 100644 index 00000000000..4a2d8c8fdc0 --- /dev/null +++ b/bdb/test/test050.tcl @@ -0,0 +1,191 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test050.tcl,v 11.15 2000/08/25 14:21:57 sue Exp $ +# +# Test050: Overwrite test of small/big key/data with cursor checks for RECNO +proc test050 { method args } { + global alphabet + global errorInfo + global errorCode + source ./include.tcl + + set tstn 050 + + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_rrecno $method] != 1 } { + puts "Test$tstn skipping for method $method." + return + } + + puts "\tTest$tstn:\ + Overwrite test with cursor and small/big key/data ($method)." + + set data "data" + set txn "" + set flags "" + + puts "\tTest$tstn: Create $method database." + 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/test0$tstn.db + set env NULL + } else { + set testfile test0$tstn.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + + set oflags "-create -truncate -mode 0644 $args $omethod" + set db [eval {berkdb_open_noerr} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # open curs to db + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + + # keep nkeys even + set nkeys 20 + + # Fill page w/ small key/data pairs + # + puts "\tTest$tstn: Fill page with $nkeys small key/data pairs." + for { set i 1 } { $i <= $nkeys } { incr i } { + set ret [$db put $i [chop_data $method $data$i]] + error_check_good dbput $ret 0 + } + + # get db order of keys + for {set i 0; set ret [$dbc get -first]} { [llength $ret] != 0} { \ + set ret [$dbc get -next]} { + set key_set($i) [lindex [lindex $ret 0] 0] + set data_set($i) [lindex [lindex $ret 0] 1] + incr i + } + + # verify ordering: should be unnecessary, but hey, why take chances? + # key_set is zero indexed but keys start at 1 + for {set i 0} { $i < $nkeys } {incr i} { + error_check_good \ + verify_order:$i $key_set($i) [pad_data $method [expr $i+1]] + } + + puts "\tTest$tstn.a: Inserts before/after by cursor." + puts "\t\tTest$tstn.a.1:\ + Insert with uninitialized cursor (should fail)." + error_check_good dbc_close [$dbc close] 0 + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + catch {$dbc put -before DATA1} ret + error_check_good dbc_put:before:uninit [is_substr $errorCode EINVAL] 1 + + catch {$dbc put -after DATA2} ret + error_check_good dbc_put:after:uninit [is_substr $errorCode EINVAL] 1 + + puts "\t\tTest$tstn.a.2: Insert with deleted cursor (should succeed)." + set ret [$dbc get -first] + error_check_bad dbc_get:first [llength $ret] 0 + error_check_good dbc_del [$dbc del] 0 + set ret [$dbc put -current DATAOVER1] + error_check_good dbc_put:current:deleted $ret 0 + + puts "\t\tTest$tstn.a.3: Insert by cursor before cursor (DB_BEFORE)." + set currecno [lindex [lindex [$dbc get -current] 0] 0] + set ret [$dbc put -before DATAPUTBEFORE] + error_check_good dbc_put:before $ret $currecno + set old1 [$dbc get -next] + error_check_bad dbc_get:next [llength $old1] 0 + error_check_good \ + dbc_get:next(compare) [lindex [lindex $old1 0] 1] DATAOVER1 + + puts "\t\tTest$tstn.a.4: Insert by cursor after cursor (DB_AFTER)." + set ret [$dbc get -first] + error_check_bad dbc_get:first [llength $ret] 0 + error_check_good dbc_get:first [lindex [lindex $ret 0] 1] DATAPUTBEFORE + set currecno [lindex [lindex [$dbc get -current] 0] 0] + set ret [$dbc put -after DATAPUTAFTER] + error_check_good dbc_put:after $ret [expr $currecno + 1] + set ret [$dbc get -prev] + error_check_bad dbc_get:prev [llength $ret] 0 + error_check_good \ + dbc_get:prev [lindex [lindex $ret 0] 1] DATAPUTBEFORE + + puts "\t\tTest$tstn.a.5: Verify that all keys have been renumbered." + # should be $nkeys + 2 keys, starting at 1 + for {set i 1; set ret [$dbc get -first]} { \ + $i <= $nkeys && [llength $ret] != 0 } {\ + incr i; set ret [$dbc get -next]} { + error_check_good check_renumber $i [lindex [lindex $ret 0] 0] + } + + # tested above + + puts "\tTest$tstn.b: Overwrite tests (cursor and key)." + # For the next part of the test, we need a db with no dups to test + # overwrites + # + # we should have ($nkeys + 2) keys, ordered: + # DATAPUTBEFORE, DATAPUTAFTER, DATAOVER1, data1, ..., data$nkeys + # + # Prepare cursor on item + # + set ret [$dbc get -first] + error_check_bad dbc_get:first [llength $ret] 0 + + # Prepare unique big/small values for an initial + # and an overwrite set of data + set databig DATA_BIG_[repeat alphabet 250] + set datasmall DATA_SMALL + + # Now, we want to overwrite data: + # by key and by cursor + # 1. small by small + # 2. small by big + # 3. big by small + # 4. big by big + # + set i 0 + # Do all overwrites for key and cursor + foreach type { by_key by_cursor } { + incr i + puts "\tTest$tstn.b.$i: Overwrites $type." + foreach pair { {small small} \ + {small big} {big small} {big big} } { + # put in initial type + set data $data[lindex $pair 0] + set ret [$dbc put -current $data] + error_check_good dbc_put:curr:init:($pair) $ret 0 + + # Now, try to overwrite: dups not supported in this db + if { [string compare $type by_key] == 0 } { + puts "\t\tTest$tstn.b.$i:\ + Overwrite:($pair):$type" + set ret [$db put \ + 1 OVER$pair$data[lindex $pair 1]] + error_check_good dbput:over:($pair) $ret 0 + } else { + # This is a cursor overwrite + puts "\t\tTest$tstn.b.$i:\ + Overwrite:($pair) by cursor." + set ret [$dbc put \ + -current OVER$pair$data[lindex $pair 1]] + error_check_good dbcput:over:($pair) $ret 0 + } + } ;# foreach pair + } ;# foreach type key/cursor + + puts "\tTest$tstn.c: Cleanup and close cursor." + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + puts "\tTest$tstn complete." +} diff --git a/bdb/test/test051.tcl b/bdb/test/test051.tcl new file mode 100644 index 00000000000..6994526e214 --- /dev/null +++ b/bdb/test/test051.tcl @@ -0,0 +1,191 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test051.tcl,v 11.14 2000/08/25 14:21:57 sue Exp $ +# +# Test51: +# Test of the fixed recno method. +# 0. Test various flags (legal and illegal) to open +# 1. Test partial puts where dlen != size (should fail) +# 2. Partial puts for existent record -- replaces at beg, mid, and +# end of record, as well as full replace +# +proc test051 { method { args "" } } { + global fixed_len + global errorInfo + global errorCode + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test051: Test of the fixed length records." + if { [is_fixed_length $method] != 1 } { + puts "Test051: skipping for method $method" + return + } + + # Create the database and open the dictionary + 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/test051.db + set testfile1 $testdir/test051a.db + set env NULL + } else { + set testfile test051.db + set testfile1 test051a.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + set oflags "-create -truncate -mode 0644 $args" + + # Test various flags (legal and illegal) to open + puts "\tTest051.a: Test correct flag behavior on open." + set errorCode NONE + foreach f { "-dup" "-dup -dupsort" "-recnum" } { + puts "\t\tTest051.a: Test flag $f" + error_check_good dbopen:flagtest:catch \ + [catch {set db \ + [eval {berkdb_open_noerr} $oflags $f $omethod \ + $testfile]} ret] 1 + error_check_good \ + dbopen:flagtest:$f [is_substr $errorCode EINVAL] 1 + set errorCode NONE + } + set f "-renumber" + puts "\t\tTest051.a: Test $f" + if { [is_frecno $method] == 1 } { + set db [eval {berkdb_open} $oflags $f $omethod $testfile] + error_check_good dbopen:flagtest:$f [is_valid_db $db] TRUE + $db close + } else { + error_check_good \ + dbopen:flagtest:catch [catch {set db [eval \ + {berkdb_open_noerr} $oflags $f \ + $omethod $testfile]} ret] 1 + error_check_good \ + dbopen:flagtest:$f [is_substr $errorCode EINVAL] 1 + } + + + # Test partial puts where dlen != size (should fail) + # it is an error to specify a partial put w/ different + # dlen and size in fixed length recno/queue + set key 1 + set data "" + set test_char "a" + + set db [eval {berkdb_open_noerr} $oflags $omethod $testfile1] + error_check_good dbopen [is_valid_db $db] TRUE + + puts "\tTest051.b: Partial puts with dlen != size." + foreach dlen { 1 16 20 32 } { + foreach doff { 0 10 20 32 } { + # dlen < size + puts "\t\tTest051.e: dlen: $dlen, doff: $doff, \ + size: [expr $dlen+1]" + set data [repeat $test_char [expr $dlen + 1]] + error_check_good catch:put 1 [catch {$db \ + put -partial [list $doff $dlen] $key $data} ret] + # + # We don't get back the server error string just + # the result. + # + if { $eindex == -1 } { + error_check_good "dbput:partial: dlen < size" \ + [is_substr $errorInfo "Length improper"] 1 + } else { + error_check_good "dbput:partial: dlen < size" \ + [is_substr $errorCode "EINVAL"] 1 + } + + # dlen > size + puts "\t\tTest051.e: dlen: $dlen, doff: $doff, \ + size: [expr $dlen-1]" + set data [repeat $test_char [expr $dlen - 1]] + error_check_good catch:put 1 [catch {$db \ + put -partial [list $doff $dlen] $key $data} ret] + if { $eindex == -1 } { + error_check_good "dbput:partial: dlen > size" \ + [is_substr $errorInfo "Length improper"] 1 + } else { + error_check_good "dbput:partial: dlen < size" \ + [is_substr $errorCode "EINVAL"] 1 + } + } + } + + $db close + + # Partial puts for existent record -- replaces at beg, mid, and + # end of record, as well as full replace + puts "\tTest051.f: Partial puts within existent record." + set db [eval {berkdb_open} $oflags $omethod $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + puts "\t\tTest051.f: First try a put and then a full replace." + set data [repeat "a" $fixed_len] + + set ret [$db put 1 $data] + error_check_good dbput $ret 0 + error_check_good dbget $data [lindex [lindex [$db get -recno 1] 0] 1] + + set data [repeat "b" $fixed_len] + set ret [$db put -partial [list 0 $fixed_len] 1 $data] + error_check_good dbput $ret 0 + error_check_good dbget $data [lindex [lindex [$db get -recno 1] 0] 1] + + set data "InitialData" + set pdata "PUT" + set dlen [string length $pdata] + set ilen [string length $data] + set mid [expr $ilen/2] + + # put initial data + set key 0 + + set offlist [list 0 $mid [expr $ilen -1] [expr $fixed_len - $dlen]] + puts "\t\tTest051.g: Now replace at different offsets ($offlist)." + foreach doff $offlist { + incr key + set ret [$db put $key $data] + error_check_good dbput:init $ret 0 + + puts "\t\t Test051.g: Replace at offset $doff." + set ret [$db put -partial [list $doff $dlen] $key $pdata] + error_check_good dbput:partial $ret 0 + + if { $doff == 0} { + set beg "" + set end [string range $data $dlen $ilen] + } else { + set beg [string range $data 0 [expr $doff - 1]] + set end [string range $data [expr $doff + $dlen] $ilen] + } + if { $doff > $ilen } { + # have to put padding between record and inserted + # string + set newdata [format %s%s $beg $end] + set diff [expr $doff - $ilen] + set nlen [string length $newdata] + set newdata [binary \ + format a[set nlen]x[set diff]a$dlen $newdata $pdata] + } else { + set newdata [make_fixed_length \ + frecno [format %s%s%s $beg $pdata $end]] + } + set ret [$db get -recno $key] + error_check_good compare($newdata,$ret) \ + [binary_compare [lindex [lindex $ret 0] 1] $newdata] 0 + } + + $db close + + puts "\tTest051 complete." +} diff --git a/bdb/test/test052.tcl b/bdb/test/test052.tcl new file mode 100644 index 00000000000..820c99a2bd5 --- /dev/null +++ b/bdb/test/test052.tcl @@ -0,0 +1,254 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test052.tcl,v 11.10 2000/10/06 19:29:52 krinsky Exp $ +# +# Test52 +# Renumbering recno test. +proc test052 { method args } { + global alphabet + global errorInfo + global errorCode + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test052: Test of renumbering recno." + if { [is_rrecno $method] != 1} { + puts "Test052: skipping for method $method." + return + } + + set data "data" + set txn "" + set flags "" + + puts "\tTest052: Create $method database." + 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/test052.db + set env NULL + } else { + set testfile test052.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + + set oflags "-create -truncate -mode 0644 $args $omethod" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # open curs to db + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + + # keep nkeys even + set nkeys 20 + + # Fill page w/ small key/data pairs + puts "\tTest052: Fill page with $nkeys small key/data pairs." + for { set i 1 } { $i <= $nkeys } { incr i } { + set ret [$db put $i $data$i] + error_check_good dbput $ret 0 + } + + # get db order of keys + for {set i 1; set ret [$dbc get -first]} { [llength $ret] != 0} { \ + set ret [$dbc get -next]} { + set keys($i) [lindex [lindex $ret 0] 0] + set darray($i) [lindex [lindex $ret 0] 1] + incr i + } + + puts "\tTest052: Deletes by key." + puts "\t Test052.a: Get data with SET, then delete before cursor." + # get key in middle of page, call this the nth set curr to it + set i [expr $nkeys/2] + set k $keys($i) + set ret [$dbc get -set $k] + error_check_bad dbc_get:set [llength $ret] 0 + error_check_good dbc_get:set [lindex [lindex $ret 0] 1] $darray($i) + + # delete by key before current + set i [incr i -1] + error_check_good db_del:before [$db del $keys($i)] 0 + # with renumber, current's data should be constant, but key==--key + set i [incr i +1] + error_check_good dbc:data \ + [lindex [lindex [$dbc get -current] 0] 1] $darray($i) + error_check_good dbc:keys \ + [lindex [lindex [$dbc get -current] 0] 0] $keys([expr $nkeys/2 - 1]) + + puts "\t Test052.b: Delete cursor item by key." + set i [expr $nkeys/2 ] + + set ret [$dbc get -set $keys($i)] + error_check_bad dbc:get [llength $ret] 0 + error_check_good dbc:get:curs [lindex [lindex $ret 0] 1] \ + $darray([expr $i + 1]) + error_check_good db_del:curr [$db del $keys($i)] 0 + set ret [$dbc get -current] + + # After a delete, cursor should return DB_NOTFOUND. + error_check_good dbc:get:key [llength [lindex [lindex $ret 0] 0]] 0 + error_check_good dbc:get:data [llength [lindex [lindex $ret 0] 1]] 0 + + # And the item after the cursor should now be + # key: $nkeys/2, data: $nkeys/2 + 2 + set ret [$dbc get -next] + error_check_bad dbc:getnext [llength $ret] 0 + error_check_good dbc:getnext:data \ + [lindex [lindex $ret 0] 1] $darray([expr $i + 2]) + error_check_good dbc:getnext:keys \ + [lindex [lindex $ret 0] 0] $keys($i) + + puts "\t Test052.c: Delete item after cursor." + # should be { keys($nkeys/2), darray($nkeys/2 + 2) } + set i [expr $nkeys/2] + # deleting data for key after current (key $nkeys/2 + 1) + error_check_good db_del [$db del $keys([expr $i + 1])] 0 + + # current should be constant + set ret [$dbc get -current] + error_check_bad dbc:get:current [llength $ret] 0 + error_check_good dbc:get:keys [lindex [lindex $ret 0] 0] \ + $keys($i) + error_check_good dbc:get:data [lindex [lindex $ret 0] 1] \ + $darray([expr $i + 2]) + + puts "\tTest052: Deletes by cursor." + puts "\t Test052.d: Delete, do DB_NEXT." + set i 1 + set ret [$dbc get -first] + error_check_bad dbc_get:first [llength $ret] 0 + error_check_good dbc_get:first [lindex [lindex $ret 0] 1] $darray($i) + error_check_good dbc_del [$dbc del] 0 + set ret [$dbc get -current] + error_check_bad dbc_get:current [llength $ret] 0 + error_check_good dbc:getcurrent:key \ + [llength [lindex [lindex $ret 0] 0]] 0 + error_check_good dbc:getcurrent:data \ + [llength [lindex [lindex $ret 0] 1]] 0 + + set ret [$dbc get -next] + error_check_bad dbc_get:next [llength $ret] 0 + error_check_good dbc:get:curs \ + [lindex [lindex $ret 0] 1] $darray([expr $i + 1]) + error_check_good dbc:get:keys \ + [lindex [lindex $ret 0] 0] $keys($i) + + # Move one more forward, so we're not on the first item. + error_check_bad dbc:getnext [llength [$dbc get -next]] 0 + + puts "\t Test052.e: Delete, do DB_PREV." + error_check_good dbc:del [$dbc del] 0 + set ret [$dbc get -current] + error_check_bad dbc:get:curr [llength $ret] 0 + error_check_good dbc:getcurrent:key \ + [llength [lindex [lindex $ret 0] 0]] 0 + error_check_good dbc:getcurrent:data \ + [llength [lindex [lindex $ret 0] 1]] 0 + + # next should now reference the record that was previously after + # old current + set ret [$dbc get -next] + error_check_bad get:next [llength $ret] 0 + error_check_good dbc:get:next:data \ + [lindex [lindex $ret 0] 1] $darray([expr $i + 3]) + error_check_good dbc:get:next:keys \ + [lindex [lindex $ret 0] 0] $keys([expr $i + 1]) + + set ret [$dbc get -prev] + error_check_bad dbc:get:curr [llength $ret] 0 + error_check_good dbc:get:curr:compare \ + [lindex [lindex $ret 0] 1] $darray([expr $i + 1]) + error_check_good dbc:get:curr:keys \ + [lindex [lindex $ret 0] 0] $keys($i) + + # The rest of the test was written with the old rrecno semantics, + # which required a separate c_del(CURRENT) test; to leave + # the database in the expected state, we now delete the first item. + set ret [$dbc get -first] + error_check_bad getfirst [llength $ret] 0 + error_check_good delfirst [$dbc del] 0 + + puts "\tTest052: Inserts." + puts "\t Test052.g: Insert before (DB_BEFORE)." + set i 1 + set ret [$dbc get -first] + error_check_bad dbc:get:first [llength $ret] 0 + error_check_good dbc_get:first \ + [lindex [lindex $ret 0] 0] $keys($i) + error_check_good dbc_get:first:data \ + [lindex [lindex $ret 0] 1] $darray([expr $i + 3]) + + set ret [$dbc put -before $darray($i)] + # should return new key, which should be $keys($i) + error_check_good dbc_put:before $ret $keys($i) + # cursor should adjust to point to new item + set ret [$dbc get -current] + error_check_bad dbc_get:curr [llength $ret] 0 + error_check_good dbc_put:before:keys \ + [lindex [lindex $ret 0] 0] $keys($i) + error_check_good dbc_put:before:data \ + [lindex [lindex $ret 0] 1] $darray($i) + + set ret [$dbc get -next] + error_check_bad dbc_get:next [llength $ret] 0 + error_check_good dbc_get:next:compare \ + $ret [list [list $keys([expr $i + 1]) $darray([expr $i + 3])]] + set ret [$dbc get -prev] + error_check_bad dbc_get:prev [llength $ret] 0 + + puts "\t Test052.h: Insert by cursor after (DB_AFTER)." + set i [incr i] + set ret [$dbc put -after $darray($i)] + # should return new key, which should be $keys($i) + error_check_good dbcput:after $ret $keys($i) + # cursor should reference new item + set ret [$dbc get -current] + error_check_good dbc:get:current:keys \ + [lindex [lindex $ret 0] 0] $keys($i) + error_check_good dbc:get:current:data \ + [lindex [lindex $ret 0] 1] $darray($i) + + # items after curs should be adjusted + set ret [$dbc get -next] + error_check_bad dbc:get:next [llength $ret] 0 + error_check_good dbc:get:next:compare \ + $ret [list [list $keys([expr $i + 1]) $darray([expr $i + 2])]] + + puts "\t Test052.i: Insert (overwrite) current item (DB_CURRENT)." + set i 1 + set ret [$dbc get -first] + error_check_bad dbc_get:first [llength $ret] 0 + # choose a datum that is not currently in db + set ret [$dbc put -current $darray([expr $i + 2])] + error_check_good dbc_put:curr $ret 0 + # curs should be on new item + set ret [$dbc get -current] + error_check_bad dbc_get:current [llength $ret] 0 + error_check_good dbc_get:curr:keys \ + [lindex [lindex $ret 0] 0] $keys($i) + error_check_good dbc_get:curr:data \ + [lindex [lindex $ret 0] 1] $darray([expr $i + 2]) + + set ret [$dbc get -next] + error_check_bad dbc_get:next [llength $ret] 0 + set i [incr i] + error_check_good dbc_get:next \ + $ret [list [list $keys($i) $darray($i)]] + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + puts "\tTest052 complete." +} diff --git a/bdb/test/test053.tcl b/bdb/test/test053.tcl new file mode 100644 index 00000000000..e3a908c90d8 --- /dev/null +++ b/bdb/test/test053.tcl @@ -0,0 +1,194 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test053.tcl,v 11.12 2000/12/11 17:24:55 sue Exp $ +# +# Test53: test of the DB_REVSPLITOFF flag in the btree and +# Btree-w-recnum methods +proc test053 { method args } { + global alphabet + global errorCode + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "\tTest053: Test of cursor stability across btree splits." + if { [is_btree $method] != 1 && [is_rbtree $method] != 1 } { + puts "Test053: skipping for method $method." + return + } + + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test053: skipping for specific pagesizes" + return + } + + set txn "" + set flags "" + + puts "\tTest053.a: Create $omethod $args database." + 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/test053.db + set env NULL + } else { + set testfile test053.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + + set oflags \ + "-create -truncate -revsplitoff -pagesize 1024 $args $omethod" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set nkeys 8 + set npages 15 + + # We want to create a db with npages leaf pages, and have each page + # be near full with keys that we can predict. We set pagesize above + # to 1024 bytes, it should breakdown as follows (per page): + # + # ~20 bytes overhead + # key: ~4 bytes overhead, XXX0N where X is a letter, N is 0-9 + # data: ~4 bytes overhead, + 100 bytes + # + # then, with 8 keys/page we should be just under 1024 bytes + puts "\tTest053.b: Create $npages pages with $nkeys pairs on each." + set keystring [string range $alphabet 0 [expr $npages -1]] + set data [repeat DATA 22] + for { set i 0 } { $i < $npages } {incr i } { + set key "" + set keyroot \ + [repeat [string toupper [string range $keystring $i $i]] 3] + set key_set($i) $keyroot + for {set j 0} { $j < $nkeys} {incr j} { + if { $j < 10 } { + set key [set keyroot]0$j + } else { + set key $keyroot$j + } + set ret [$db put $key $data] + error_check_good dbput $ret 0 + } + } + + puts "\tTest053.c: Check page count." + error_check_good page_count:check \ + [is_substr [$db stat] "{Leaf pages} $npages"] 1 + + puts "\tTest053.d: Delete all but one key per page." + for {set i 0} { $i < $npages } {incr i } { + for {set j 1} { $j < $nkeys } {incr j } { + set ret [$db del $key_set($i)0$j] + error_check_good dbdel $ret 0 + } + } + puts "\tTest053.e: Check to make sure all pages are still there." + error_check_good page_count:check \ + [is_substr [$db stat] "{Leaf pages} $npages"] 1 + + set dbc [$db cursor] + error_check_good db:cursor [is_substr $dbc $db] 1 + + # walk cursor through tree forward, backward. + # delete one key, repeat + for {set i 0} { $i < $npages} {incr i} { + puts -nonewline \ + "\tTest053.f.$i: Walk curs through tree: forward..." + for { set j $i; set curr [$dbc get -first]} { $j < $npages} { \ + incr j; set curr [$dbc get -next]} { + error_check_bad dbc:get:next [llength $curr] 0 + error_check_good dbc:get:keys \ + [lindex [lindex $curr 0] 0] $key_set($j)00 + } + puts -nonewline "backward..." + for { set j [expr $npages - 1]; set curr [$dbc get -last]} { \ + $j >= $i } { \ + set j [incr j -1]; set curr [$dbc get -prev]} { + error_check_bad dbc:get:prev [llength $curr] 0 + error_check_good dbc:get:keys \ + [lindex [lindex $curr 0] 0] $key_set($j)00 + } + puts "complete." + + if { [is_rbtree $method] == 1} { + puts "\t\tTest053.f.$i:\ + Walk through tree with record numbers." + for {set j 1} {$j <= [expr $npages - $i]} {incr j} { + set curr [$db get -recno $j] + error_check_bad \ + db_get:recno:$j [llength $curr] 0 + error_check_good db_get:recno:keys:$j \ + [lindex [lindex $curr 0] 0] \ + $key_set([expr $j + $i - 1])00 + } + } + puts "\tTest053.g.$i:\ + Delete single key ([expr $npages - $i] keys left)." + set ret [$db del $key_set($i)00] + error_check_good dbdel $ret 0 + error_check_good del:check \ + [llength [$db get $key_set($i)00]] 0 + } + + # end for loop, verify db_notfound + set ret [$dbc get -first] + error_check_good dbc:get:verify [llength $ret] 0 + + # loop: until single key restored on each page + for {set i 0} { $i < $npages} {incr i} { + puts "\tTest053.i.$i:\ + Restore single key ([expr $i + 1] keys in tree)." + set ret [$db put $key_set($i)00 $data] + error_check_good dbput $ret 0 + + puts -nonewline \ + "\tTest053.j: Walk cursor through tree: forward..." + for { set j 0; set curr [$dbc get -first]} { $j <= $i} {\ + incr j; set curr [$dbc get -next]} { + error_check_bad dbc:get:next [llength $curr] 0 + error_check_good dbc:get:keys \ + [lindex [lindex $curr 0] 0] $key_set($j)00 + } + error_check_good dbc:get:next [llength $curr] 0 + + puts -nonewline "backward..." + for { set j $i; set curr [$dbc get -last]} { \ + $j >= 0 } { \ + set j [incr j -1]; set curr [$dbc get -prev]} { + error_check_bad dbc:get:prev [llength $curr] 0 + error_check_good dbc:get:keys \ + [lindex [lindex $curr 0] 0] $key_set($j)00 + } + puts "complete." + error_check_good dbc:get:prev [llength $curr] 0 + + if { [is_rbtree $method] == 1} { + puts "\t\tTest053.k.$i:\ + Walk through tree with record numbers." + for {set j 1} {$j <= [expr $i + 1]} {incr j} { + set curr [$db get -recno $j] + error_check_bad \ + db_get:recno:$j [llength $curr] 0 + error_check_good db_get:recno:keys:$j \ + [lindex [lindex $curr 0] 0] \ + $key_set([expr $j - 1])00 + } + } + } + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + puts "Test053 complete." +} diff --git a/bdb/test/test054.tcl b/bdb/test/test054.tcl new file mode 100644 index 00000000000..7308f995645 --- /dev/null +++ b/bdb/test/test054.tcl @@ -0,0 +1,369 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test054.tcl,v 11.15 2000/08/25 14:21:57 sue Exp $ +# +# Test054: +# +# This test checks for cursor maintenance in the presence of deletes. +# There are N different scenarios to tests: +# 1. No duplicates. Cursor A deletes a key, do a GET for the key. +# 2. No duplicates. Cursor is positioned right before key K, Delete K, +# do a next on the cursor. +# 3. No duplicates. Cursor is positioned on key K, do a regular delete of K. +# do a current get on K. +# 4. Repeat 3 but do a next instead of current. +# +# 5. Duplicates. Cursor A is on the first item of a duplicate set, A +# does a delete. Then we do a non-cursor get. +# 6. Duplicates. Cursor A is in a duplicate set and deletes the item. +# do a delete of the entire Key. Test cursor current. +# 7. Continue last test and try cursor next. +# 8. Duplicates. Cursor A is in a duplicate set and deletes the item. +# Cursor B is in the same duplicate set and deletes a different item. +# Verify that the cursor is in the right place. +# 9. Cursors A and B are in the place in the same duplicate set. A deletes +# its item. Do current on B. +# 10. Continue 8 and do a next on B. +proc test054 { method args } { + global errorInfo + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + append args " -create -truncate -mode 0644" + puts "Test054 ($method $args):\ + interspersed cursor and normal operations" + if { [is_record_based $method] == 1 } { + puts "Test054 skipping for method $method" + return + } + + # Create the database and open the dictionary + 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/test054.db + set env NULL + } else { + set testfile test054.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set flags "" + set txn "" + + puts "\tTest054.a: No Duplicate Tests" + set db [eval {berkdb_open} $args {$omethod $testfile}] + error_check_good db_open:nodup [is_valid_db $db] TRUE + + set curs [eval {$db cursor} $txn] + error_check_good curs_open:nodup [is_substr $curs $db] 1 + + # Put three keys in the database + for { set key 1 } { $key <= 3 } {incr key} { + set r [eval {$db put} $txn $flags {$key datum$key}] + error_check_good put $r 0 + } + + # Retrieve keys sequentially so we can figure out their order + set i 1 + for {set d [$curs get -first] } \ + {[llength $d] != 0 } \ + {set d [$curs get -next] } { + set key_set($i) [lindex [lindex $d 0] 0] + incr i + } + + # TEST CASE 1 + puts "\tTest054.a1: Delete w/cursor, regular get" + + # Now set the cursor on the middle on. + set r [$curs get -set $key_set(2)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(2) + error_check_good curs_get:DB_SET:data $d datum$key_set(2) + + # Now do the delete + set r [eval {$curs del} $txn] + error_check_good curs_del $r 0 + + # Now do the get + set r [eval {$db get} $txn {$key_set(2)}] + error_check_good get_after_del [llength $r] 0 + + # Free up the cursor. + error_check_good cursor_close [eval {$curs close}] 0 + + # TEST CASE 2 + puts "\tTest054.a2: Cursor before K, delete K, cursor next" + + # Replace key 2 + set r [eval {$db put} $txn {$key_set(2) datum$key_set(2)}] + error_check_good put $r 0 + + # Open and position cursor on first item. + set curs [eval {$db cursor} $txn] + error_check_good curs_open:nodup [is_substr $curs $db] 1 + + # Retrieve keys sequentially so we can figure out their order + set i 1 + for {set d [eval {$curs get} -first] } \ + {[llength $d] != 0 } \ + {set d [$curs get -nextdup] } { + set key_set($i) [lindex [lindex $d 0] 0] + incr i + } + + set r [eval {$curs get} -set {$key_set(1)} ] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(1) + error_check_good curs_get:DB_SET:data $d datum$key_set(1) + + # Now delete (next item) $key_set(2) + error_check_good \ + db_del:$key_set(2) [eval {$db del} $txn {$key_set(2)}] 0 + + # Now do next on cursor + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(3) + error_check_good curs_get:DB_NEXT:data $d datum$key_set(3) + + # TEST CASE 3 + puts "\tTest054.a3: Cursor on K, delete K, cursor current" + + # delete item 3 + error_check_good \ + db_del:$key_set(3) [eval {$db del} $txn {$key_set(3)}] 0 + # NEEDS TO COME BACK IN, BUG CHECK + set ret [$curs get -current] + error_check_good current_after_del $ret [list [list [] []]] + error_check_good cursor_close [$curs close] 0 + + puts "\tTest054.a4: Cursor on K, delete K, cursor next" + + # Restore keys 2 and 3 + set r [eval {$db put} $txn {$key_set(2) datum$key_set(2)}] + error_check_good put $r 0 + set r [eval {$db put} $txn {$key_set(3) datum$key_set(3)}] + error_check_good put $r 0 + + # Create the new cursor and put it on 1 + set curs [eval {$db cursor} $txn] + error_check_good curs_open:nodup [is_substr $curs $db] 1 + set r [$curs get -set $key_set(1)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(1) + error_check_good curs_get:DB_SET:data $d datum$key_set(1) + + # Delete 2 + error_check_good \ + db_del:$key_set(2) [eval {$db del} $txn {$key_set(2)}] 0 + + # Now do next on cursor + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(3) + error_check_good curs_get:DB_NEXT:data $d datum$key_set(3) + + # Close cursor + error_check_good curs_close [$curs close] 0 + error_check_good db_close [$db close] 0 + + # Now get ready for duplicate tests + + if { [is_rbtree $method] == 1 } { + puts "Test054: skipping remainder of test for method $method." + return + } + + puts "\tTest054.b: Duplicate Tests" + append args " -dup" + set db [eval {berkdb_open} $args {$omethod $testfile}] + error_check_good db_open:dup [is_valid_db $db] TRUE + + set curs [eval {$db cursor} $txn] + error_check_good curs_open:dup [is_substr $curs $db] 1 + + # Put three keys in the database + for { set key 1 } { $key <= 3 } {incr key} { + set r [eval {$db put} $txn $flags {$key datum$key}] + error_check_good put $r 0 + } + + # Retrieve keys sequentially so we can figure out their order + set i 1 + for {set d [$curs get -first] } \ + {[llength $d] != 0 } \ + {set d [$curs get -nextdup] } { + set key_set($i) [lindex [lindex $d 0] 0] + incr i + } + + # Now put in a bunch of duplicates for key 2 + for { set d 1 } { $d <= 5 } {incr d} { + set r [eval {$db put} $txn $flags {$key_set(2) dup_$d}] + error_check_good dup:put $r 0 + } + + # TEST CASE 5 + puts "\tTest054.b1: Delete dup w/cursor on first item. Get on key." + + # Now set the cursor on the first of the duplicate set. + set r [eval {$curs get} -set {$key_set(2)}] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(2) + error_check_good curs_get:DB_SET:data $d datum$key_set(2) + + # Now do the delete + set r [$curs del] + error_check_good curs_del $r 0 + + # Now do the get + set r [eval {$db get} $txn {$key_set(2)}] + error_check_good get_after_del [lindex [lindex $r 0] 1] dup_1 + + # TEST CASE 6 + puts "\tTest054.b2: Now get the next duplicate from the cursor." + + # Now do next on cursor + set r [$curs get -nextdup] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(2) + error_check_good curs_get:DB_NEXT:data $d dup_1 + + # TEST CASE 3 + puts "\tTest054.b3: Two cursors in set; each delete different items" + + # Open a new cursor. + set curs2 [eval {$db cursor} $txn] + error_check_good curs_open [is_substr $curs2 $db] 1 + + # Set on last of duplicate set. + set r [$curs2 get -set $key_set(3)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(3) + error_check_good curs_get:DB_SET:data $d datum$key_set(3) + + set r [$curs2 get -prev] + error_check_bad cursor_get:DB_PREV [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_PREV:key $k $key_set(2) + error_check_good curs_get:DB_PREV:data $d dup_5 + + # Delete the item at cursor 1 (dup_1) + error_check_good curs1_del [$curs del] 0 + + # Verify curs1 and curs2 + # current should fail + set ret [$curs get -current] + error_check_good \ + curs1_get_after_del $ret [list [list [] []]] + + set r [$curs2 get -current] + error_check_bad curs2_get [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_CURRENT:key $k $key_set(2) + error_check_good curs_get:DB_CURRENT:data $d dup_5 + + # Now delete the item at cursor 2 (dup_5) + error_check_good curs2_del [$curs2 del] 0 + + # Verify curs1 and curs2 + set ret [$curs get -current] + error_check_good curs1_get:del2 $ret [list [list [] []]] + + set ret [$curs2 get -current] + error_check_good curs2_get:del2 $ret [list [list [] []]] + + # Now verify that next and prev work. + + set r [$curs2 get -prev] + error_check_bad cursor_get:DB_PREV [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_PREV:key $k $key_set(2) + error_check_good curs_get:DB_PREV:data $d dup_4 + + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(2) + error_check_good curs_get:DB_NEXT:data $d dup_2 + + puts "\tTest054.b4: Two cursors same item, one delete, one get" + + # Move curs2 onto dup_2 + set r [$curs2 get -prev] + error_check_bad cursor_get:DB_PREV [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_PREV:key $k $key_set(2) + error_check_good curs_get:DB_PREV:data $d dup_3 + + set r [$curs2 get -prev] + error_check_bad cursor_get:DB_PREV [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_PREV:key $k $key_set(2) + error_check_good curs_get:DB_PREV:data $d dup_2 + + # delete on curs 1 + error_check_good curs1_del [$curs del] 0 + + # Verify gets on both 1 and 2 + set ret [$curs get -current] + error_check_good \ + curs1_get:deleted $ret [list [list [] []]] + set ret [$curs2 get -current] + error_check_good \ + curs2_get:deleted $ret [list [list [] []]] + + puts "\tTest054.b5: Now do a next on both cursors" + + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(2) + error_check_good curs_get:DB_NEXT:data $d dup_3 + + set r [$curs2 get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(2) + error_check_good curs_get:DB_NEXT:data $d dup_3 + + # Close cursor + error_check_good curs_close [$curs close] 0 + error_check_good curs2_close [$curs2 close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test055.tcl b/bdb/test/test055.tcl new file mode 100644 index 00000000000..fc5ce4e98bd --- /dev/null +++ b/bdb/test/test055.tcl @@ -0,0 +1,118 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test055.tcl,v 11.11 2000/08/25 14:21:57 sue Exp $ +# +# Test055: +# This test checks basic cursor operations. +# There are N different scenarios to tests: +# 1. (no dups) Set cursor, retrieve current. +# 2. (no dups) Set cursor, retrieve next. +# 3. (no dups) Set cursor, retrieve prev. +proc test055 { method args } { + global errorInfo + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test055: $method interspersed cursor and normal operations" + + # Create the database and open the dictionary + 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/test055.db + set env NULL + } else { + set testfile test055.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set flags "" + set txn "" + + puts "\tTest055.a: No duplicates" + set db [eval {berkdb_open -create -truncate -mode 0644 $omethod } \ + $args {$testfile}] + error_check_good db_open:nodup [is_valid_db $db] TRUE + + set curs [eval {$db cursor} $txn] + error_check_good curs_open:nodup [is_substr $curs $db] 1 + + # Put three keys in the database + for { set key 1 } { $key <= 3 } {incr key} { + set r [eval {$db put} $txn $flags {$key datum$key}] + error_check_good put $r 0 + } + + # Retrieve keys sequentially so we can figure out their order + set i 1 + for {set d [$curs get -first] } { [llength $d] != 0 } {\ + set d [$curs get -next] } { + set key_set($i) [lindex [lindex $d 0] 0] + incr i + } + + # TEST CASE 1 + puts "\tTest055.a1: Set cursor, retrieve current" + + # Now set the cursor on the middle on. + set r [$curs get -set $key_set(2)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(2) + error_check_good \ + curs_get:DB_SET:data $d [pad_data $method datum$key_set(2)] + + # Now retrieve current + set r [$curs get -current] + error_check_bad cursor_get:DB_CURRENT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_CURRENT:key $k $key_set(2) + error_check_good \ + curs_get:DB_CURRENT:data $d [pad_data $method datum$key_set(2)] + + # TEST CASE 2 + puts "\tTest055.a2: Set cursor, retrieve previous" + set r [$curs get -prev] + error_check_bad cursor_get:DB_PREV [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_PREV:key $k $key_set(1) + error_check_good \ + curs_get:DB_PREV:data $d [pad_data $method datum$key_set(1)] + + #TEST CASE 3 + puts "\tTest055.a2: Set cursor, retrieve next" + + # Now set the cursor on the middle on. + set r [$curs get -set $key_set(2)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(2) + error_check_good \ + curs_get:DB_SET:data $d [pad_data $method datum$key_set(2)] + + # Now retrieve next + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(3) + error_check_good \ + curs_get:DB_NEXT:data $d [pad_data $method datum$key_set(3)] + + # Close cursor and database. + error_check_good curs_close [$curs close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test056.tcl b/bdb/test/test056.tcl new file mode 100644 index 00000000000..ade3890c3f9 --- /dev/null +++ b/bdb/test/test056.tcl @@ -0,0 +1,145 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test056.tcl,v 11.13 2000/08/25 14:21:57 sue Exp $ +# +# Test056 +# Check if deleting a key when a cursor is on a duplicate of that key works. +proc test056 { method args } { + global errorInfo + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + append args " -create -truncate -mode 0644 -dup " + if { [is_record_based $method] == 1 || [is_rbtree $method] } { + puts "Test056: skipping for method $method" + return + } + puts "Test056: $method delete of key in presence of cursor" + + # Create the database and open the dictionary + 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/test056.db + set env NULL + } else { + set testfile test056.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set flags "" + set txn "" + + set db [eval {berkdb_open} $args {$omethod $testfile}] + error_check_good db_open:dup [is_valid_db $db] TRUE + + set curs [eval {$db cursor} $txn] + error_check_good curs_open:dup [is_substr $curs $db] 1 + + puts "\tTest056.a: Key delete with cursor on duplicate." + # Put three keys in the database + for { set key 1 } { $key <= 3 } {incr key} { + set r [eval {$db put} $txn $flags {$key datum$key}] + error_check_good put $r 0 + } + + # Retrieve keys sequentially so we can figure out their order + set i 1 + for {set d [$curs get -first] } { [llength $d] != 0 } { + set d [$curs get -next] } { + set key_set($i) [lindex [lindex $d 0] 0] + incr i + } + + # Now put in a bunch of duplicates for key 2 + for { set d 1 } { $d <= 5 } {incr d} { + set r [eval {$db put} $txn $flags {$key_set(2) dup_$d}] + error_check_good dup:put $r 0 + } + + # Now put the cursor on a duplicate of key 2 + + # Now set the cursor on the first of the duplicate set. + set r [$curs get -set $key_set(2)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(2) + error_check_good curs_get:DB_SET:data $d datum$key_set(2) + + # Now do two nexts + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(2) + error_check_good curs_get:DB_NEXT:data $d dup_1 + + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(2) + error_check_good curs_get:DB_NEXT:data $d dup_2 + + # Now do the delete + set r [eval {$db del} $txn $flags {$key_set(2)}] + error_check_good delete $r 0 + + # Now check the get current on the cursor. + set ret [$curs get -current] + error_check_good curs_after_del $ret [list [list [] []]] + + # Now check that the rest of the database looks intact. There + # should be only two keys, 1 and 3. + + set r [$curs get -first] + error_check_bad cursor_get:DB_FIRST [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_FIRST:key $k $key_set(1) + error_check_good curs_get:DB_FIRST:data $d datum$key_set(1) + + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(3) + error_check_good curs_get:DB_NEXT:data $d datum$key_set(3) + + set r [$curs get -next] + error_check_good cursor_get:DB_NEXT [llength $r] 0 + + puts "\tTest056.b:\ + Cursor delete of first item, followed by cursor FIRST" + # Set to beginning + set r [$curs get -first] + error_check_bad cursor_get:DB_FIRST [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_FIRST:key $k $key_set(1) + error_check_good curs_get:DB_FIRST:data $d datum$key_set(1) + + # Now do delete + error_check_good curs_del [$curs del] 0 + + # Now do DB_FIRST + set r [$curs get -first] + error_check_bad cursor_get:DB_FIRST [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_FIRST:key $k $key_set(3) + error_check_good curs_get:DB_FIRST:data $d datum$key_set(3) + + error_check_good curs_close [$curs close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test057.tcl b/bdb/test/test057.tcl new file mode 100644 index 00000000000..1dc350e32a5 --- /dev/null +++ b/bdb/test/test057.tcl @@ -0,0 +1,225 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test057.tcl,v 11.17 2000/08/25 14:21:57 sue Exp $ +# +# Test057: +# Check if we handle the case where we delete a key with the cursor on it +# and then add the same key. The cursor should not get the new item +# returned, but the item shouldn't disappear. +# Run test tests, one where the overwriting put is done with a put and +# one where it's done with a cursor put. +proc test057 { method args } { + global errorInfo + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + append args " -create -truncate -mode 0644 -dup " + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts "Test057: skipping for method $method" + return + } + puts "Test057: $method delete and replace in presence of cursor." + + # Create the database and open the dictionary + 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/test057.db + set env NULL + } else { + set testfile test057.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set flags "" + set txn "" + + set db [eval {berkdb_open} $args {$omethod $testfile}] + error_check_good dbopen:dup [is_valid_db $db] TRUE + + set curs [eval {$db cursor} $txn] + error_check_good curs_open:dup [is_substr $curs $db] 1 + + puts "\tTest057.a: Set cursor, delete cursor, put with key." + # Put three keys in the database + for { set key 1 } { $key <= 3 } {incr key} { + set r [eval {$db put} $txn $flags {$key datum$key}] + error_check_good put $r 0 + } + + # Retrieve keys sequentially so we can figure out their order + set i 1 + for {set d [$curs get -first] } {[llength $d] != 0 } {\ + set d [$curs get -next] } { + set key_set($i) [lindex [lindex $d 0] 0] + incr i + } + + # Now put in a bunch of duplicates for key 2 + for { set d 1 } { $d <= 5 } {incr d} { + set r [eval {$db put} $txn $flags {$key_set(2) dup_$d}] + error_check_good dup:put $r 0 + } + + # Now put the cursor on key 1 + + # Now set the cursor on the first of the duplicate set. + set r [$curs get -set $key_set(1)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(1) + error_check_good curs_get:DB_SET:data $d datum$key_set(1) + + # Now do the delete + set r [$curs del] + error_check_good delete $r 0 + + # Now check the get current on the cursor. + error_check_good curs_get:del [$curs get -current] [list [list [] []]] + + # Now do a put on the key + set r [eval {$db put} $txn $flags {$key_set(1) new_datum$key_set(1)}] + error_check_good put $r 0 + + # Do a get + set r [eval {$db get} $txn {$key_set(1)}] + error_check_good get [lindex [lindex $r 0] 1] new_datum$key_set(1) + + # Recheck cursor + error_check_good curs_get:deleted [$curs get -current] [list [list [] []]] + + # Move cursor and see if we get the key. + set r [$curs get -first] + error_check_bad cursor_get:DB_FIRST [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_FIRST:key $k $key_set(1) + error_check_good curs_get:DB_FIRST:data $d new_datum$key_set(1) + + puts "\tTest057.b: Set two cursor on a key, delete one, overwrite other" + set curs2 [eval {$db cursor} $txn] + error_check_good curs2_open [is_substr $curs2 $db] 1 + + # Set both cursors on the 4rd key + set r [$curs get -set $key_set(3)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(3) + error_check_good curs_get:DB_SET:data $d datum$key_set(3) + + set r [$curs2 get -set $key_set(3)] + error_check_bad cursor2_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs2_get:DB_SET:key $k $key_set(3) + error_check_good curs2_get:DB_SET:data $d datum$key_set(3) + + # Now delete through cursor 1 + error_check_good curs1_del [$curs del] 0 + + # Verify gets on both 1 and 2 + error_check_good curs_get:deleted [$curs get -current] \ + [list [list [] []]] + error_check_good curs_get:deleted [$curs2 get -current] \ + [list [list [] []]] + + # Now do a replace through cursor 2 + set pflags "-current" + if {[is_hash $method] == 1} { + error_check_good curs1_get_after_del [is_substr \ + [$curs2 put $pflags new_datum$key_set(3)] "DB_NOTFOUND"] 1 + + # Gets fail + error_check_good curs1_get:deleted \ + [$curs get -current] \ + [list [list [] []]] + error_check_good curs2_get:deleted \ + [$curs get -current] \ + [list [list [] []]] + } else { + # btree only, recno is skipped this test + set ret [$curs2 put $pflags new_datum$key_set(3)] + error_check_good curs_replace $ret 0 + } + + # Gets fail + #error_check_good curs1_get:deleted [catch {$curs get -current} r] 1 + #error_check_good curs1_get_after_del \ + [is_substr $errorInfo "DB_KEYEMPTY"] 1 + #error_check_good curs2_get:deleted [catch {$curs2 get -current} r] 1 + #error_check_good curs2_get_after_del \ + [is_substr $errorInfo "DB_KEYEMPTY"] 1 + + puts "\tTest057.c:\ + Set two cursors on a dup, delete one, overwrite other" + + # Set both cursors on the 2nd duplicate of key 2 + set r [$curs get -set $key_set(2)] + error_check_bad cursor_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_SET:key $k $key_set(2) + error_check_good curs_get:DB_SET:data $d datum$key_set(2) + + set r [$curs get -next] + error_check_bad cursor_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs_get:DB_NEXT:key $k $key_set(2) + error_check_good curs_get:DB_NEXT:data $d dup_1 + + set r [$curs2 get -set $key_set(2)] + error_check_bad cursor2_get:DB_SET [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs2_get:DB_SET:key $k $key_set(2) + error_check_good curs2_get:DB_SET:data $d datum$key_set(2) + + set r [$curs2 get -next] + error_check_bad cursor2_get:DB_NEXT [llength $r] 0 + set k [lindex [lindex $r 0] 0] + set d [lindex [lindex $r 0] 1] + error_check_good curs2_get:DB_NEXT:key $k $key_set(2) + error_check_good curs2_get:DB_NEXT:data $d dup_1 + + # Now delete through cursor 1 + error_check_good curs1_del [$curs del] 0 + + # Verify gets on both 1 and 2 + error_check_good curs_get:deleted [$curs get -current] \ + [list [list [] []]] + error_check_good curs_get:deleted [$curs2 get -current] \ + [list [list [] []]] + + # Now do a replace through cursor 2 -- this will work on btree but + # not on hash + if {[is_hash $method] == 1} { + error_check_good hash_replace \ + [is_substr [$curs2 put -current new_dup_1] "DB_NOTFOUND"] 1 + } else { + error_check_good curs_replace [$curs2 put -current new_dup_1] 0 + } + + # Both gets should fail + #error_check_good curs1_get:deleted [catch {$curs get -current} r] 1 + #error_check_good curs1_get_after_del \ + [is_substr $errorInfo "DB_KEYEMPTY"] 1 + #error_check_good curs2_get:deleted [catch {$curs2 get -current} r] 1 + #error_check_good curs2_get_after_del \ + [is_substr $errorInfo "DB_KEYEMPTY"] 1 + + error_check_good curs2_close [$curs2 close] 0 + error_check_good curs_close [$curs close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test058.tcl b/bdb/test/test058.tcl new file mode 100644 index 00000000000..00870a6b5f8 --- /dev/null +++ b/bdb/test/test058.tcl @@ -0,0 +1,99 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test058.tcl,v 11.14 2000/08/25 14:21:57 sue Exp $ +# +proc test058 { method args } { + source ./include.tcl + + # + # If we are using an env, then skip this test. It needs its own. + set eindex [lsearch -exact $args "-env"] + if { $eindex != -1 } { + incr eindex + set env [lindex $args $eindex] + puts "Test058 skipping for env $env" + return + } + set args [convert_args $method $args] + set omethod [convert_method $method] + + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts "Test058: skipping for method $method" + return + } + puts "Test058: $method delete dups after inserting after duped key." + + # environment + env_cleanup $testdir + set eflags "-create -txn -home $testdir" + set env [eval {berkdb env} $eflags] + error_check_good env [is_valid_env $env] TRUE + + # db open + set flags "-create -mode 0644 -dup -env $env $args" + set db [eval {berkdb_open} $flags $omethod "test058.db"] + error_check_good dbopen [is_valid_db $db] TRUE + + set tn "" + set tid "" + set tn [$env txn] + set tflags "-txn $tn" + + puts "\tTest058.a: Adding 10 duplicates" + # Add a bunch of dups + for { set i 0 } { $i < 10 } {incr i} { + set ret \ + [eval {$db put} $tflags {doghouse $i"DUPLICATE_DATA_VALUE"}] + error_check_good db_put $ret 0 + } + + puts "\tTest058.b: Adding key after duplicates" + # Now add one more key/data AFTER the dup set. + set ret [eval {$db put} $tflags {zebrahouse NOT_A_DUP}] + error_check_good db_put $ret 0 + + error_check_good txn_commit [$tn commit] 0 + + set tn [$env txn] + error_check_good txnbegin [is_substr $tn $env] 1 + set tflags "-txn $tn" + + # Now delete everything + puts "\tTest058.c: Deleting duplicated key" + set ret [eval {$db del} $tflags {doghouse}] + error_check_good del $ret 0 + + # Now reput everything + set pad \ + abcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuvabcdefghijklmnopqrtsuv + + puts "\tTest058.d: Reputting duplicates with big data vals" + for { set i 0 } { $i < 10 } {incr i} { + set ret [eval {$db put} \ + $tflags {doghouse $i"DUPLICATE_DATA_VALUE"$pad}] + error_check_good db_put $ret 0 + } + error_check_good txn_commit [$tn commit] 0 + + # Check duplicates for order + set dbc [$db cursor] + error_check_good db_cursor [is_substr $dbc $db] 1 + + puts "\tTest058.e: Verifying that duplicates are in order." + set i 0 + for { set ret [$dbc get -set doghouse] } \ + {$i < 10 && [llength $ret] != 0} \ + { set ret [$dbc get -nextdup] } { + set data [lindex [lindex $ret 0] 1] + error_check_good \ + duplicate_value $data $i"DUPLICATE_DATA_VALUE"$pad + incr i + } + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + reset_env $env +} diff --git a/bdb/test/test059.tcl b/bdb/test/test059.tcl new file mode 100644 index 00000000000..f9988c4e20b --- /dev/null +++ b/bdb/test/test059.tcl @@ -0,0 +1,128 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test059.tcl,v 11.12 2000/08/25 14:21:57 sue Exp $ +# +# Test059: +# Make sure that we handle retrieves of zero-length data items correctly. +# The following ops, should allow a partial data retrieve of 0-length. +# db_get +# db_cget FIRST, NEXT, LAST, PREV, CURRENT, SET, SET_RANGE +# +proc test059 { method args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test059: $method 0-length partial data retrieval" + + # Create the database and open the dictionary + 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/test059.db + set env NULL + } else { + set testfile test059.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set pflags "" + set gflags "" + set txn "" + set count 0 + + if { [is_record_based $method] == 1 } { + append gflags " -recno" + } + + puts "\tTest059.a: Populate a database" + set oflags "-create -truncate -mode 0644 $omethod $args $testfile" + set db [eval {berkdb_open} $oflags] + error_check_good db_create [is_substr $db db] 1 + + # Put ten keys in the database + for { set key 1 } { $key <= 10 } {incr key} { + set r [eval {$db put} $txn $pflags {$key datum$key}] + error_check_good put $r 0 + } + + # Retrieve keys sequentially so we can figure out their order + set i 1 + set curs [$db cursor] + error_check_good db_curs [is_substr $curs $db] 1 + + for {set d [$curs get -first] } { [llength $d] != 0 } { + set d [$curs get -next] } { + set key_set($i) [lindex [lindex $d 0] 0] + incr i + } + + puts "\tTest059.a: db get with 0 partial length retrieve" + + # Now set the cursor on the middle one. + set ret [eval {$db get -partial {0 0}} $gflags {$key_set(5)}] + error_check_bad db_get_0 [llength $ret] 0 + + puts "\tTest059.a: db cget FIRST with 0 partial length retrieve" + set ret [$curs get -first -partial {0 0}] + set data [lindex [lindex $ret 0] 1] + set key [lindex [lindex $ret 0] 0] + error_check_good key_check_first $key $key_set(1) + error_check_good db_cget_first [string length $data] 0 + + puts "\tTest059.b: db cget NEXT with 0 partial length retrieve" + set ret [$curs get -next -partial {0 0}] + set data [lindex [lindex $ret 0] 1] + set key [lindex [lindex $ret 0] 0] + error_check_good key_check_next $key $key_set(2) + error_check_good db_cget_next [string length $data] 0 + + puts "\tTest059.c: db cget LAST with 0 partial length retrieve" + set ret [$curs get -last -partial {0 0}] + set data [lindex [lindex $ret 0] 1] + set key [lindex [lindex $ret 0] 0] + error_check_good key_check_last $key $key_set(10) + error_check_good db_cget_last [string length $data] 0 + + puts "\tTest059.d: db cget PREV with 0 partial length retrieve" + set ret [$curs get -prev -partial {0 0}] + set data [lindex [lindex $ret 0] 1] + set key [lindex [lindex $ret 0] 0] + error_check_good key_check_prev $key $key_set(9) + error_check_good db_cget_prev [string length $data] 0 + + puts "\tTest059.e: db cget CURRENT with 0 partial length retrieve" + set ret [$curs get -current -partial {0 0}] + set data [lindex [lindex $ret 0] 1] + set key [lindex [lindex $ret 0] 0] + error_check_good key_check_current $key $key_set(9) + error_check_good db_cget_current [string length $data] 0 + + puts "\tTest059.f: db cget SET with 0 partial length retrieve" + set ret [$curs get -set -partial {0 0} $key_set(7)] + set data [lindex [lindex $ret 0] 1] + set key [lindex [lindex $ret 0] 0] + error_check_good key_check_set $key $key_set(7) + error_check_good db_cget_set [string length $data] 0 + + if {[is_btree $method] == 1} { + puts "\tTest059.g:\ + db cget SET_RANGE with 0 partial length retrieve" + set ret [$curs get -set_range -partial {0 0} $key_set(5)] + set data [lindex [lindex $ret 0] 1] + set key [lindex [lindex $ret 0] 0] + error_check_good key_check_set $key $key_set(5) + error_check_good db_cget_set [string length $data] 0 + } + + error_check_good curs_close [$curs close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test060.tcl b/bdb/test/test060.tcl new file mode 100644 index 00000000000..7f7cc71f00b --- /dev/null +++ b/bdb/test/test060.tcl @@ -0,0 +1,53 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test060.tcl,v 11.6 2000/08/25 14:21:57 sue Exp $ +# +# Test060: Test of the DB_EXCL flag to DB->open. +# 1) Attempt to open and create a nonexistent database; verify success. +# 2) Attempt to reopen it; verify failure. +proc test060 { method args } { + global errorCode + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test060: $method ($args) Test of the DB_EXCL flag to DB->open" + + # Set the database location and make sure the db doesn't exist yet + 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/test060.db + set env NULL + } else { + set testfile test060.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + # Create the database and check success + puts "\tTest060.a: open and close non-existent file with DB_EXCL" + set db [eval {berkdb_open \ + -create -excl -mode 0644} $args {$omethod $testfile}] + error_check_good dbopen:excl [is_valid_db $db] TRUE + + # Close it and check success + error_check_good db_close [$db close] 0 + + # Try to open it again, and make sure the open fails + puts "\tTest060.b: open it again with DB_EXCL and make sure it fails" + set errorCode NONE + error_check_good open:excl:catch [catch { \ + set db [eval {berkdb_open_noerr \ + -create -excl -mode 0644} $args {$omethod $testfile}] + } ret ] 1 + + error_check_good dbopen:excl [is_substr $errorCode EEXIST] 1 +} diff --git a/bdb/test/test061.tcl b/bdb/test/test061.tcl new file mode 100644 index 00000000000..c3187268e39 --- /dev/null +++ b/bdb/test/test061.tcl @@ -0,0 +1,215 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test061.tcl,v 11.12 2000/10/27 13:23:56 sue Exp $ +# +# Test061: Test of transaction abort and commit for in-memory databases. +# a) Put + abort: verify absence of data +# b) Put + commit: verify presence of data +# c) Overwrite + abort: verify that data is unchanged +# d) Overwrite + commit: verify that data has changed +# e) Delete + abort: verify that data is still present +# f) Delete + commit: verify that data has been deleted +proc test061 { method args } { + global alphabet + global errorCode + source ./include.tcl + + # + # If we are using an env, then skip this test. It needs its own. + set eindex [lsearch -exact $args "-env"] + if { $eindex != -1 } { + incr eindex + set env [lindex $args $eindex] + puts "Test061 skipping for env $env" + return + } + set args [convert_args $method $args] + set omethod [convert_method $method] + if { [is_queueext $method] == 1} { + puts "Test061 skipping for method $method" + return + } + + puts "Test061: Transaction abort and commit test for in-memory data." + puts "Test061: $method $args" + + set key "key" + set data "data" + set otherdata "otherdata" + set txn "" + set flags "" + set gflags "" + + if { [is_record_based $method] == 1} { + set key 1 + set gflags " -recno" + } + + puts "\tTest061: Create environment and $method database." + env_cleanup $testdir + + # create environment + set eflags "-create -txn -home $testdir" + set dbenv [eval {berkdb env} $eflags] + error_check_good dbenv [is_valid_env $dbenv] TRUE + + # db open -- no file specified, in-memory database + set flags "-create $args $omethod" + set db [eval {berkdb_open -env} $dbenv $flags] + error_check_good dbopen [is_valid_db $db] TRUE + + # Here we go with the six test cases. Since we need to verify + # a different thing each time, and since we can't just reuse + # the same data if we're to test overwrite, we just + # plow through rather than writing some impenetrable loop code; + # each of the cases is only a few lines long, anyway. + + puts "\tTest061.a: put/abort" + + # txn_begin + set txn [$dbenv txn] + error_check_good txn_begin [is_valid_txn $txn $dbenv] TRUE + + # put a key + set ret [eval {$db put} -txn $txn {$key [chop_data $method $data]}] + error_check_good db_put $ret 0 + + # check for existence + set ret [eval {$db get} -txn $txn $gflags {$key}] + error_check_good get $ret [list [list $key [pad_data $method $data]]] + + # abort + error_check_good txn_abort [$txn abort] 0 + + # check for *non*-existence + set ret [eval {$db get} $gflags {$key}] + error_check_good get $ret {} + + puts "\tTest061.b: put/commit" + + # txn_begin + set txn [$dbenv txn] + error_check_good txn_begin [is_valid_txn $txn $dbenv] TRUE + + # put a key + set ret [eval {$db put} -txn $txn {$key [chop_data $method $data]}] + error_check_good db_put $ret 0 + + # check for existence + set ret [eval {$db get} -txn $txn $gflags {$key}] + error_check_good get $ret [list [list $key [pad_data $method $data]]] + + # commit + error_check_good txn_commit [$txn commit] 0 + + # check again for existence + set ret [eval {$db get} $gflags {$key}] + error_check_good get $ret [list [list $key [pad_data $method $data]]] + + puts "\tTest061.c: overwrite/abort" + + # txn_begin + set txn [$dbenv txn] + error_check_good txn_begin [is_valid_txn $txn $dbenv] TRUE + + # overwrite {key,data} with {key,otherdata} + set ret [eval {$db put} -txn $txn {$key [chop_data $method $otherdata]}] + error_check_good db_put $ret 0 + + # check for existence + set ret [eval {$db get} -txn $txn $gflags {$key}] + error_check_good get $ret \ + [list [list $key [pad_data $method $otherdata]]] + + # abort + error_check_good txn_abort [$txn abort] 0 + + # check that data is unchanged ($data not $otherdata) + set ret [eval {$db get} $gflags {$key}] + error_check_good get $ret [list [list $key [pad_data $method $data]]] + + puts "\tTest061.d: overwrite/commit" + + # txn_begin + set txn [$dbenv txn] + error_check_good txn_begin [is_valid_txn $txn $dbenv] TRUE + + # overwrite {key,data} with {key,otherdata} + set ret [eval {$db put} -txn $txn {$key [chop_data $method $otherdata]}] + error_check_good db_put $ret 0 + + # check for existence + set ret [eval {$db get} -txn $txn $gflags {$key}] + error_check_good get $ret \ + [list [list $key [pad_data $method $otherdata]]] + + # commit + error_check_good txn_commit [$txn commit] 0 + + # check that data has changed ($otherdata not $data) + set ret [eval {$db get} $gflags {$key}] + error_check_good get $ret \ + [list [list $key [pad_data $method $otherdata]]] + + puts "\tTest061.e: delete/abort" + + # txn_begin + set txn [$dbenv txn] + error_check_good txn_begin [is_valid_txn $txn $dbenv] TRUE + + # delete + set ret [eval {$db del} -txn $txn {$key}] + error_check_good db_put $ret 0 + + # check for nonexistence + set ret [eval {$db get} -txn $txn $gflags {$key}] + error_check_good get $ret {} + + # abort + error_check_good txn_abort [$txn abort] 0 + + # check for existence + set ret [eval {$db get} $gflags {$key}] + error_check_good get $ret \ + [list [list $key [pad_data $method $otherdata]]] + + puts "\tTest061.f: delete/commit" + + # txn_begin + set txn [$dbenv txn] + error_check_good txn_begin [is_valid_txn $txn $dbenv] TRUE + + # put a key + set ret [eval {$db del} -txn $txn {$key}] + error_check_good db_put $ret 0 + + # check for nonexistence + set ret [eval {$db get} -txn $txn $gflags {$key}] + error_check_good get $ret {} + + # commit + error_check_good txn_commit [$txn commit] 0 + + # check for continued nonexistence + set ret [eval {$db get} $gflags {$key}] + error_check_good get $ret {} + + # We're done; clean up. + error_check_good db_close [eval {$db close}] 0 + error_check_good env_close [eval {$dbenv close}] 0 + + # Now run db_recover and ensure that it runs cleanly. + puts "\tTest061.g: Running db_recover -h" + set ret [catch {exec $util_path/db_recover -h $testdir} res] + if { $ret != 0 } { + puts "FAIL: db_recover outputted $res" + } + error_check_good db_recover $ret 0 + + puts "\tTest061.h: Running db_recover -c -h" + set ret [catch {exec $util_path/db_recover -c -h $testdir} res] + error_check_good db_recover-c $ret 0 +} diff --git a/bdb/test/test062.tcl b/bdb/test/test062.tcl new file mode 100644 index 00000000000..43a5e1d3939 --- /dev/null +++ b/bdb/test/test062.tcl @@ -0,0 +1,125 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test062.tcl,v 11.13 2000/12/20 19:02:36 sue Exp $ +# +# DB Test 62: Test of partial puts onto duplicate pages. +# Insert the first 200 words into the dictionary 200 times each with +# self as key and <random letter>:self as data. Use partial puts to +# append self again to data; verify correctness. +proc test062 { method {nentries 200} {ndups 200} {tnum 62} args } { + global alphabet + global rand_init + source ./include.tcl + + berkdb srand $rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + # Create the database and open the dictionary + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + puts "Test0$tnum:\ + $method ($args) Partial puts and duplicates." + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts "Test0$tnum skipping for method $omethod" + return + } + set db [eval {berkdb_open -create -truncate -mode 0644 \ + $omethod -dup} $args {$testfile} ] + error_check_good dbopen [is_valid_db $db] TRUE + set did [open $dict] + + set pflags "" + set gflags "" + set txn "" + set count 0 + + # Here is the loop where we put each key/data pair + puts "\tTest0$tnum.a: Put loop (initialize database)" + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + while { [gets $did str] != -1 && $count < $nentries } { + for { set i 1 } { $i <= $ndups } { incr i } { + set pref \ + [string index $alphabet [berkdb random_int 0 25]] + set datastr $pref:$str + set ret [eval {$db put} \ + $txn $pflags {$str [chop_data $method $datastr]}] + error_check_good put $ret 0 + } + set keys($count) $str + + incr count + } + error_check_good cursor_close [$dbc close] 0 + close $did + + puts "\tTest0$tnum.b: Partial puts." + set dbc [eval {$db cursor} $txn] + error_check_good cursor_open [is_substr $dbc $db] 1 + + # Do a partial write to extend each datum in + # the regular db by the corresponding dictionary word. + # We have to go through each key's dup set using -set + # because cursors are not stable in the hash AM and we + # want to make sure we hit all the keys. + for { set i 0 } { $i < $count } { incr i } { + set key $keys($i) + for {set ret [$dbc get -set $key]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -nextdup]} { + + set k [lindex [lindex $ret 0] 0] + set orig_d [lindex [lindex $ret 0] 1] + set d [string range $orig_d 2 end] + set doff [expr [string length $d] + 2] + set dlen 0 + error_check_good data_and_key_sanity $d $k + + set ret [$dbc get -current] + error_check_good before_sanity \ + [lindex [lindex $ret 0] 0] \ + [string range [lindex [lindex $ret 0] 1] 2 end] + + error_check_good partial_put [eval {$dbc put -current \ + -partial [list $doff $dlen] $d}] 0 + + set ret [$dbc get -current] + error_check_good partial_put_correct \ + [lindex [lindex $ret 0] 1] $orig_d$d + } + } + + puts "\tTest0$tnum.c: Double-checking get loop." + # Double-check that each datum in the regular db has + # been appropriately modified. + + for {set ret [$dbc get -first]} \ + {[llength $ret] != 0} \ + {set ret [$dbc get -next]} { + + set k [lindex [lindex $ret 0] 0] + set d [lindex [lindex $ret 0] 1] + error_check_good modification_correct \ + [string range $d 2 end] [repeat $k 2] + } + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test063.tcl b/bdb/test/test063.tcl new file mode 100644 index 00000000000..2b9c4c4c763 --- /dev/null +++ b/bdb/test/test063.tcl @@ -0,0 +1,141 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test063.tcl,v 11.11 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 63: Test that the DB_RDONLY flag is respected. +# Attempt to both DB->put and DBC->c_put into a database +# that has been opened DB_RDONLY, and check for failure. +proc test063 { method args } { + global errorCode + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + set tnum 63 + + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set key "key" + set data "data" + set key2 "another_key" + set data2 "more_data" + + set gflags "" + + if { [is_record_based $method] == 1 } { + set key "1" + set key2 "2" + append gflags " -recno" + } + + puts "Test0$tnum: $method ($args) DB_RDONLY test." + + # Create a test database. + puts "\tTest0$tnum.a: Creating test database." + set db [eval {berkdb_open_noerr -create -truncate -mode 0644} \ + $omethod $args $testfile] + error_check_good db_create [is_valid_db $db] TRUE + + # Put and get an item so it's nonempty. + set ret [eval {$db put} $key [chop_data $method $data]] + error_check_good initial_put $ret 0 + + set dbt [eval {$db get} $gflags $key] + error_check_good initial_get $dbt \ + [list [list $key [pad_data $method $data]]] + + error_check_good db_close [$db close] 0 + + if { $eindex == -1 } { + # Confirm that database is writable. If we are + # using an env (that may be remote on a server) + # we cannot do this check. + error_check_good writable [file writable $testfile] 1 + } + + puts "\tTest0$tnum.b: Re-opening DB_RDONLY and attempting to put." + + # Now open it read-only and make sure we can get but not put. + set db [eval {berkdb_open_noerr -rdonly} $args {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + set dbt [eval {$db get} $gflags $key] + error_check_good db_get $dbt \ + [list [list $key [pad_data $method $data]]] + + set ret [catch {eval {$db put} $key2 [chop_data $method $data]} res] + error_check_good put_failed $ret 1 + error_check_good db_put_rdonly [is_substr $errorCode "EACCES"] 1 + + set errorCode "NONE" + + puts "\tTest0$tnum.c: Attempting cursor put." + + set dbc [$db cursor] + error_check_good cursor_create [is_valid_cursor $dbc $db] TRUE + + error_check_good cursor_set [$dbc get -first] $dbt + set ret [catch {eval {$dbc put} -current $data} res] + error_check_good c_put_failed $ret 1 + error_check_good dbc_put_rdonly [is_substr $errorCode "EACCES"] 1 + + set dbt [eval {$db get} $gflags $key2] + error_check_good db_get_key2 $dbt "" + + puts "\tTest0$tnum.d: Attempting ordinary delete." + + set errorCode "NONE" + set ret [catch {eval {$db del} $key} 1] + error_check_good del_failed $ret 1 + error_check_good db_del_rdonly [is_substr $errorCode "EACCES"] 1 + + set dbt [eval {$db get} $gflags $key] + error_check_good db_get_key $dbt \ + [list [list $key [pad_data $method $data]]] + + puts "\tTest0$tnum.e: Attempting cursor delete." + # Just set the cursor to the beginning; we don't care what's there... + # yet. + set dbt2 [$dbc get -first] + error_check_good db_get_first_key $dbt2 $dbt + set errorCode "NONE" + set ret [catch {$dbc del} res] + error_check_good c_del_failed $ret 1 + error_check_good dbc_del_rdonly [is_substr $errorCode "EACCES"] 1 + + set dbt2 [$dbc get -current] + error_check_good db_get_key $dbt2 $dbt + + puts "\tTest0$tnum.f: Close, reopen db; verify unchanged." + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + set db [eval {berkdb_open} $omethod $args $testfile] + error_check_good db_reopen [is_valid_db $db] TRUE + + set dbc [$db cursor] + error_check_good cursor_create [is_valid_cursor $dbc $db] TRUE + + error_check_good first_there [$dbc get -first] \ + [list [list $key [pad_data $method $data]]] + error_check_good nomore_there [$dbc get -next] "" + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test064.tcl b/bdb/test/test064.tcl new file mode 100644 index 00000000000..ad39f4b2256 --- /dev/null +++ b/bdb/test/test064.tcl @@ -0,0 +1,62 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test064.tcl,v 11.8 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 64: Test of DB->get_type +# Create a database of type specified by method. +# Make sure DB->get_type returns the right thing with both a +# normal and DB_UNKNOWN open. +proc test064 { method args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + set tnum 64 + + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + puts "Test0$tnum: $method ($args) DB->get_type test." + + # Create a test database. + puts "\tTest0$tnum.a: Creating test database of type $method." + set db [eval {berkdb_open -create -truncate -mode 0644} \ + $omethod $args $testfile] + error_check_good db_create [is_valid_db $db] TRUE + + error_check_good db_close [$db close] 0 + + puts "\tTest0$tnum.b: get_type after method specifier." + + set db [eval {berkdb_open} $omethod $args {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + set type [$db get_type] + error_check_good get_type $type [string range $omethod 1 end] + + error_check_good db_close [$db close] 0 + + puts "\tTest0$tnum.c: get_type after DB_UNKNOWN." + + set db [eval {berkdb_open} $args $testfile] + error_check_good db_open [is_valid_db $db] TRUE + + set type [$db get_type] + error_check_good get_type $type [string range $omethod 1 end] + + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test065.tcl b/bdb/test/test065.tcl new file mode 100644 index 00000000000..5f236ebbd04 --- /dev/null +++ b/bdb/test/test065.tcl @@ -0,0 +1,146 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test065.tcl,v 11.8 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 65: Test of DB->stat(DB_RECORDCOUNT) +proc test065 { method args } { + source ./include.tcl + global errorCode + global alphabet + + set args [convert_args $method $args] + set omethod [convert_method $method] + set tnum 65 + + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + puts "Test0$tnum: $method ($args) DB->stat(DB_RECORDCOUNT) test." + + puts "\tTest0$tnum.a: Create database and check it while empty." + + set db [eval {berkdb_open_noerr -create -truncate -mode 0644} \ + $omethod $args $testfile] + error_check_good db_open [is_valid_db $db] TRUE + + set ret [catch {eval $db stat -recordcount} res] + + error_check_good db_close [$db close] 0 + + if { ([is_record_based $method] && ![is_queue $method]) \ + || [is_rbtree $method] } { + error_check_good recordcount_ok [lindex [lindex $res 0] 1] 0 + } else { + error_check_good \ + recordcount_notok [is_substr $errorCode "EINVAL"] 1 + puts "\tTest0$tnum: Test complete for method $method." + return + } + + # If we've got this far, we're on an access method for + # which DB_RECORDCOUNT makes sense. Thus, we no longer + # catch EINVALs, and no longer care about __db_errs. + set db [eval {berkdb_open -create -mode 0644} $omethod $args $testfile] + + puts "\tTest0$tnum.b: put 10000 keys." + + if { [is_record_based $method] } { + set gflags " -recno " + set keypfx "" + } else { + set gflags "" + set keypfx "key" + } + + set data [pad_data $method $alphabet] + + for { set ndx 1 } { $ndx <= 10000 } { incr ndx } { + set ret [eval {$db put} $keypfx$ndx $data] + error_check_good db_put $ret 0 + } + + set ret [$db stat -recordcount] + error_check_good \ + recordcount_after_puts [lindex [lindex $ret 0] 1] 10000 + + puts "\tTest0$tnum.c: delete 9000 keys." + for { set ndx 1 } { $ndx <= 9000 } { incr ndx } { + if { [is_rrecno $method] == 1 } { + # if we're renumbering, when we hit key 5001 we'll + # have deleted 5000 and we'll croak! So delete key + # 1, repeatedly. + set ret [eval {$db del} [concat $keypfx 1]] + } else { + set ret [eval {$db del} $keypfx$ndx] + } + error_check_good db_del $ret 0 + } + + set ret [$db stat -recordcount] + if { [is_rrecno $method] == 1 || [is_rbtree $method] == 1 } { + # We allow renumbering--thus the stat should return 1000 + error_check_good \ + recordcount_after_dels [lindex [lindex $ret 0] 1] 1000 + } else { + # No renumbering--no change in RECORDCOUNT! + error_check_good \ + recordcount_after_dels [lindex [lindex $ret 0] 1] 10000 + } + + puts "\tTest0$tnum.d: put 8000 new keys at the beginning." + for { set ndx 1 } { $ndx <= 8000 } {incr ndx } { + set ret [eval {$db put} $keypfx$ndx $data] + error_check_good db_put_beginning $ret 0 + } + + set ret [$db stat -recordcount] + if { [is_rrecno $method] == 1 } { + # With renumbering we're back up to 8000 + error_check_good \ + recordcount_after_dels [lindex [lindex $ret 0] 1] 8000 + } elseif { [is_rbtree $method] == 1 } { + # Total records in a btree is now 9000 + error_check_good \ + recordcount_after_dels [lindex [lindex $ret 0] 1] 9000 + } else { + # No renumbering--still no change in RECORDCOUNT. + error_check_good \ + recordcount_after_dels [lindex [lindex $ret 0] 1] 10000 + } + + puts "\tTest0$tnum.e: put 8000 new keys off the end." + for { set ndx 9001 } { $ndx <= 17000 } {incr ndx } { + set ret [eval {$db put} $keypfx$ndx $data] + error_check_good db_put_end $ret 0 + } + + set ret [$db stat -recordcount] + if { [is_rbtree $method] != 1 } { + # If this is a recno database, the record count should + # be up to 17000, the largest number we've seen, with + # or without renumbering. + error_check_good \ + recordcount_after_dels [lindex [lindex $ret 0] 1] 17000 + } else { + # In an rbtree, 1000 of those keys were overwrites, + # so there are 7000 new keys + 9000 old keys == 16000 + error_check_good \ + recordcount_after_dels [lindex [lindex $ret 0] 1] 16000 + } + + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test066.tcl b/bdb/test/test066.tcl new file mode 100644 index 00000000000..591c51a4c87 --- /dev/null +++ b/bdb/test/test066.tcl @@ -0,0 +1,73 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test066.tcl,v 11.7 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 66: Make sure a cursor put to DB_CURRENT acts as an overwrite in +# a database with duplicates +proc test066 { method args } { + set omethod [convert_method $method] + set args [convert_args $method $args] + + set tnum 66 + + if { [is_record_based $method] || [is_rbtree $method] } { + puts "Test0$tnum: Skipping for method $method." + return + } + + puts "Test0$tnum: Test of cursor put to DB_CURRENT with duplicates." + + source ./include.tcl + + 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/test066.db + set env NULL + } else { + set testfile test066.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set key "test" + set data "olddata" + + set db [eval {berkdb_open -create -mode 0644 -dup} $omethod $args \ + $testfile] + error_check_good db_open [is_valid_db $db] TRUE + + set ret [eval {$db put} $key [chop_data $method $data]] + error_check_good db_put $ret 0 + + set dbc [$db cursor] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + set ret [$dbc get -first] + error_check_good db_get $ret [list [list $key [pad_data $method $data]]] + + set newdata "newdata" + set ret [$dbc put -current [chop_data $method $newdata]] + error_check_good dbc_put $ret 0 + + # There should be only one (key,data) pair in the database, and this + # is it. + set ret [$dbc get -first] + error_check_good db_get_first $ret \ + [list [list $key [pad_data $method $newdata]]] + + # and this one should come up empty. + set ret [$dbc get -next] + error_check_good db_get_next $ret "" + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + + puts "\tTest0$tnum: Test completed successfully." +} diff --git a/bdb/test/test067.tcl b/bdb/test/test067.tcl new file mode 100644 index 00000000000..c287d7b1ec5 --- /dev/null +++ b/bdb/test/test067.tcl @@ -0,0 +1,114 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test067.tcl,v 11.12 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 67: Test of DB_CURRENT partial puts on almost-empty duplicate pages. +# This test was written to address the following issue, #2 in the list of +# issues relating to bug #0820: +# 2. DBcursor->put, DB_CURRENT flag, off-page duplicates, hash and btree: +# In Btree, the DB_CURRENT overwrite of off-page duplicate records +# first deletes the record and then puts the new one -- this could +# be a problem if the removal of the record causes a reverse split. +# Suggested solution is to acquire a cursor to lock down the current +# record, put a new record after that record, and then delete using +# the held cursor. +# It also tests the following, #5 in the same list of issues: +# 5. DBcursor->put, DB_AFTER/DB_BEFORE/DB_CURRENT flags, DB_DBT_PARTIAL set, +# duplicate comparison routine specified. +# The partial change does not change how data items sort, but the +# record to be put isn't built yet, and that record supplied is the +# one that's checked for ordering compatibility. +proc test067 { method {ndups 1000} {tnum 67} args } { + source ./include.tcl + global alphabet + global errorCode + + set args [convert_args $method $args] + set omethod [convert_method $method] + + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + + puts "Test0$tnum:\ + $method ($args) Partial puts on near-empty duplicate pages." + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts "\tTest0$tnum: skipping for method $method." + return + } + + foreach dupopt { "-dup" "-dup -dupsort" } { + cleanup $testdir $env + set db [eval {berkdb_open -create -truncate -mode 0644 \ + $omethod} $args $dupopt {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + puts "\tTest0$tnum.a ($dupopt): Put $ndups duplicates." + + set key "key_test$tnum" + + for { set ndx 0 } { $ndx < $ndups } { incr ndx } { + set data $alphabet$ndx + + # No need for pad_data since we're skipping recno. + set ret [eval {$db put} $key $data] + error_check_good put($key,$data) $ret 0 + } + + # Sync so we can inspect database if the next section bombs. + error_check_good db_sync [$db sync] 0 + puts "\tTest0$tnum.b ($dupopt):\ + Deleting dups (last first), overwriting each." + + set dbc [$db cursor] + error_check_good cursor_create [is_valid_cursor $dbc $db] TRUE + + set count 0 + while { $count < $ndups - 1 } { + # set cursor to last item in db + set ret [$dbc get -last] + error_check_good \ + verify_key [lindex [lindex $ret 0] 0] $key + + # for error reporting + set currdatum [lindex [lindex $ret 0] 1] + + # partial-overwrite it + # (overwrite offsets 1-4 with "bcde"--which they + # already are) + + # Even though we expect success, we catch this + # since it might return EINVAL, and we want that + # to FAIL. + set errorCode NONE + set ret [catch {eval $dbc put -current \ + {-partial [list 1 4]} "bcde"} \ + res] + error_check_good \ + partial_put_valid($currdatum) $errorCode NONE + error_check_good partial_put($currdatum) $res 0 + + # delete it + error_check_good dbc_del [$dbc del] 0 + + #puts $currdatum + + incr count + } + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + } +} diff --git a/bdb/test/test068.tcl b/bdb/test/test068.tcl new file mode 100644 index 00000000000..587cd207890 --- /dev/null +++ b/bdb/test/test068.tcl @@ -0,0 +1,181 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test068.tcl,v 11.11 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 68: Test of DB_BEFORE and DB_AFTER and partial puts. +# Make sure DB_BEFORE and DB_AFTER work properly with partial puts, +# and check that they return EINVAL if DB_DUPSORT is set or if DB_DUP is not. +proc test068 { method args } { + source ./include.tcl + global alphabet + global errorCode + + set tnum 68 + set nkeys 1000 + + set args [convert_args $method $args] + set omethod [convert_method $method] + + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + + puts "Test0$tnum:\ + $method ($args) Test of DB_BEFORE/DB_AFTER and partial puts." + if { [is_record_based $method] == 1 } { + puts "\tTest0$tnum: skipping for method $method." + return + } + + # Create a list of $nkeys words to insert into db. + puts "\tTest0$tnum.a: Initialize word list." + set wordlist {} + set count 0 + set did [open $dict] + while { [gets $did str] != -1 && $count < $nkeys } { + lappend wordlist $str + incr count + } + close $did + + # Sanity check: did we get $nkeys words? + error_check_good enough_keys [llength $wordlist] $nkeys + + # rbtree can't handle dups, so just test the non-dup case + # if it's the current method. + if { [is_rbtree $method] == 1 } { + set dupoptlist { "" } + } else { + set dupoptlist { "" "-dup" "-dup -dupsort" } + } + + foreach dupopt $dupoptlist { + cleanup $testdir $env + set db [eval {berkdb_open_noerr -create -truncate -mode 0644 \ + $omethod} $args $dupopt {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + puts "\tTest0$tnum.b ($dupopt): DB initialization: put loop." + foreach word $wordlist { + error_check_good db_put [$db put $word $word] 0 + } + + puts "\tTest0$tnum.c ($dupopt): get loop." + foreach word $wordlist { + # Make sure that the Nth word has been correctly + # inserted, and also that the Nth word is the + # Nth one we pull out of the database using a cursor. + + set dbt [$db get $word] + error_check_good get_key [list [list $word $word]] $dbt + } + + set dbc [$db cursor] + error_check_good cursor_open [is_valid_cursor $dbc $db] TRUE + + puts "\tTest0$tnum.d ($dupopt): DBC->put w/ DB_AFTER." + + # Set cursor to the first key; make sure it succeeds. + # With an unsorted wordlist, we can't be sure that the + # first item returned will equal the first item in the + # wordlist, so we just make sure it got something back. + set dbt [eval {$dbc get -first}] + error_check_good \ + dbc_get_first [llength $dbt] 1 + + # If -dup is not set, or if -dupsort is set too, we + # need to verify that DB_BEFORE and DB_AFTER fail + # and then move on to the next $dupopt. + if { $dupopt != "-dup" } { + set errorCode "NONE" + set ret [catch {eval $dbc put -after \ + {-partial [list 6 0]} "after"} res] + error_check_good dbc_put_after_fail $ret 1 + error_check_good dbc_put_after_einval \ + [is_substr $errorCode EINVAL] 1 + puts "\tTest0$tnum ($dupopt): DB_AFTER returns EINVAL." + set errorCode "NONE" + set ret [catch {eval $dbc put -before \ + {-partial [list 6 0]} "before"} res] + error_check_good dbc_put_before_fail $ret 1 + error_check_good dbc_put_before_einval \ + [is_substr $errorCode EINVAL] 1 + puts "\tTest0$tnum ($dupopt): DB_BEFORE returns EINVAL." + puts "\tTest0$tnum ($dupopt): Correct error returns,\ + skipping further test." + # continue with broad foreach + error_check_good db_close [$db close] 0 + continue + } + + puts "\tTest0$tnum.e ($dupopt): DBC->put(DB_AFTER) loop." + foreach word $wordlist { + # set cursor to $word + set dbt [$dbc get -set $word] + error_check_good \ + dbc_get_set $dbt [list [list $word $word]] + # put after it + set ret [$dbc put -after -partial {4 0} after] + error_check_good dbc_put_after $ret 0 + } + + puts "\tTest0$tnum.f ($dupopt): DBC->put(DB_BEFORE) loop." + foreach word $wordlist { + # set cursor to $word + set dbt [$dbc get -set $word] + error_check_good \ + dbc_get_set $dbt [list [list $word $word]] + # put before it + set ret [$dbc put -before -partial {6 0} before] + error_check_good dbc_put_before $ret 0 + } + + error_check_good dbc_close [$dbc close] 0 + + eval $db sync + puts "\tTest0$tnum.g ($dupopt): Verify correctness." + + set dbc [$db cursor] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + # loop through the whole db beginning to end, + # make sure we have, in order, {$word "\0\0\0\0\0\0before"}, + # {$word $word}, {$word "\0\0\0\0after"} for each word. + set count 0 + while { $count < $nkeys } { + # Get the first item of each set of three. + # We don't know what the word is, but set $word to + # the key and check that the data is + # "\0\0\0\0\0\0before". + set dbt [$dbc get -next] + set word [lindex [lindex $dbt 0] 0] + + error_check_good dbc_get_one $dbt \ + [list [list $word "\0\0\0\0\0\0before"]] + + set dbt [$dbc get -next] + error_check_good \ + dbc_get_two $dbt [list [list $word $word]] + + set dbt [$dbc get -next] + error_check_good dbc_get_three $dbt \ + [list [list $word "\0\0\0\0after"]] + + incr count + } + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + } +} diff --git a/bdb/test/test069.tcl b/bdb/test/test069.tcl new file mode 100644 index 00000000000..f3b839de7f9 --- /dev/null +++ b/bdb/test/test069.tcl @@ -0,0 +1,14 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test069.tcl,v 11.4 2000/02/14 03:00:21 bostic Exp $ +# +# DB Test 69: Run DB Test 67 with a small number of dups, +# to ensure that partial puts to DB_CURRENT work correctly in +# the absence of duplicate pages. + +proc test069 { method {ndups 50} {tnum 69} args } { + eval test067 $method $ndups $tnum $args +} diff --git a/bdb/test/test070.tcl b/bdb/test/test070.tcl new file mode 100644 index 00000000000..befec9ce1e9 --- /dev/null +++ b/bdb/test/test070.tcl @@ -0,0 +1,120 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test070.tcl,v 11.18 2000/12/18 20:04:47 sue Exp $ +# +# DB Test 70: Test of DB_CONSUME. +# Fork off six processes, four consumers and two producers. +# The producers will each put 20000 records into a queue; +# the consumers will each get 10000. +# Then, verify that no record was lost or retrieved twice. +proc test070 { method {nconsumers 4} {nproducers 2} \ + {nitems 1000} {mode CONSUME } {start 0} {txn -txn} {tnum 70} args } { + source ./include.tcl + global alphabet + + # + # If we are using an env, then skip this test. It needs its own. + set eindex [lsearch -exact $args "-env"] + if { $eindex != -1 } { + incr eindex + set env [lindex $args $eindex] + puts "Test0$tnum skipping for env $env" + return + } + set omethod [convert_method $method] + set args [convert_args $method $args] + + puts "Test0$tnum: $method ($args) Test of DB_$mode flag to DB->get." + puts "\tUsing $txn environment." + + error_check_good enough_consumers [expr $nconsumers > 0] 1 + error_check_good enough_producers [expr $nproducers > 0] 1 + + if { [is_queue $method] != 1 } { + puts "\tSkipping Test0$tnum for method $method." + return + } + + env_cleanup $testdir + set testfile test0$tnum.db + + # Create environment + set dbenv [eval {berkdb env -create $txn -home } $testdir] + error_check_good dbenv_create [is_valid_env $dbenv] TRUE + + # Create database + set db [eval {berkdb_open -create -mode 0644 -queue}\ + -env $dbenv $args $testfile] + error_check_good db_open [is_valid_db $db] TRUE + + if { $start != 0 } { + error_check_good set_seed [$db put $start "consumer data"] 0 + puts "\tStarting at $start." + } else { + incr start + } + + set pidlist {} + + # Divvy up the total number of records amongst the consumers and + # producers. + error_check_good cons_div_evenly [expr $nitems % $nconsumers] 0 + error_check_good prod_div_evenly [expr $nitems % $nproducers] 0 + set nperconsumer [expr $nitems / $nconsumers] + set nperproducer [expr $nitems / $nproducers] + + set consumerlog $testdir/CONSUMERLOG. + + # Fork consumer processes (we want them to be hungry) + for { set ndx 0 } { $ndx < $nconsumers } { incr ndx } { + set output $consumerlog$ndx + set p [exec $tclsh_path $test_path/wrap.tcl \ + conscript.tcl $testdir/conscript.log.consumer$ndx \ + $testdir $testfile $mode $nperconsumer $output $tnum \ + $args &] + lappend pidlist $p + } + for { set ndx 0 } { $ndx < $nproducers } { incr ndx } { + set p [exec $tclsh_path $test_path/wrap.tcl \ + conscript.tcl $testdir/conscript.log.producer$ndx \ + $testdir $testfile PRODUCE $nperproducer "" $tnum \ + $args &] + lappend pidlist $p + } + + # Wait for all children. + watch_procs 10 + + # Verify: slurp all record numbers into list, sort, and make + # sure each appears exactly once. + puts "\tTest0$tnum: Verifying results." + set reclist {} + for { set ndx 0 } { $ndx < $nconsumers } { incr ndx } { + set input $consumerlog$ndx + set iid [open $input r] + while { [gets $iid str] != -1 } { + lappend reclist $str + } + close $iid + } + set sortreclist [lsort -integer $reclist] + + set nitems [expr $start + $nitems] + for { set ndx $start } { $ndx < $nitems } { incr ndx } { + # Skip 0 if we are wrapping around + if { $ndx == 0 } { + incr ndx + incr nitems + } + # Be sure to convert ndx to a number before comparing. + error_check_good pop_num [lindex $sortreclist 0] [expr $ndx + 0] + set sortreclist [lreplace $sortreclist 0 0] + } + error_check_good list_ends_empty $sortreclist {} + error_check_good dbenv_close [$dbenv close] 0 + + puts "\tTest0$tnum completed successfully." +} diff --git a/bdb/test/test071.tcl b/bdb/test/test071.tcl new file mode 100644 index 00000000000..376c902ec4d --- /dev/null +++ b/bdb/test/test071.tcl @@ -0,0 +1,15 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test071.tcl,v 11.6 2000/12/01 04:28:36 ubell Exp $ +# +# DB Test 71: Test of DB_CONSUME. +# This is DB Test 70, with one consumer, one producers, and 10000 items. +proc test071 { method {nconsumers 1} {nproducers 1}\ + {nitems 10000} {mode CONSUME} {start 0 } {txn -txn} {tnum 71} args } { + + eval test070 $method \ + $nconsumers $nproducers $nitems $mode $start $txn $tnum $args +} diff --git a/bdb/test/test072.tcl b/bdb/test/test072.tcl new file mode 100644 index 00000000000..3ca7415a2cb --- /dev/null +++ b/bdb/test/test072.tcl @@ -0,0 +1,225 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test072.tcl,v 11.13 2000/12/11 17:24:55 sue Exp $ +# +# DB Test 72: Test of cursor stability when duplicates are moved off-page. +proc test072 { method {pagesize 512} {ndups 20} {tnum 72} args } { + source ./include.tcl + global alphabet + + set omethod [convert_method $method] + set args [convert_args $method $args] + + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + # Keys must sort $prekey < $key < $postkey. + set prekey "a key" + set key "the key" + set postkey "z key" + + # Make these distinguishable from each other and from the + # alphabets used for the $key's data. + set predatum "1234567890" + set postdatum "0987654321" + + append args " -pagesize $pagesize " + + puts -nonewline "Test0$tnum $omethod ($args): " + if { [is_record_based $method] || [is_rbtree $method] } { + puts "Skipping for method $method." + return + } else { + puts "\n Test of cursor stability when\ + duplicates are moved off-page." + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test0$tnum: skipping for specific pagesizes" + return + } + + foreach dupopt { "-dup" "-dup -dupsort" } { + set db [eval {berkdb_open -create -truncate -mode 0644} \ + $omethod $args $dupopt $testfile] + error_check_good "db open" [is_valid_db $db] TRUE + + puts \ +"\tTest0$tnum.a: ($dupopt) Set up surrounding keys and cursors." + error_check_good pre_put [$db put $prekey $predatum] 0 + error_check_good post_put [$db put $postkey $postdatum] 0 + set precursor [$db cursor] + error_check_good precursor [is_valid_cursor $precursor \ + $db] TRUE + set postcursor [$db cursor] + error_check_good postcursor [is_valid_cursor $postcursor \ + $db] TRUE + error_check_good preset [$precursor get -set $prekey] \ + [list [list $prekey $predatum]] + error_check_good postset [$postcursor get -set $postkey] \ + [list [list $postkey $postdatum]] + + puts "\tTest0$tnum.b: Put/create cursor/verify all cursor loop." + + for { set i 0 } { $i < $ndups } { incr i } { + set datum [format "%4d$alphabet" [expr $i + 1000]] + set data($i) $datum + + # Uncomment these lines to see intermediate steps. + error_check_good db_sync($i) [$db sync] 0 + error_check_good db_dump($i) \ + [catch {exec $util_path/db_dump \ + -da $testfile > TESTDIR/out.$i}] 0 + + error_check_good "db put ($i)" [$db put $key $datum] 0 + + set dbc($i) [$db cursor] + error_check_good "db cursor ($i)"\ + [is_valid_cursor $dbc($i) $db] TRUE + + error_check_good "dbc get -get_both ($i)"\ + [$dbc($i) get -get_both $key $datum]\ + [list [list $key $datum]] + + for { set j 0 } { $j < $i } { incr j } { + set dbt [$dbc($j) get -current] + set k [lindex [lindex $dbt 0] 0] + set d [lindex [lindex $dbt 0] 1] + + #puts "cursor $j after $i: $d" + + eval {$db sync} + + error_check_good\ + "cursor $j key correctness after $i puts" \ + $k $key + error_check_good\ + "cursor $j data correctness after $i puts" \ + $d $data($j) + } + + # Check correctness of pre- and post- cursors. Do an + # error_check_good on the lengths first so that we don't + # spew garbage as the "got" field and screw up our + # terminal. (It's happened here.) + set pre_dbt [$precursor get -current] + set post_dbt [$postcursor get -current] + error_check_good \ + "key earlier cursor correctness after $i puts" \ + [string length [lindex [lindex $pre_dbt 0] 0]] \ + [string length $prekey] + error_check_good \ + "data earlier cursor correctness after $i puts" \ + [string length [lindex [lindex $pre_dbt 0] 1]] \ + [string length $predatum] + error_check_good \ + "key later cursor correctness after $i puts" \ + [string length [lindex [lindex $post_dbt 0] 0]] \ + [string length $postkey] + error_check_good \ + "data later cursor correctness after $i puts" \ + [string length [lindex [lindex $post_dbt 0] 1]]\ + [string length $postdatum] + + + error_check_good \ + "earlier cursor correctness after $i puts" \ + $pre_dbt [list [list $prekey $predatum]] + error_check_good \ + "later cursor correctness after $i puts" \ + $post_dbt [list [list $postkey $postdatum]] + } + + puts "\tTest0$tnum.c: Reverse Put/create cursor/verify all cursor loop." + set end [expr $ndups * 2 - 1] + for { set i $end } { $i > $ndups } { set i [expr $i - 1] } { + set datum [format "%4d$alphabet" [expr $i + 1000]] + set data($i) $datum + + # Uncomment these lines to see intermediate steps. + error_check_good db_sync($i) [$db sync] 0 + error_check_good db_dump($i) \ + [catch {exec $util_path/db_dump \ + -da $testfile > TESTDIR/out.$i}] 0 + + error_check_good "db put ($i)" [$db put $key $datum] 0 + + set dbc($i) [$db cursor] + error_check_good "db cursor ($i)"\ + [is_valid_cursor $dbc($i) $db] TRUE + + error_check_good "dbc get -get_both ($i)"\ + [$dbc($i) get -get_both $key $datum]\ + [list [list $key $datum]] + + for { set j $i } { $j < $end } { incr j } { + set dbt [$dbc($j) get -current] + set k [lindex [lindex $dbt 0] 0] + set d [lindex [lindex $dbt 0] 1] + + #puts "cursor $j after $i: $d" + + eval {$db sync} + + error_check_good\ + "cursor $j key correctness after $i puts" \ + $k $key + error_check_good\ + "cursor $j data correctness after $i puts" \ + $d $data($j) + } + + # Check correctness of pre- and post- cursors. Do an + # error_check_good on the lengths first so that we don't + # spew garbage as the "got" field and screw up our + # terminal. (It's happened here.) + set pre_dbt [$precursor get -current] + set post_dbt [$postcursor get -current] + error_check_good \ + "key earlier cursor correctness after $i puts" \ + [string length [lindex [lindex $pre_dbt 0] 0]] \ + [string length $prekey] + error_check_good \ + "data earlier cursor correctness after $i puts" \ + [string length [lindex [lindex $pre_dbt 0] 1]] \ + [string length $predatum] + error_check_good \ + "key later cursor correctness after $i puts" \ + [string length [lindex [lindex $post_dbt 0] 0]] \ + [string length $postkey] + error_check_good \ + "data later cursor correctness after $i puts" \ + [string length [lindex [lindex $post_dbt 0] 1]]\ + [string length $postdatum] + + + error_check_good \ + "earlier cursor correctness after $i puts" \ + $pre_dbt [list [list $prekey $predatum]] + error_check_good \ + "later cursor correctness after $i puts" \ + $post_dbt [list [list $postkey $postdatum]] + } + + # Close cursors. + puts "\tTest0$tnum.d: Closing cursors." + for { set i 0 } { $i < $ndups } { incr i } { + error_check_good "dbc close ($i)" [$dbc($i) close] 0 + } + error_check_good "db close" [$db close] 0 + } +} diff --git a/bdb/test/test073.tcl b/bdb/test/test073.tcl new file mode 100644 index 00000000000..12a48b0e412 --- /dev/null +++ b/bdb/test/test073.tcl @@ -0,0 +1,265 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test073.tcl,v 11.17 2000/12/11 17:24:55 sue Exp $ +# +# DB Test 73: Test of cursor stability on duplicate pages. +# Does the following: +# a. Initialize things by DB->putting ndups dups and +# setting a reference cursor to point to each. +# b. c_put ndups dups (and correspondingly expanding +# the set of reference cursors) after the last one, making sure +# after each step that all the reference cursors still point to +# the right item. +# c. Ditto, but before the first one. +# d. Ditto, but after each one in sequence first to last. +# e. Ditto, but after each one in sequence from last to first. +# occur relative to the new datum) +# f. Ditto for the two sequence tests, only doing a +# DBC->c_put(DB_CURRENT) of a larger datum instead of adding a +# new one. +proc test073 { method {pagesize 512} {ndups 50} {tnum 73} args } { + source ./include.tcl + global alphabet + + set omethod [convert_method $method] + set args [convert_args $method $args] + + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set key "the key" + + + puts -nonewline "Test0$tnum $omethod ($args): " + if { [is_record_based $method] || [is_rbtree $method] } { + puts "Skipping for method $method." + return + } else { + puts "cursor stability on duplicate pages." + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test073: skipping for specific pagesizes" + return + } + + append args " -pagesize $pagesize -dup" + + set db [eval {berkdb_open \ + -create -truncate -mode 0644} $omethod $args $testfile] + error_check_good "db open" [is_valid_db $db] TRUE + + # Number of outstanding keys. + set keys 0 + + puts "\tTest0$tnum.a.1: Initializing put loop; $ndups dups, short data." + + for { set i 0 } { $i < $ndups } { incr i } { + set datum [makedatum_t73 $i 0] + + error_check_good "db put ($i)" [$db put $key $datum] 0 + + set is_long($i) 0 + incr keys + } + + puts "\tTest0$tnum.a.2: Initializing cursor get loop; $keys dups." + for { set i 0 } { $i < $keys } { incr i } { + set datum [makedatum_t73 $i 0] + + set dbc($i) [$db cursor] + error_check_good "db cursor ($i)"\ + [is_valid_cursor $dbc($i) $db] TRUE + error_check_good "dbc get -get_both ($i)"\ + [$dbc($i) get -get_both $key $datum]\ + [list [list $key $datum]] + } + + puts "\tTest0$tnum.b: Cursor put (DB_KEYLAST); $ndups new dups,\ + short data." + + for { set i 0 } { $i < $ndups } { incr i } { + # !!! keys contains the number of the next dup + # to be added (since they start from zero) + + set datum [makedatum_t73 $keys 0] + set curs [$db cursor] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + error_check_good "c_put(DB_KEYLAST, $keys)"\ + [$curs put -keylast $key $datum] 0 + + set dbc($keys) $curs + set is_long($keys) 0 + incr keys + + verify_t73 is_long dbc $keys $key + } + + puts "\tTest0$tnum.c: Cursor put (DB_KEYFIRST); $ndups new dups,\ + short data." + + for { set i 0 } { $i < $ndups } { incr i } { + # !!! keys contains the number of the next dup + # to be added (since they start from zero) + + set datum [makedatum_t73 $keys 0] + set curs [$db cursor] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + error_check_good "c_put(DB_KEYFIRST, $keys)"\ + [$curs put -keyfirst $key $datum] 0 + + set dbc($keys) $curs + set is_long($keys) 0 + incr keys + + verify_t73 is_long dbc $keys $key + } + + puts "\tTest0$tnum.d: Cursor put (DB_AFTER) first to last;\ + $keys new dups, short data" + # We want to add a datum after each key from 0 to the current + # value of $keys, which we thus need to save. + set keysnow $keys + for { set i 0 } { $i < $keysnow } { incr i } { + set datum [makedatum_t73 $keys 0] + set curs [$db cursor] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + + # Which datum to insert this guy after. + set curdatum [makedatum_t73 $i 0] + error_check_good "c_get(DB_GET_BOTH, $i)"\ + [$curs get -get_both $key $curdatum]\ + [list [list $key $curdatum]] + error_check_good "c_put(DB_AFTER, $i)"\ + [$curs put -after $datum] 0 + + set dbc($keys) $curs + set is_long($keys) 0 + incr keys + + verify_t73 is_long dbc $keys $key + } + + puts "\tTest0$tnum.e: Cursor put (DB_BEFORE) last to first;\ + $keys new dups, short data" + + for { set i [expr $keys - 1] } { $i >= 0 } { incr i -1 } { + set datum [makedatum_t73 $keys 0] + set curs [$db cursor] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + + # Which datum to insert this guy before. + set curdatum [makedatum_t73 $i 0] + error_check_good "c_get(DB_GET_BOTH, $i)"\ + [$curs get -get_both $key $curdatum]\ + [list [list $key $curdatum]] + error_check_good "c_put(DB_BEFORE, $i)"\ + [$curs put -before $datum] 0 + + set dbc($keys) $curs + set is_long($keys) 0 + incr keys + + if { $i % 10 == 1 } { + verify_t73 is_long dbc $keys $key + } + } + verify_t73 is_long dbc $keys $key + + puts "\tTest0$tnum.f: Cursor put (DB_CURRENT), first to last,\ + growing $keys data." + set keysnow $keys + for { set i 0 } { $i < $keysnow } { incr i } { + set olddatum [makedatum_t73 $i 0] + set newdatum [makedatum_t73 $i 1] + set curs [$db cursor] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + + error_check_good "c_get(DB_GET_BOTH, $i)"\ + [$curs get -get_both $key $olddatum]\ + [list [list $key $olddatum]] + error_check_good "c_put(DB_CURRENT, $i)"\ + [$curs put -current $newdatum] 0 + + error_check_good "cursor close" [$curs close] 0 + + set is_long($i) 1 + + if { $i % 10 == 1 } { + verify_t73 is_long dbc $keys $key + } + } + verify_t73 is_long dbc $keys $key + + # Close cursors. + puts "\tTest0$tnum.g: Closing cursors." + for { set i 0 } { $i < $keys } { incr i } { + error_check_good "dbc close ($i)" [$dbc($i) close] 0 + } + error_check_good "db close" [$db close] 0 +} + +# !!!: This procedure is also used by test087. +proc makedatum_t73 { num is_long } { + global alphabet + if { $is_long == 1 } { + set a $alphabet$alphabet$alphabet + } else { + set a abcdefghijklm + } + + # format won't do leading zeros, alas. + if { $num / 1000 > 0 } { + set i $num + } elseif { $num / 100 > 0 } { + set i 0$num + } elseif { $num / 10 > 0 } { + set i 00$num + } else { + set i 000$num + } + + return $i$a +} + +# !!!: This procedure is also used by test087. +proc verify_t73 { is_long_array curs_array numkeys key } { + upvar $is_long_array is_long + upvar $curs_array dbc + upvar db db + + #useful for debugging, perhaps. + eval $db sync + + for { set j 0 } { $j < $numkeys } { incr j } { + set dbt [$dbc($j) get -current] + set k [lindex [lindex $dbt 0] 0] + set d [lindex [lindex $dbt 0] 1] + + error_check_good\ + "cursor $j key correctness (with $numkeys total items)"\ + $k $key + error_check_good\ + "cursor $j data correctness (with $numkeys total items)"\ + $d [makedatum_t73 $j $is_long($j)] + } +} diff --git a/bdb/test/test074.tcl b/bdb/test/test074.tcl new file mode 100644 index 00000000000..ddc5f16429d --- /dev/null +++ b/bdb/test/test074.tcl @@ -0,0 +1,221 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test074.tcl,v 11.10 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 74: Test of DB_NEXT_NODUP. +proc test074 { method {dir -nextnodup} {pagesize 512} {nitems 100} {tnum 74} args } { + source ./include.tcl + global alphabet + global rand_init + + set omethod [convert_method $method] + set args [convert_args $method $args] + + berkdb srand $rand_init + + # Data prefix--big enough that we get a mix of on-page, off-page, + # and multi-off-page dups with the default nitems + if { [is_fixed_length $method] == 1 } { + set globaldata "somedata" + } else { + set globaldata [repeat $alphabet 4] + } + + puts "Test0$tnum $omethod ($args): Test of $dir" + + # First, test non-dup (and not-very-interesting) case with + # all db types. + + puts "\tTest0$tnum.a: No duplicates." + + 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/test0$tnum-nodup.db + set env NULL + } else { + set testfile test0$tnum-nodup.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + set db [eval {berkdb_open -create -truncate -mode 0644} $omethod\ + $args {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + # Insert nitems items. + puts "\t\tTest0$tnum.a.1: Put loop." + for {set i 1} {$i <= $nitems} {incr i} { + # + # If record based, set key to $i * 2 to leave + # holes/unused entries for further testing. + # + if {[is_record_based $method] == 1} { + set key [expr $i * 2] + } else { + set key "key$i" + } + set data "$globaldata$i" + error_check_good put($i) [$db put $key\ + [chop_data $method $data]] 0 + } + + puts "\t\tTest0$tnum.a.2: Get($dir)" + + # foundarray($i) is set when key number i is found in the database + set dbc [$db cursor] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + # Initialize foundarray($i) to zero for all $i + for {set i 1} {$i < $nitems} {incr i} { + set foundarray($i) 0 + } + + # Walk database using $dir and record each key gotten. + for {set i 1} {$i <= $nitems} {incr i} { + set dbt [$dbc get $dir] + set key [lindex [lindex $dbt 0] 0] + if {[is_record_based $method] == 1} { + set num [expr $key / 2] + set desired_key $key + error_check_good $method:num $key [expr $num * 2] + } else { + set num [string range $key 3 end] + set desired_key key$num + } + + error_check_good dbt_correct($i) $dbt\ + [list [list $desired_key\ + [pad_data $method $globaldata$num]]] + + set foundarray($num) 1 + } + + puts "\t\tTest0$tnum.a.3: Final key." + error_check_good last_db_get [$dbc get $dir] [list] + + puts "\t\tTest0$tnum.a.4: Verify loop." + for { set i 1 } { $i <= $nitems } { incr i } { + error_check_good found_key($i) $foundarray($i) 1 + } + + error_check_good dbc_close(nodup) [$dbc close] 0 + + # If we are a method that doesn't allow dups, verify that + # we get an empty list if we try to use DB_NEXT_DUP + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts "\t\tTest0$tnum.a.5: Check DB_NEXT_DUP for $method." + set dbc [$db cursor] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + set dbt [$dbc get $dir] + error_check_good $method:nextdup [$dbc get -nextdup] [list] + error_check_good dbc_close(nextdup) [$dbc close] 0 + } + error_check_good db_close(nodup) [$db close] 0 + + # Quit here if we're a method that won't allow dups. + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts "\tTest0$tnum: Skipping remainder for method $method." + return + } + + foreach opt { "-dup" "-dupsort" } { + + # + # 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/test0$tnum$opt.db + } else { + set testfile test0$tnum$opt.db + } + + if { [string compare $opt "-dupsort"] == 0 } { + set opt "-dup -dupsort" + } + + puts "\tTest0$tnum.b: Duplicates ($opt)." + + puts "\t\tTest0$tnum.b.1 ($opt): Put loop." + set db [eval {berkdb_open -create -truncate -mode 0644}\ + $opt $omethod $args {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + # Insert nitems different keys such that key i has i dups. + for {set i 1} {$i <= $nitems} {incr i} { + set key key$i + + for {set j 1} {$j <= $i} {incr j} { + if { $j < 10 } { + set data "${globaldata}00$j" + } elseif { $j < 100 } { + set data "${globaldata}0$j" + } else { + set data "$globaldata$j" + } + + error_check_good put($i,$j) \ + [$db put $key $data] 0 + } + } + + # Initialize foundarray($i) to 0 for all i. + unset foundarray + for { set i 1 } { $i <= $nitems } { incr i } { + set foundarray($i) 0 + } + + # Get loop--after each get, move forward a random increment + # within the duplicate set. + puts "\t\tTest0$tnum.b.2 ($opt): Get loop." + set one "001" + set dbc [$db cursor] + error_check_good dbc($opt) [is_valid_cursor $dbc $db] TRUE + for { set i 1 } { $i <= $nitems } { incr i } { + set dbt [$dbc get $dir] + set key [lindex [lindex $dbt 0] 0] + set num [string range $key 3 end] + + set desired_key key$num + if { [string compare $dir "-prevnodup"] == 0 } { + if { $num < 10 } { + set one "00$num" + } elseif { $num < 100 } { + set one "0$num" + } else { + set one $num + } + } + + error_check_good dbt_correct($i) $dbt\ + [list [list $desired_key\ + "$globaldata$one"]] + + set foundarray($num) 1 + + # Go forward by some number w/i dup set. + set inc [berkdb random_int 0 [expr $num - 1]] + for { set j 0 } { $j < $inc } { incr j } { + eval {$dbc get -nextdup} + } + } + + puts "\t\tTest0$tnum.b.3 ($opt): Final key." + error_check_good last_db_get($opt) [$dbc get $dir] [list] + + # Verify + puts "\t\tTest0$tnum.b.4 ($opt): Verify loop." + for { set i 1 } { $i <= $nitems } { incr i } { + error_check_good found_key($i) $foundarray($i) 1 + } + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 + } +} diff --git a/bdb/test/test075.tcl b/bdb/test/test075.tcl new file mode 100644 index 00000000000..2aa0e1e2501 --- /dev/null +++ b/bdb/test/test075.tcl @@ -0,0 +1,195 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test075.tcl,v 11.9 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 75 (replacement) +# Test the DB->rename method. +proc test075 { method { tnum 75 } args } { + global errorCode + source ./include.tcl + set omethod [convert_method $method] + set args [convert_args $method $args] + + puts "Test0$tnum: $method ($args): Test of DB->rename()" + + # If we are using an env, then testfile should just be the db name. + # Otherwise it is the test directory and the name. + set eindex [lsearch -exact $args "-env"] + if { $eindex == -1 } { + set oldfile $testdir/test0$tnum-old.db + set newfile $testdir/test0$tnum.db + set env NULL + set renargs "" + } else { + set oldfile test0$tnum-old.db + set newfile test0$tnum.db + # File existence checks won't work in an env, since $oldfile + # and $newfile won't be in the current working directory. + # We use this to skip them, and turn our secondary check + # (opening the dbs and seeing that all is well) into the main + # one. + incr eindex + set env [lindex $args $eindex] + set renargs " -env $env" + } + + # Make sure we're starting from a clean slate. + cleanup $testdir $env + if { $env == "NULL" } { + error_check_bad "$oldfile exists" [file exists $oldfile] 1 + error_check_bad "$newfile exists" [file exists $newfile] 1 + } + + puts "\tTest0$tnum.a: Create/rename file" + puts "\t\tTest0$tnum.a.1: create" + set db [eval {berkdb_open -create -mode 0644} $omethod $args $oldfile] + error_check_good dbopen [is_valid_db $db] TRUE + + if { $env == "NULL" } { + error_check_bad "$oldfile exists" [file exists $oldfile] 0 + error_check_bad "$newfile exists" [file exists $newfile] 1 + } + + # The nature of the key and data are unimportant; use numeric key + # so record-based methods don't need special treatment. + set key 1 + set data [pad_data $method data] + + error_check_good dbput [$db put $key $data] 0 + error_check_good dbclose [$db close] 0 + + puts "\t\tTest0$tnum.a.2: rename" + if { $env == "NULL" } { + error_check_bad "$oldfile exists" [file exists $oldfile] 0 + error_check_bad "$newfile exists" [file exists $newfile] 1 + } + error_check_good rename_file [eval {berkdb dbrename}\ + $renargs $oldfile $newfile] 0 + if { $env == "NULL" } { + error_check_bad "$oldfile exists" [file exists $oldfile] 1 + error_check_bad "$newfile exists" [file exists $newfile] 0 + } + + puts "\t\tTest0$tnum.a.3: check" + # Open again with create to make sure we're not caching or anything + # silly. In the normal case (no env), we already know the file doesn't + # exist. + set odb [eval {berkdb_open -create -mode 0644} $omethod $args $oldfile] + set ndb [eval {berkdb_open -create -mode 0644} $omethod $args $newfile] + error_check_good odb_open [is_valid_db $odb] TRUE + error_check_good ndb_open [is_valid_db $ndb] TRUE + + set odbt [$odb get $key] + set ndbt [$ndb get $key] + + # The DBT from the "old" database should be empty, not the "new" one. + error_check_good odbt_empty [llength $odbt] 0 + error_check_bad ndbt_empty [llength $ndbt] 0 + + error_check_good ndbt [lindex [lindex $ndbt 0] 1] $data + + error_check_good odb_close [$odb close] 0 + error_check_good ndb_close [$ndb close] 0 + + if { $env != "NULL" } { + puts "\tTest0$tnum: External environment present; \ + skipping remainder" + return + } + + # Now there's both an old and a new. Rename the "new" to the "old" + # and make sure that fails. + # + # XXX Ideally we'd do this test even when there's an external + # environment, but that env has errpfx/errfile set now. :-( + puts "\tTest0$tnum.b: Make sure rename fails instead of overwriting" + set ret [catch {eval {berkdb dbrename} $renargs $newfile $oldfile} res] + error_check_bad rename_overwrite $ret 0 + error_check_good rename_overwrite_ret [is_substr $errorCode EEXIST] 1 + + # Verify and then start over from a clean slate. + verify_dir $testdir "\tTest0$tnum.c: " + cleanup $testdir $env + error_check_bad "$oldfile exists" [file exists $oldfile] 1 + error_check_bad "$newfile exists" [file exists $newfile] 1 + + set oldfile test0$tnum-old.db + set newfile test0$tnum.db + + puts "\tTest0$tnum.d: Create/rename file in environment" + + set env [berkdb env -create -home $testdir] + error_check_good env_open [is_valid_env $env] TRUE + error_check_bad "$oldfile exists" [file exists $oldfile] 1 + error_check_bad "$newfile exists" [file exists $newfile] 1 + + puts "\t\tTest0$tnum.d.1: create" + set db [eval {berkdb_open -create -mode 0644} -env $env\ + $omethod $args $oldfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # We need to make sure that it didn't create/rename into the + # current directory. + error_check_bad "$oldfile exists" [file exists $oldfile] 1 + error_check_bad "$newfile exists" [file exists $newfile] 1 + error_check_bad "$testdir/$oldfile exists"\ + [file exists $testdir/$oldfile] 0 + error_check_bad "$testdir/$newfile exists"\ + [file exists $testdir/$newfile] 1 + + error_check_good dbput [$db put $key $data] 0 + error_check_good dbclose [$db close] 0 + + puts "\t\tTest0$tnum.d.2: rename" + + error_check_good rename_file [berkdb dbrename -env $env\ + $oldfile $newfile] 0 + error_check_bad "$oldfile exists" [file exists $oldfile] 1 + error_check_bad "$newfile exists" [file exists $newfile] 1 + error_check_bad "$testdir/$oldfile exists"\ + [file exists $testdir/$oldfile] 1 + error_check_bad "$testdir/$newfile exists"\ + [file exists $testdir/$newfile] 0 + + puts "\t\tTest0$tnum.d.3: check" + # Open again with create to make sure we're not caching or anything + # silly. + set odb [eval {berkdb_open -create -mode 0644} -env $env\ + $omethod $args $oldfile] + set ndb [eval {berkdb_open -create -mode 0644} -env $env\ + $omethod $args $newfile] + error_check_good odb_open [is_valid_db $odb] TRUE + error_check_good ndb_open [is_valid_db $ndb] TRUE + + set odbt [$odb get $key] + set ndbt [$ndb get $key] + + # The DBT from the "old" database should be empty, not the "new" one. + error_check_good odbt_empty [llength $odbt] 0 + error_check_bad ndbt_empty [llength $ndbt] 0 + + error_check_good ndbt [lindex [lindex $ndbt 0] 1] $data + + error_check_good odb_close [$odb close] 0 + error_check_good ndb_close [$ndb close] 0 + + # XXX + # We need to close and reopen the env since berkdb_open has + # set its errfile/errpfx, and we can't unset that. + error_check_good env_close [$env close] 0 + set env [berkdb env -home $testdir] + error_check_good env_open2 [is_valid_env $env] TRUE + + puts "\tTest0$tnum.e:\ + Make sure rename fails instead of overwriting in env" + set ret [catch {eval {berkdb dbrename} -env $env $newfile $oldfile} res] + error_check_bad rename_overwrite $ret 0 + error_check_good rename_overwrite_ret [is_substr $errorCode EEXIST] 1 + + error_check_good env_close [$env close] 0 + + puts "\tTest0$tnum succeeded." +} diff --git a/bdb/test/test076.tcl b/bdb/test/test076.tcl new file mode 100644 index 00000000000..13a919011e4 --- /dev/null +++ b/bdb/test/test076.tcl @@ -0,0 +1,59 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test076.tcl,v 1.7 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 76: Test creation of many small databases in an env +proc test076 { method { ndbs 1000 } { tnum 76 } args } { + source ./include.tcl + + set omethod [convert_method $method] + set args [convert_args $method $args] + + + if { [is_record_based $method] == 1 } { + set key "" + } else { + set key "key" + } + set data "datamoredatamoredata" + + puts -nonewline "Test0$tnum $method ($args): " + puts -nonewline "Create $ndbs" + puts " small databases in one env." + + # Create an env if we weren't passed one. + set eindex [lsearch -exact $args "-env"] + if { $eindex == -1 } { + set deleteenv 1 + set env [eval {berkdb env -create -home} $testdir \ + {-cachesize {0 102400 1}}] + error_check_good env [is_valid_env $env] TRUE + set args "$args -env $env" + } else { + set deleteenv 0 + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + for { set i 1 } { $i <= $ndbs } { incr i } { + set testfile test0$tnum.$i.db + + set db [eval {berkdb_open -create -truncate -mode 0644}\ + $args $omethod $testfile] + error_check_good db_open($i) [is_valid_db $db] TRUE + + error_check_good db_put($i) [$db put $key$i \ + [chop_data $method $data$i]] 0 + error_check_good db_close($i) [$db close] 0 + } + + if { $deleteenv == 1 } { + error_check_good env_close [$env close] 0 + } + + puts "\tTest0$tnum passed." +} diff --git a/bdb/test/test077.tcl b/bdb/test/test077.tcl new file mode 100644 index 00000000000..47248a309b8 --- /dev/null +++ b/bdb/test/test077.tcl @@ -0,0 +1,68 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test077.tcl,v 1.4 2000/08/25 14:21:58 sue Exp $ +# +# DB Test 77: Test of DB_GET_RECNO [#1206]. +proc test077 { method { nkeys 1000 } { pagesize 512 } { tnum 77 } args } { + source ./include.tcl + global alphabet + + set omethod [convert_method $method] + set args [convert_args $method $args] + + puts "Test0$tnum: Test of DB_GET_RECNO." + + if { [is_rbtree $method] != 1 } { + puts "\tTest0$tnum: Skipping for method $method." + return + } + + set data $alphabet + + set eindex [lsearch -exact $args "-env"] + if { $eindex == -1 } { + set testfile $testdir/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + set db [eval {berkdb_open -create -truncate -mode 0644\ + -pagesize $pagesize} $omethod $args {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + puts "\tTest0$tnum.a: Populating database." + + for { set i 1 } { $i <= $nkeys } { incr i } { + set key [format %5d $i] + error_check_good db_put($key) [$db put $key $data] 0 + } + + puts "\tTest0$tnum.b: Verifying record numbers." + + set dbc [$db cursor] + error_check_good dbc_open [is_valid_cursor $dbc $db] TRUE + + set i 1 + for { set dbt [$dbc get -first] } \ + { [string length $dbt] != 0 } \ + { set dbt [$dbc get -next] } { + set recno [$dbc get -get_recno] + set keynum [expr [lindex [lindex $dbt 0] 0]] + + # Verify that i, the number that is the key, and recno + # are all equal. + error_check_good key($i) $keynum $i + error_check_good recno($i) $recno $i + incr i + } + + error_check_good dbc_close [$dbc close] 0 + error_check_good db_close [$db close] 0 +} diff --git a/bdb/test/test078.tcl b/bdb/test/test078.tcl new file mode 100644 index 00000000000..9642096faf9 --- /dev/null +++ b/bdb/test/test078.tcl @@ -0,0 +1,90 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test078.tcl,v 1.9 2000/12/11 17:24:55 sue Exp $ +# +# DB Test 78: Test of DBC->c_count(). [#303] +proc test078 { method { nkeys 100 } { pagesize 512 } { tnum 78 } args } { + source ./include.tcl + global alphabet rand_init + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test0$tnum: Test of key counts." + + berkdb srand $rand_init + + set eindex [lsearch -exact $args "-env"] + if { $eindex == -1 } { + set testfile $testdir/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + cleanup $testdir $env + + puts "\tTest0$tnum.a: No duplicates, trivial answer." + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test078: skipping for specific pagesizes" + return + } + + set db [eval {berkdb_open -create -truncate -mode 0644\ + -pagesize $pagesize} $omethod $args {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + for { set i 1 } { $i <= $nkeys } { incr i } { + error_check_good put.a($i) [$db put $i\ + [pad_data $method $alphabet$i]] 0 + error_check_good count.a [$db count $i] 1 + } + error_check_good db_close.a [$db close] 0 + + if { [is_record_based $method] == 1 || [is_rbtree $method] == 1 } { + puts \ + "\tTest0$tnum.b: Duplicates not supported in $method, skipping." + return + } + + foreach tuple {{b sorted "-dup -dupsort"} {c unsorted "-dup"}} { + set letter [lindex $tuple 0] + set dupopt [lindex $tuple 2] + + puts "\tTest0$tnum.$letter: Duplicates ([lindex $tuple 1])." + + puts "\t\tTest0$tnum.$letter.1: Populating database." + + set db [eval {berkdb_open -create -truncate -mode 0644\ + -pagesize $pagesize} $dupopt $omethod $args {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + + for { set i 1 } { $i <= $nkeys } { incr i } { + for { set j 0 } { $j < $i } { incr j } { + error_check_good put.$letter,$i [$db put $i\ + [pad_data $method $j$alphabet]] 0 + } + } + + puts -nonewline "\t\tTest0$tnum.$letter.2: " + puts "Verifying dup counts on first dup." + for { set i 1 } { $i < $nkeys } { incr i } { + error_check_good count.$letter,$i \ + [$db count $i] $i + } + + puts -nonewline "\t\tTest0$tnum.$letter.3: " + puts "Verifying dup counts on random dup." + for { set i 1 } { $i < $nkeys } { incr i } { + set key [berkdb random_int 1 $nkeys] + error_check_good count.$letter,$i \ + [$db count $i] $i + } + error_check_good db_close.$letter [$db close] 0 + } +} diff --git a/bdb/test/test079.tcl b/bdb/test/test079.tcl new file mode 100644 index 00000000000..fe7b978a3dd --- /dev/null +++ b/bdb/test/test079.tcl @@ -0,0 +1,18 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test079.tcl,v 11.5 2000/11/16 23:56:18 ubell Exp $ +# +# DB Test 79 {access method} +# Check that delete operations work in large btrees. 10000 entries and +# a pagesize of 512 push this out to a four-level btree, with a small fraction +# of the entries going on overflow pages. +proc test079 { method {nentries 10000} {pagesize 512} {tnum 79} args} { + if { [ is_queueext $method ] == 1 } { + set method "queue"; + lappend args "-extent" "20" + } + eval {test006 $method $nentries 1 $tnum -pagesize $pagesize} $args +} diff --git a/bdb/test/test080.tcl b/bdb/test/test080.tcl new file mode 100644 index 00000000000..02a6a7242cd --- /dev/null +++ b/bdb/test/test080.tcl @@ -0,0 +1,41 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test080.tcl,v 11.7 2000/10/19 23:15:22 ubell Exp $ +# +# DB Test 80 {access method} +# Test of dbremove +proc test080 { method {tnum 80} args } { + source ./include.tcl + + set args [convert_args $method $args] + set omethod [convert_method $method] + + puts "Test0$tnum: Test of DB->remove()" + + + set eindex [lsearch -exact $args "-env"] + if { $eindex != -1 } { + puts "\tTest0$tnum: Skipping in the presence of an environment" + return + } + cleanup $testdir NULL + + set testfile $testdir/test0$tnum.db + set db [eval {berkdb_open -create -truncate -mode 0644} $omethod \ + $args {$testfile}] + error_check_good db_open [is_valid_db $db] TRUE + for {set i 1} { $i < 1000 } {incr i} { + $db put $i $i + } + error_check_good db_close [$db close] 0 + + error_check_good file_exists_before [file exists $testfile] 1 + + error_check_good db_remove [berkdb dbremove $testfile] 0 + error_check_good file_exists_after [file exists $testfile] 0 + + puts "\tTest0$tnum succeeded." +} diff --git a/bdb/test/test081.tcl b/bdb/test/test081.tcl new file mode 100644 index 00000000000..44e708c5d49 --- /dev/null +++ b/bdb/test/test081.tcl @@ -0,0 +1,16 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test081.tcl,v 11.3 2000/03/01 15:13:59 krinsky Exp $ +# +# Test 81. +# Test off-page duplicates and overflow pages together with +# very large keys (key/data as file contents). +# +proc test081 { method {ndups 13} {tnum 81} args} { + source ./include.tcl + + eval {test017 $method 1 $ndups $tnum} $args +} diff --git a/bdb/test/test082.tcl b/bdb/test/test082.tcl new file mode 100644 index 00000000000..e8bd4f975dd --- /dev/null +++ b/bdb/test/test082.tcl @@ -0,0 +1,15 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test082.tcl,v 11.1 2000/04/30 05:05:26 krinsky Exp $ +# +# Test 82. +# Test of DB_PREV_NODUP +proc test082 { method {dir -prevnodup} {pagesize 512} {nitems 100}\ + {tnum 82} args} { + source ./include.tcl + + eval {test074 $method $dir $pagesize $nitems $tnum} $args +} diff --git a/bdb/test/test083.tcl b/bdb/test/test083.tcl new file mode 100644 index 00000000000..7565a5a74f5 --- /dev/null +++ b/bdb/test/test083.tcl @@ -0,0 +1,136 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test083.tcl,v 11.6 2000/12/11 17:24:55 sue Exp $ +# +# Test 83. +# Test of DB->key_range +proc test083 { method {pgsz 512} {maxitems 5000} {step 2} args} { + source ./include.tcl + set omethod [convert_method $method] + set args [convert_args $method $args] + + puts "Test083 $method ($args): Test of DB->key_range" + if { [is_btree $method] != 1 } { + puts "\tTest083: Skipping for method $method." + return + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test083: skipping for specific pagesizes" + return + } + + # If we are using an env, then testfile should just be the db name. + # Otherwise it is the test directory and the name. + set eindex [lsearch -exact $args "-env"] + if { $eindex == -1 } { + set testfile $testdir/test083.db + set env NULL + } else { + set testfile test083.db + incr eindex + set env [lindex $args $eindex] + } + + # We assume that numbers will be at most six digits wide + error_check_bad maxitems_range [expr $maxitems > 999999] 1 + + # We want to test key_range on a variety of sizes of btree. + # Start at ten keys and work up to $maxitems keys, at each step + # multiplying the number of keys by $step. + for { set nitems 10 } { $nitems <= $maxitems }\ + { set nitems [expr $nitems * $step] } { + + puts "\tTest083.a: Opening new database" + cleanup $testdir $env + set db [eval {berkdb_open -create -truncate -mode 0644} \ + -pagesize $pgsz $omethod $args $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + t83_build $db $nitems + t83_test $db $nitems + + error_check_good db_close [$db close] 0 + } +} + +proc t83_build { db nitems } { + source ./include.tcl + + puts "\tTest083.b: Populating database with $nitems keys" + + set keylist {} + puts "\t\tTest083.b.1: Generating key list" + for { set i 0 } { $i < $nitems } { incr i } { + lappend keylist $i + } + + # With randomly ordered insertions, the range of errors we + # get from key_range can be unpredictably high [#2134]. For now, + # just skip the randomization step. + #puts "\t\tTest083.b.2: Randomizing key list" + #set keylist [randomize_list $keylist] + + #puts "\t\tTest083.b.3: Populating database with randomized keys" + + puts "\t\tTest083.b.2: Populating database" + set data [repeat . 50] + + foreach keynum $keylist { + error_check_good db_put [$db put key[format %6d $keynum] \ + $data] 0 + } +} + +proc t83_test { db nitems } { + # Look at the first key, then at keys about 1/4, 1/2, 3/4, and + # all the way through the database. Make sure the key_ranges + # aren't off by more than 10%. + + set dbc [$db cursor] + error_check_good dbc [is_valid_cursor $dbc $db] TRUE + + puts "\tTest083.c: Verifying ranges..." + + for { set i 0 } { $i < $nitems } \ + { incr i [expr $nitems / [berkdb random_int 3 16]] } { + puts "\t\t...key $i" + error_check_bad key0 [llength [set dbt [$dbc get -first]]] 0 + + for { set j 0 } { $j < $i } { incr j } { + error_check_bad key$j \ + [llength [set dbt [$dbc get -next]]] 0 + } + + set ranges [$db keyrange [lindex [lindex $dbt 0] 0]] + + #puts $ranges + error_check_good howmanyranges [llength $ranges] 3 + + set lessthan [lindex $ranges 0] + set morethan [lindex $ranges 2] + + set rangesum [expr $lessthan + [lindex $ranges 1] + $morethan] + + roughly_equal $rangesum 1 0.05 + + # Wild guess. + if { $nitems < 500 } { + set tol 0.3 + } elseif { $nitems > 500 } { + set tol 0.15 + } + + roughly_equal $lessthan [expr $i * 1.0 / $nitems] $tol + + } + + error_check_good dbc_close [$dbc close] 0 +} + +proc roughly_equal { a b tol } { + error_check_good "$a =~ $b" [expr $a - $b < $tol] 1 +} diff --git a/bdb/test/test084.tcl b/bdb/test/test084.tcl new file mode 100644 index 00000000000..0efd0d17c00 --- /dev/null +++ b/bdb/test/test084.tcl @@ -0,0 +1,48 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test084.tcl,v 11.6 2000/12/11 17:24:55 sue Exp $ +# +# Test 84. +# Basic sanity test (test001) with large (64K) pages. +# +proc test084 { method {nentries 10000} {tnum 84} {pagesize 65536} args} { + source ./include.tcl + + 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/test0$tnum-empty.db + set env NULL + } else { + set testfile test0$tnum-empty.db + incr eindex + set env [lindex $args $eindex] + } + + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test084: skipping for specific pagesizes" + return + } + + cleanup $testdir $env + + set args "-pagesize $pagesize $args" + + eval {test001 $method $nentries 0 $tnum} $args + + set omethod [convert_method $method] + set args [convert_args $method $args] + + # For good measure, create a second database that's empty + # with the large page size. (There was a verifier bug that + # choked on empty 64K pages. [#2408]) + set db [eval {berkdb_open -create -mode 0644} $args $omethod $testfile] + error_check_good empty_db [is_valid_db $db] TRUE + error_check_good empty_db_close [$db close] 0 +} diff --git a/bdb/test/test085.tcl b/bdb/test/test085.tcl new file mode 100644 index 00000000000..09134a00f65 --- /dev/null +++ b/bdb/test/test085.tcl @@ -0,0 +1,274 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test085.tcl,v 1.4 2000/12/11 17:24:55 sue Exp $ +# +# DB Test 85: Test of cursor behavior when a cursor is pointing to a deleted +# btree key which then has duplicates added. +proc test085 { method {pagesize 512} {onp 3} {offp 10} {tnum 85} args } { + source ./include.tcl + global alphabet + + set omethod [convert_method $method] + set args [convert_args $method $args] + + + 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/test0$tnum.db + set env NULL + } else { + set testfile test0$tnum.db + incr eindex + set env [lindex $args $eindex] + } + + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test085: skipping for specific pagesizes" + return + } + cleanup $testdir $env + + # Keys must sort $prekey < $key < $postkey. + set prekey "AA" + set key "BBB" + set postkey "CCCC" + + # Make these distinguishable from each other and from the + # alphabets used for the $key's data. + set predatum "1234567890" + set datum $alphabet + set postdatum "0987654321" + + append args " -pagesize $pagesize -dup" + + puts -nonewline "Test0$tnum $omethod ($args): " + + # Skip for all non-btrees. (Rbtrees don't count as btrees, for + # now, since they don't support dups.) + if { [is_btree $method] != 1 } { + puts "Skipping for method $method." + return + } else { + puts "Duplicates w/ deleted item cursor." + } + + # Repeat the test with both on-page and off-page numbers of dups. + foreach ndups "$onp $offp" { + # Put operations we want to test on a cursor set to the + # deleted item, the key to use with them, and what should + # come before and after them given a placement of + # the deleted item at the beginning or end of the dupset. + set final [expr $ndups - 1] + set putops { + {{-before} "" $predatum {[test085_ddatum 0]} beginning} + {{-before} "" {[test085_ddatum $final]} $postdatum end} + {{-current} "" $predatum {[test085_ddatum 0]} beginning} + {{-current} "" {[test085_ddatum $final]} $postdatum end} + {{-keyfirst} $key $predatum {[test085_ddatum 0]} beginning} + {{-keyfirst} $key $predatum {[test085_ddatum 0]} end} + {{-keylast} $key {[test085_ddatum $final]} $postdatum beginning} + {{-keylast} $key {[test085_ddatum $final]} $postdatum end} + {{-after} "" $predatum {[test085_ddatum 0]} beginning} + {{-after} "" {[test085_ddatum $final]} $postdatum end} + } + + # Get operations we want to test on a cursor set to the + # deleted item, any args to get, and the expected key/data pair. + set getops { + {{-current} "" "" "" beginning} + {{-current} "" "" "" end} + {{-next} "" $key {[test085_ddatum 0]} beginning} + {{-next} "" $postkey $postdatum end} + {{-prev} "" $prekey $predatum beginning} + {{-prev} "" $key {[test085_ddatum $final]} end} + {{-first} "" $prekey $predatum beginning} + {{-first} "" $prekey $predatum end} + {{-last} "" $postkey $postdatum beginning} + {{-last} "" $postkey $postdatum end} + {{-nextdup} "" $key {[test085_ddatum 0]} beginning} + {{-nextdup} "" EMPTYLIST "" end} + {{-nextnodup} "" $postkey $postdatum beginning} + {{-nextnodup} "" $postkey $postdatum end} + {{-prevnodup} "" $prekey $predatum beginning} + {{-prevnodup} "" $prekey $predatum end} + } + + foreach pair $getops { + set op [lindex $pair 0] + puts "\tTest0$tnum: Get ($op) with $ndups duplicates,\ + cursor at the [lindex $pair 4]." + set db [eval {berkdb_open -create \ + -truncate -mode 0644} $omethod $args $testfile] + error_check_good "db open" [is_valid_db $db] TRUE + + set dbc [test085_setup $db] + + set beginning [expr [string compare \ + [lindex $pair 4] "beginning"] == 0] + + for { set i 0 } { $i < $ndups } { incr i } { + if { $beginning } { + error_check_good db_put($i) \ + [$db put $key [test085_ddatum $i]] 0 + } else { + set c [$db cursor] + set j [expr $ndups - $i - 1] + error_check_good db_cursor($j) \ + [is_valid_cursor $c $db] TRUE + set d [test085_ddatum $j] + error_check_good dbc_put($j) \ + [$c put -keyfirst $key $d] 0 + error_check_good c_close [$c close] 0 + } + } + + set gargs [lindex $pair 1] + set ekey "" + set edata "" + eval set ekey [lindex $pair 2] + eval set edata [lindex $pair 3] + + set dbt [eval $dbc get $op $gargs] + if { [string compare $ekey EMPTYLIST] == 0 } { + error_check_good dbt($op,$ndups) \ + [llength $dbt] 0 + } else { + error_check_good dbt($op,$ndups) $dbt \ + [list [list $ekey $edata]] + } + error_check_good "dbc close" [$dbc close] 0 + error_check_good "db close" [$db close] 0 + verify_dir $testdir "\t\t" + } + + foreach pair $putops { + # Open and set up database. + set op [lindex $pair 0] + puts "\tTest0$tnum: Put ($op) with $ndups duplicates,\ + cursor at the [lindex $pair 4]." + set db [eval {berkdb_open -create \ + -truncate -mode 0644} $omethod $args $testfile] + error_check_good "db open" [is_valid_db $db] TRUE + + set beginning [expr [string compare \ + [lindex $pair 4] "beginning"] == 0] + + set dbc [test085_setup $db] + + # Put duplicates. + for { set i 0 } { $i < $ndups } { incr i } { + if { $beginning } { + error_check_good db_put($i) \ + [$db put $key [test085_ddatum $i]] 0 + } else { + set c [$db cursor] + set j [expr $ndups - $i - 1] + error_check_good db_cursor($j) \ + [is_valid_cursor $c $db] TRUE + set d [test085_ddatum $j] + error_check_good dbc_put($j) \ + [$c put -keyfirst $key $d] 0 + error_check_good c_close [$c close] 0 + } + } + + # Set up cursors for stability test. + set pre_dbc [$db cursor] + error_check_good pre_set [$pre_dbc get -set $prekey] \ + [list [list $prekey $predatum]] + set post_dbc [$db cursor] + error_check_good post_set [$post_dbc get -set $postkey]\ + [list [list $postkey $postdatum]] + set first_dbc [$db cursor] + error_check_good first_set \ + [$first_dbc get -get_both $key [test085_ddatum 0]] \ + [list [list $key [test085_ddatum 0]]] + set last_dbc [$db cursor] + error_check_good last_set \ + [$last_dbc get -get_both $key [test085_ddatum \ + [expr $ndups - 1]]] \ + [list [list $key [test085_ddatum [expr $ndups -1]]]] + + set k [lindex $pair 1] + set d_before "" + set d_after "" + eval set d_before [lindex $pair 2] + eval set d_after [lindex $pair 3] + set newdatum "NewDatum" + error_check_good dbc_put($op,$ndups) \ + [eval $dbc put $op $k $newdatum] 0 + error_check_good dbc_prev($op,$ndups) \ + [lindex [lindex [$dbc get -prev] 0] 1] \ + $d_before + error_check_good dbc_current($op,$ndups) \ + [lindex [lindex [$dbc get -next] 0] 1] \ + $newdatum + + error_check_good dbc_next($op,$ndups) \ + [lindex [lindex [$dbc get -next] 0] 1] \ + $d_after + + # Verify stability of pre- and post- cursors. + error_check_good pre_stable [$pre_dbc get -current] \ + [list [list $prekey $predatum]] + error_check_good post_stable [$post_dbc get -current] \ + [list [list $postkey $postdatum]] + error_check_good first_stable \ + [$first_dbc get -current] \ + [list [list $key [test085_ddatum 0]]] + error_check_good last_stable \ + [$last_dbc get -current] \ + [list [list $key [test085_ddatum [expr $ndups -1]]]] + + + foreach c "$pre_dbc $post_dbc $first_dbc $last_dbc" { + error_check_good ${c}_close [$c close] 0 + } + + error_check_good "dbc close" [$dbc close] 0 + error_check_good "db close" [$db close] 0 + verify_dir $testdir "\t\t" + } + } +} + + +# Set up the test database; put $prekey, $key, and $postkey with their +# respective data, and then delete $key with a new cursor. Return that +# cursor, still pointing to the deleted item. +proc test085_setup { db } { + upvar key key + upvar prekey prekey + upvar postkey postkey + upvar predatum predatum + upvar postdatum postdatum + + # no one else should ever see this one! + set datum "bbbbbbbb" + + error_check_good pre_put [$db put $prekey $predatum] 0 + error_check_good main_put [$db put $key $datum] 0 + error_check_good post_put [$db put $postkey $postdatum] 0 + + set dbc [$db cursor] + error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE + + error_check_good dbc_getset [$dbc get -get_both $key $datum] \ + [list [list $key $datum]] + + error_check_good dbc_del [$dbc del] 0 + + return $dbc +} + +proc test085_ddatum { a } { + global alphabet + return $a$alphabet +} diff --git a/bdb/test/test086.tcl b/bdb/test/test086.tcl new file mode 100644 index 00000000000..dc30de8ec37 --- /dev/null +++ b/bdb/test/test086.tcl @@ -0,0 +1,162 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test086.tcl,v 11.2 2000/08/25 14:21:58 sue Exp $ + +# Test086: Cursor stability across btree splits w/ subtransaction abort [#2373]. +proc test086 { method args } { + global errorCode + source ./include.tcl + + set tstn 086 + + if { [is_btree $method] != 1 } { + puts "Test$tstn skipping for method $method." + return + } + + set method "-btree" + + puts "\tTest$tstn: Test of cursor stability across aborted\ + btree splits." + + set key "key" + set data "data" + set txn "" + set flags "" + + set eindex [lsearch -exact $args "-env"] + # + # If we are using an env, then this test won't work. + if { $eindex == -1 } { + # But we will be using our own env... + set testfile test0$tstn.db + } else { + puts "\tTest$tstn: Environment provided; skipping test." + return + } + set t1 $testdir/t1 + env_cleanup $testdir + + set env [berkdb env -create -home $testdir -txn] + error_check_good berkdb_env [is_valid_env $env] TRUE + + puts "\tTest$tstn.a: Create $method database." + set oflags "-create -env $env -mode 0644 $args $method" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set nkeys 5 + # Fill page w/ small key/data pairs, keep at leaf + # + puts "\tTest$tstn.b: Fill page with $nkeys small key/data pairs." + set txn [$env txn] + error_check_good txn [is_valid_txn $txn $env] TRUE + for { set i 0 } { $i < $nkeys } { incr i } { + set ret [$db put -txn $txn key000$i $data$i] + error_check_good dbput $ret 0 + } + error_check_good commit [$txn commit] 0 + + # get db ordering, set cursors + puts "\tTest$tstn.c: Set cursors on each of $nkeys pairs." + set txn [$env txn] + error_check_good txn [is_valid_txn $txn $env] TRUE + for {set i 0; set ret [$db get -txn $txn key000$i]} {\ + $i < $nkeys && [llength $ret] != 0} {\ + incr i; set ret [$db get -txn $txn key000$i]} { + set key_set($i) [lindex [lindex $ret 0] 0] + set data_set($i) [lindex [lindex $ret 0] 1] + set dbc [$db cursor -txn $txn] + set dbc_set($i) $dbc + error_check_good db_cursor:$i [is_substr $dbc_set($i) $db] 1 + set ret [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc_set($i)_get:set [llength $ret] 0 + } + + # Create child txn. + set ctxn [$env txn -parent $txn] + error_check_good ctxn [is_valid_txn $txn $env] TRUE + + # if mkeys is above 1000, need to adjust below for lexical order + set mkeys 1000 + puts "\tTest$tstn.d: Add $mkeys pairs to force split." + for {set i $nkeys} { $i < $mkeys } { incr i } { + if { $i >= 100 } { + set ret [$db put -txn $ctxn key0$i $data$i] + } elseif { $i >= 10 } { + set ret [$db put -txn $ctxn key00$i $data$i] + } else { + set ret [$db put -txn $ctxn key000$i $data$i] + } + error_check_good dbput:more $ret 0 + } + + puts "\tTest$tstn.e: Abort." + error_check_good ctxn_abort [$ctxn abort] 0 + + + puts "\tTest$tstn.f: Check and see that cursors maintained reference." + for {set i 0} { $i < $nkeys } {incr i} { + set ret [$dbc_set($i) get -current] + error_check_bad dbc$i:get:current [llength $ret] 0 + set ret2 [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc$i:get:set [llength $ret2] 0 + error_check_good dbc$i:get(match) $ret $ret2 + } + + # Put (and this time keep) the keys that caused the split. + # We'll delete them to test reverse splits. + puts "\tTest$tstn.g: Put back added keys." + for {set i $nkeys} { $i < $mkeys } { incr i } { + if { $i >= 100 } { + set ret [$db put -txn $txn key0$i $data$i] + } elseif { $i >= 10 } { + set ret [$db put -txn $txn key00$i $data$i] + } else { + set ret [$db put -txn $txn key000$i $data$i] + } + error_check_good dbput:more $ret 0 + } + + puts "\tTest$tstn.h: Delete added keys to force reverse split." + set ctxn [$env txn -parent $txn] + error_check_good ctxn [is_valid_txn $txn $env] TRUE + for {set i $nkeys} { $i < $mkeys } { incr i } { + if { $i >= 100 } { + error_check_good db_del:$i [$db del -txn $ctxn key0$i] 0 + } elseif { $i >= 10 } { + error_check_good db_del:$i \ + [$db del -txn $ctxn key00$i] 0 + } else { + error_check_good db_del:$i \ + [$db del -txn $ctxn key000$i] 0 + } + } + + puts "\tTest$tstn.i: Abort." + error_check_good ctxn_abort [$ctxn abort] 0 + + puts "\tTest$tstn.j: Verify cursor reference." + for {set i 0} { $i < $nkeys } {incr i} { + set ret [$dbc_set($i) get -current] + error_check_bad dbc$i:get:current [llength $ret] 0 + set ret2 [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc$i:get:set [llength $ret2] 0 + error_check_good dbc$i:get(match) $ret $ret2 + } + + puts "\tTest$tstn.j: Cleanup." + # close cursors + for {set i 0} { $i < $nkeys } {incr i} { + error_check_good dbc_close:$i [$dbc_set($i) close] 0 + } + + error_check_good commit [$txn commit] 0 + error_check_good dbclose [$db close] 0 + error_check_good envclose [$env close] 0 + + puts "\tTest$tstn complete." +} diff --git a/bdb/test/test087.tcl b/bdb/test/test087.tcl new file mode 100644 index 00000000000..7096e6c1cb9 --- /dev/null +++ b/bdb/test/test087.tcl @@ -0,0 +1,278 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test087.tcl,v 11.6 2000/12/11 17:24:55 sue Exp $ +# +# DB Test 87: Test of cursor stability on duplicate pages w/aborts. +# Does the following: +# a. Initialize things by DB->putting ndups dups and +# setting a reference cursor to point to each. +# b. c_put ndups dups (and correspondingly expanding +# the set of reference cursors) after the last one, making sure +# after each step that all the reference cursors still point to +# the right item. +# c. Ditto, but before the first one. +# d. Ditto, but after each one in sequence first to last. +# e. Ditto, but after each one in sequence from last to first. +# occur relative to the new datum) +# f. Ditto for the two sequence tests, only doing a +# DBC->c_put(DB_CURRENT) of a larger datum instead of adding a +# new one. +proc test087 { method {pagesize 512} {ndups 50} {tnum 87} args } { + source ./include.tcl + global alphabet + + set omethod [convert_method $method] + set args [convert_args $method $args] + + puts "Test0$tnum $omethod ($args): " + set eindex [lsearch -exact $args "-env"] + # + # If we are using an env, then return + if { $eindex != -1 } { + puts "Environment specified; skipping." + return + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test087: skipping for specific pagesizes" + return + } + env_cleanup $testdir + set testfile test0$tnum.db + set key "the key" + append args " -pagesize $pagesize -dup" + + if { [is_record_based $method] || [is_rbtree $method] } { + puts "Skipping for method $method." + return + } else { + puts "Cursor stability on dup. pages w/ aborts." + } + + set env [berkdb env -create -home $testdir -txn] + error_check_good env_create [is_valid_env $env] TRUE + + set db [eval {berkdb_open -env $env \ + -create -mode 0644} $omethod $args $testfile] + error_check_good "db open" [is_valid_db $db] TRUE + + # Number of outstanding keys. + set keys 0 + + puts "\tTest0$tnum.a.1: Initializing put loop; $ndups dups, short data." + set txn [$env txn] + error_check_good txn [is_valid_txn $txn $env] TRUE + for { set i 0 } { $i < $ndups } { incr i } { + set datum [makedatum_t73 $i 0] + + error_check_good "db put ($i)" [$db put -txn $txn $key $datum] 0 + + set is_long($i) 0 + incr keys + } + error_check_good txn_commit [$txn commit] 0 + + puts "\tTest0$tnum.a.2: Initializing cursor get loop; $keys dups." + set txn [$env txn] + error_check_good txn [is_valid_txn $txn $env] TRUE + for { set i 0 } { $i < $keys } { incr i } { + set datum [makedatum_t73 $i 0] + + set dbc($i) [$db cursor -txn $txn] + error_check_good "db cursor ($i)"\ + [is_valid_cursor $dbc($i) $db] TRUE + error_check_good "dbc get -get_both ($i)"\ + [$dbc($i) get -get_both $key $datum]\ + [list [list $key $datum]] + } + + puts "\tTest0$tnum.b: Cursor put (DB_KEYLAST); $ndups new dups,\ + short data." + + set ctxn [$env txn -parent $txn] + error_check_good ctxn($i) [is_valid_txn $ctxn $env] TRUE + for { set i 0 } { $i < $ndups } { incr i } { + # !!! keys contains the number of the next dup + # to be added (since they start from zero) + + set datum [makedatum_t73 $keys 0] + set curs [$db cursor -txn $ctxn] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + error_check_good "c_put(DB_KEYLAST, $keys)"\ + [$curs put -keylast $key $datum] 0 + + # We can't do a verification while a child txn is active, + # or we'll run into trouble when DEBUG_ROP is enabled. + # If this test has trouble, though, uncommenting this + # might be illuminating--it makes things a bit more rigorous + # and works fine when DEBUG_ROP is not enabled. + # verify_t73 is_long dbc $keys $key + error_check_good curs_close [$curs close] 0 + } + error_check_good ctxn_abort [$ctxn abort] 0 + verify_t73 is_long dbc $keys $key + + puts "\tTest0$tnum.c: Cursor put (DB_KEYFIRST); $ndups new dups,\ + short data." + + set ctxn [$env txn -parent $txn] + error_check_good ctxn($i) [is_valid_txn $ctxn $env] TRUE + for { set i 0 } { $i < $ndups } { incr i } { + # !!! keys contains the number of the next dup + # to be added (since they start from zero) + + set datum [makedatum_t73 $keys 0] + set curs [$db cursor -txn $ctxn] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + error_check_good "c_put(DB_KEYFIRST, $keys)"\ + [$curs put -keyfirst $key $datum] 0 + + # verify_t73 is_long dbc $keys $key + error_check_good curs_close [$curs close] 0 + } + # verify_t73 is_long dbc $keys $key + # verify_t73 is_long dbc $keys $key + error_check_good ctxn_abort [$ctxn abort] 0 + verify_t73 is_long dbc $keys $key + + puts "\tTest0$tnum.d: Cursor put (DB_AFTER) first to last;\ + $keys new dups, short data" + # We want to add a datum after each key from 0 to the current + # value of $keys, which we thus need to save. + set ctxn [$env txn -parent $txn] + error_check_good ctxn($i) [is_valid_txn $ctxn $env] TRUE + set keysnow $keys + for { set i 0 } { $i < $keysnow } { incr i } { + set datum [makedatum_t73 $keys 0] + set curs [$db cursor -txn $ctxn] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + + # Which datum to insert this guy after. + set curdatum [makedatum_t73 $i 0] + error_check_good "c_get(DB_GET_BOTH, $i)"\ + [$curs get -get_both $key $curdatum]\ + [list [list $key $curdatum]] + error_check_good "c_put(DB_AFTER, $i)"\ + [$curs put -after $datum] 0 + + # verify_t73 is_long dbc $keys $key + error_check_good curs_close [$curs close] 0 + } + error_check_good ctxn_abort [$ctxn abort] 0 + verify_t73 is_long dbc $keys $key + + puts "\tTest0$tnum.e: Cursor put (DB_BEFORE) last to first;\ + $keys new dups, short data" + set ctxn [$env txn -parent $txn] + error_check_good ctxn($i) [is_valid_txn $ctxn $env] TRUE + for { set i [expr $keys - 1] } { $i >= 0 } { incr i -1 } { + set datum [makedatum_t73 $keys 0] + set curs [$db cursor -txn $ctxn] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + + # Which datum to insert this guy before. + set curdatum [makedatum_t73 $i 0] + error_check_good "c_get(DB_GET_BOTH, $i)"\ + [$curs get -get_both $key $curdatum]\ + [list [list $key $curdatum]] + error_check_good "c_put(DB_BEFORE, $i)"\ + [$curs put -before $datum] 0 + + # verify_t73 is_long dbc $keys $key + error_check_good curs_close [$curs close] 0 + } + error_check_good ctxn_abort [$ctxn abort] 0 + verify_t73 is_long dbc $keys $key + + puts "\tTest0$tnum.f: Cursor put (DB_CURRENT), first to last,\ + growing $keys data." + set ctxn [$env txn -parent $txn] + error_check_good ctxn($i) [is_valid_txn $ctxn $env] TRUE + for { set i 0 } { $i < $keysnow } { incr i } { + set olddatum [makedatum_t73 $i 0] + set newdatum [makedatum_t73 $i 1] + set curs [$db cursor -txn $ctxn] + error_check_good "db cursor create" [is_valid_cursor $curs $db]\ + TRUE + + error_check_good "c_get(DB_GET_BOTH, $i)"\ + [$curs get -get_both $key $olddatum]\ + [list [list $key $olddatum]] + error_check_good "c_put(DB_CURRENT, $i)"\ + [$curs put -current $newdatum] 0 + + set is_long($i) 1 + + # verify_t73 is_long dbc $keys $key + error_check_good curs_close [$curs close] 0 + } + error_check_good ctxn_abort [$ctxn abort] 0 + for { set i 0 } { $i < $keysnow } { incr i } { + set is_long($i) 0 + } + verify_t73 is_long dbc $keys $key + + # Now delete the first item, abort the deletion, and make sure + # we're still sane. + puts "\tTest0$tnum.g: Cursor delete first item, then abort delete." + set ctxn [$env txn -parent $txn] + error_check_good ctxn($i) [is_valid_txn $ctxn $env] TRUE + set curs [$db cursor -txn $ctxn] + error_check_good "db cursor create" [is_valid_cursor $curs $db] TRUE + set datum [makedatum_t73 0 0] + error_check_good "c_get(DB_GET_BOTH, 0)"\ + [$curs get -get_both $key $datum] [list [list $key $datum]] + error_check_good "c_del(0)" [$curs del] 0 + error_check_good curs_close [$curs close] 0 + error_check_good ctxn_abort [$ctxn abort] 0 + verify_t73 is_long dbc $keys $key + + # Ditto, for the last item. + puts "\tTest0$tnum.h: Cursor delete last item, then abort delete." + set ctxn [$env txn -parent $txn] + error_check_good ctxn($i) [is_valid_txn $ctxn $env] TRUE + set curs [$db cursor -txn $ctxn] + error_check_good "db cursor create" [is_valid_cursor $curs $db] TRUE + set datum [makedatum_t73 [expr $keys - 1] 0] + error_check_good "c_get(DB_GET_BOTH, [expr $keys - 1])"\ + [$curs get -get_both $key $datum] [list [list $key $datum]] + error_check_good "c_del(0)" [$curs del] 0 + error_check_good curs_close [$curs close] 0 + error_check_good ctxn_abort [$ctxn abort] 0 + verify_t73 is_long dbc $keys $key + + # Ditto, for all the items. + puts "\tTest0$tnum.i: Cursor delete all items, then abort delete." + set ctxn [$env txn -parent $txn] + error_check_good ctxn($i) [is_valid_txn $ctxn $env] TRUE + set curs [$db cursor -txn $ctxn] + error_check_good "db cursor create" [is_valid_cursor $curs $db] TRUE + set datum [makedatum_t73 0 0] + error_check_good "c_get(DB_GET_BOTH, 0)"\ + [$curs get -get_both $key $datum] [list [list $key $datum]] + error_check_good "c_del(0)" [$curs del] 0 + for { set i 1 } { $i < $keys } { incr i } { + error_check_good "c_get(DB_NEXT, $i)"\ + [$curs get -next] [list [list $key [makedatum_t73 $i 0]]] + error_check_good "c_del($i)" [$curs del] 0 + } + error_check_good curs_close [$curs close] 0 + error_check_good ctxn_abort [$ctxn abort] 0 + verify_t73 is_long dbc $keys $key + + # Close cursors. + puts "\tTest0$tnum.j: Closing cursors." + for { set i 0 } { $i < $keys } { incr i } { + error_check_good "dbc close ($i)" [$dbc($i) close] 0 + } + error_check_good txn_commit [$txn commit] 0 + error_check_good "db close" [$db close] 0 + error_check_good "env close" [$env close] 0 +} diff --git a/bdb/test/test088.tcl b/bdb/test/test088.tcl new file mode 100644 index 00000000000..d7b0f815a00 --- /dev/null +++ b/bdb/test/test088.tcl @@ -0,0 +1,142 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test088.tcl,v 11.4 2000/12/11 17:24:55 sue Exp $ +# +# Test088: Cursor stability across btree splits with very deep trees. +# (Variant of test048, SR #2514.) +proc test088 { method args } { + global errorCode alphabet + source ./include.tcl + + set tstn 088 + + if { [is_btree $method] != 1 } { + puts "Test$tstn skipping for method $method." + return + } + set pgindex [lsearch -exact $args "-pagesize"] + if { $pgindex != -1 } { + puts "Test088: skipping for specific pagesizes" + return + } + + set method "-btree" + + puts "\tTest$tstn: Test of cursor stability across btree splits." + + set key "key$alphabet$alphabet$alphabet" + set data "data$alphabet$alphabet$alphabet" + set txn "" + set flags "" + + puts "\tTest$tstn.a: Create $method database." + 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/test$tstn.db + set env NULL + } else { + set testfile test$tstn.db + incr eindex + set env [lindex $args $eindex] + } + set t1 $testdir/t1 + cleanup $testdir $env + + set ps 512 + set oflags "-create -pagesize $ps -truncate -mode 0644 $args $method" + set db [eval {berkdb_open} $oflags $testfile] + error_check_good dbopen [is_valid_db $db] TRUE + + set nkeys 5 + # Fill page w/ key/data pairs. + # + puts "\tTest$tstn.b: Fill page with $nkeys small key/data pairs." + for { set i 0 } { $i < $nkeys } { incr i } { + set ret [$db put ${key}00000$i $data$i] + error_check_good dbput $ret 0 + } + + # get db ordering, set cursors + puts "\tTest$tstn.c: Set cursors on each of $nkeys pairs." + for {set i 0; set ret [$db get ${key}00000$i]} {\ + $i < $nkeys && [llength $ret] != 0} {\ + incr i; set ret [$db get ${key}00000$i]} { + set key_set($i) [lindex [lindex $ret 0] 0] + set data_set($i) [lindex [lindex $ret 0] 1] + set dbc [$db cursor] + set dbc_set($i) $dbc + error_check_good db_cursor:$i [is_substr $dbc_set($i) $db] 1 + set ret [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc_set($i)_get:set [llength $ret] 0 + } + + # if mkeys is above 1000, need to adjust below for lexical order + set mkeys 30000 + puts "\tTest$tstn.d: Add $mkeys pairs to force splits." + for {set i $nkeys} { $i < $mkeys } { incr i } { + if { $i >= 10000 } { + set ret [$db put ${key}0$i $data$i] + } elseif { $i >= 1000 } { + set ret [$db put ${key}00$i $data$i] + } elseif { $i >= 100 } { + set ret [$db put ${key}000$i $data$i] + } elseif { $i >= 10 } { + set ret [$db put ${key}0000$i $data$i] + } else { + set ret [$db put ${key}00000$i $data$i] + } + error_check_good dbput:more $ret 0 + } + + puts "\tTest$tstn.e: Make sure splits happened." + error_check_bad stat:check-split [is_substr [$db stat] \ + "{{Internal pages} 0}"] 1 + + puts "\tTest$tstn.f: Check to see that cursors maintained reference." + for {set i 0} { $i < $nkeys } {incr i} { + set ret [$dbc_set($i) get -current] + error_check_bad dbc$i:get:current [llength $ret] 0 + set ret2 [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc$i:get:set [llength $ret2] 0 + error_check_good dbc$i:get(match) $ret $ret2 + } + + puts "\tTest$tstn.g: Delete added keys to force reverse splits." + for {set i $nkeys} { $i < $mkeys } { incr i } { + if { $i >= 10000 } { + error_check_good db_del:$i [$db del ${key}0$i] 0 + } elseif { $i >= 1000 } { + error_check_good db_del:$i [$db del ${key}00$i] 0 + } elseif { $i >= 100 } { + error_check_good db_del:$i [$db del ${key}000$i] 0 + } elseif { $i >= 10 } { + error_check_good db_del:$i [$db del ${key}0000$i] 0 + } else { + error_check_good db_del:$i [$db del ${key}00000$i] 0 + } + } + + puts "\tTest$tstn.h: Verify cursor reference." + for {set i 0} { $i < $nkeys } {incr i} { + set ret [$dbc_set($i) get -current] + error_check_bad dbc$i:get:current [llength $ret] 0 + set ret2 [$dbc_set($i) get -set $key_set($i)] + error_check_bad dbc$i:get:set [llength $ret2] 0 + error_check_good dbc$i:get(match) $ret $ret2 + } + + puts "\tTest$tstn.i: Cleanup." + # close cursors + for {set i 0} { $i < $nkeys } {incr i} { + error_check_good dbc_close:$i [$dbc_set($i) close] 0 + } + error_check_good dbclose [$db close] 0 + + puts "\tTest$tstn complete." +} diff --git a/bdb/test/test090.tcl b/bdb/test/test090.tcl new file mode 100644 index 00000000000..ed6ec9632f5 --- /dev/null +++ b/bdb/test/test090.tcl @@ -0,0 +1,20 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test090.tcl,v 11.4 2000/12/11 17:24:56 sue Exp $ +# +# DB Test 90 {access method} +# Check for functionality near the end of the queue. +# +# +proc test090 { method {nentries 1000} {txn -txn} {tnum "90"} args} { + if { [is_queueext $method ] == 0 } { + puts "Skipping test0$tnum for $method." + return; + } + eval {test001 $method $nentries 4294967000 $tnum} $args + eval {test025 $method $nentries 4294967000 $tnum} $args + eval {test070 $method 4 2 $nentries WAIT 4294967000 $txn $tnum} $args +} diff --git a/bdb/test/test091.tcl b/bdb/test/test091.tcl new file mode 100644 index 00000000000..9420b571ce3 --- /dev/null +++ b/bdb/test/test091.tcl @@ -0,0 +1,21 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: test091.tcl,v 11.4 2000/12/01 04:28:36 ubell Exp $ +# +# DB Test 91 {access method} +# Check for CONSUME_WAIT functionality +# +proc test091 { method {nconsumers 4} \ + {nproducers 2} {nitems 1000} {start 0 } {tnum "91"} args} { + if { [is_queue $method ] == 0 } { + puts "Skipping test0$tnum for $method." + return; + } + eval {test070 $method \ + $nconsumers $nproducers $nitems WAIT $start -txn $tnum } $args + eval {test070 $method \ + $nconsumers $nproducers $nitems WAIT $start -cdb $tnum } $args +} diff --git a/bdb/test/testparams.tcl b/bdb/test/testparams.tcl new file mode 100644 index 00000000000..2def6a9d0d8 --- /dev/null +++ b/bdb/test/testparams.tcl @@ -0,0 +1,115 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: testparams.tcl,v 11.39 2001/01/11 17:29:42 sue Exp $ + +set deadtests 3 +set envtests 8 +set recdtests 13 +set rsrctests 3 +set runtests 93 +set subdbtests 10 +set rpctests 2 + +set parms(subdb001) "" +set parms(subdb002) 10000 +set parms(subdb003) 1000 +set parms(subdb004) "" +set parms(subdb005) 100 +set parms(subdb006) 100 +set parms(subdb007) 10000 +set parms(subdb008) 10000 +set parms(subdb009) "" +set parms(subdb010) "" +set parms(test001) {10000 0 "01"} +set parms(test002) 10000 +set parms(test003) "" +set parms(test004) {10000 4 0} +set parms(test005) 10000 +set parms(test006) {10000 0 6} +set parms(test007) {10000 7} +set parms(test008) {10000 8 0} +set parms(test009) 10000 +set parms(test010) {10000 5 10} +set parms(test011) {10000 5 11} +set parms(test012) "" +set parms(test013) 10000 +set parms(test014) 10000 +set parms(test015) {7500 0} +set parms(test016) 10000 +set parms(test017) {0 19 17} +set parms(test018) 10000 +set parms(test019) 10000 +set parms(test020) 10000 +set parms(test021) 10000 +set parms(test022) "" +set parms(test023) "" +set parms(test024) 10000 +set parms(test025) {10000 0 25} +set parms(test026) {2000 5 26} +set parms(test027) {100} +set parms(test028) "" +set parms(test029) 10000 +set parms(test030) 10000 +set parms(test031) {10000 5 31} +set parms(test032) {10000 5 32} +set parms(test033) {10000 5 33} +set parms(test034) 10000 +set parms(test035) 10000 +set parms(test036) 10000 +set parms(test037) 100 +set parms(test038) {10000 5 38} +set parms(test039) {10000 5 39} +set parms(test040) 10000 +set parms(test041) 10000 +set parms(test042) 1000 +set parms(test043) 10000 +set parms(test044) {5 10 0} +set parms(test045) 1000 +set parms(test046) "" +set parms(test047) "" +set parms(test048) "" +set parms(test049) "" +set parms(test050) "" +set parms(test051) "" +set parms(test052) "" +set parms(test053) "" +set parms(test054) "" +set parms(test055) "" +set parms(test056) "" +set parms(test057) "" +set parms(test058) "" +set parms(test059) "" +set parms(test060) "" +set parms(test061) "" +set parms(test062) {200 200 62} +set parms(test063) "" +set parms(test064) "" +set parms(test065) "" +set parms(test066) "" +set parms(test067) {1000 67} +set parms(test068) "" +set parms(test069) {50 69} +set parms(test070) {4 2 1000 CONSUME 0 -txn 70} +set parms(test071) {1 1 10000 CONSUME 0 -txn 71} +set parms(test072) {512 20 72} +set parms(test073) {512 50 73} +set parms(test074) {-nextnodup 512 100 74} +set parms(test075) {75} +set parms(test076) {1000 76} +set parms(test077) {1000 512 77} +set parms(test078) {100 512 78} +set parms(test079) {10000 512 79} +set parms(test080) {80} +set parms(test081) {13 81} +set parms(test082) {-prevnodup 512 100 82} +set parms(test083) {512 5000 2} +set parms(test084) {10000 84 65536} +set parms(test085) {512 3 10 85} +set parms(test086) "" +set parms(test087) {512 50 87} +set parms(test088) "" +set parms(test090) {1000 -txn 90} +set parms(test091) {4 2 1000 0 91} diff --git a/bdb/test/testutils.tcl b/bdb/test/testutils.tcl new file mode 100644 index 00000000000..c5edaef7f6a --- /dev/null +++ b/bdb/test/testutils.tcl @@ -0,0 +1,2380 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: testutils.tcl,v 11.86 2001/01/18 23:21:14 krinsky Exp $ +# +# Test system utilities +# +# Timestamp -- print time along with elapsed time since last invocation +# of timestamp. +proc timestamp {{opt ""}} { + global __timestamp_start + + if {[string compare $opt "-r"] == 0} { + clock seconds + } elseif {[string compare $opt "-t"] == 0} { + # -t gives us the current time in the format expected by + # db_recover -t. + return [clock format [clock seconds] -format "%y%m%d%H%M.%S"] + } else { + set now [clock seconds] + + if {[catch {set start $__timestamp_start}] != 0} { + set __timestamp_start $now + } + set start $__timestamp_start + + set elapsed [expr $now - $start] + set the_time [clock format $now -format ""] + set __timestamp_start $now + + format "%02d:%02d:%02d (%02d:%02d:%02d)" \ + [__fix_num [clock format $now -format "%H"]] \ + [__fix_num [clock format $now -format "%M"]] \ + [__fix_num [clock format $now -format "%S"]] \ + [expr $elapsed / 3600] \ + [expr ($elapsed % 3600) / 60] \ + [expr ($elapsed % 3600) % 60] + } +} + +proc __fix_num { num } { + set num [string trimleft $num "0"] + if {[string length $num] == 0} { + set num "0" + } + return $num +} + +# Add a {key,data} pair to the specified database where +# key=filename and data=file contents. +proc put_file { db txn flags file } { + source ./include.tcl + + set fid [open $file r] + fconfigure $fid -translation binary + set data [read $fid] + close $fid + + set ret [eval {$db put} $txn $flags {$file $data}] + error_check_good put_file $ret 0 +} + +# Get a {key,data} pair from the specified database where +# key=filename and data=file contents and then write the +# data to the specified file. +proc get_file { db txn flags file outfile } { + source ./include.tcl + + set fid [open $outfile w] + fconfigure $fid -translation binary + if [catch {eval {$db get} $txn $flags {$file}} data] { + puts -nonewline $fid $data + } else { + # Data looks like {{key data}} + set data [lindex [lindex $data 0] 1] + puts -nonewline $fid $data + } + close $fid +} + +# Add a {key,data} pair to the specified database where +# key=file contents and data=file name. +proc put_file_as_key { db txn flags file } { + source ./include.tcl + + set fid [open $file r] + fconfigure $fid -translation binary + set filecont [read $fid] + close $fid + + # Use not the file contents, but the file name concatenated + # before the file contents, as a key, to ensure uniqueness. + set data $file$filecont + + set ret [eval {$db put} $txn $flags {$data $file}] + error_check_good put_file $ret 0 +} + +# Get a {key,data} pair from the specified database where +# key=file contents and data=file name +proc get_file_as_key { db txn flags file} { + source ./include.tcl + + set fid [open $file r] + fconfigure $fid -translation binary + set filecont [read $fid] + close $fid + + set data $file$filecont + + return [eval {$db get} $txn $flags {$data}] +} + +# open file and call dump_file to dumpkeys to tempfile +proc open_and_dump_file { + dbname dbenv txn outfile checkfunc dump_func beg cont} { + source ./include.tcl + if { $dbenv == "NULL" } { + set db [berkdb open -rdonly -unknown $dbname] + error_check_good dbopen [is_valid_db $db] TRUE + } else { + set db [berkdb open -env $dbenv -rdonly -unknown $dbname] + error_check_good dbopen [is_valid_db $db] TRUE + } + $dump_func $db $txn $outfile $checkfunc $beg $cont + error_check_good db_close [$db close] 0 +} + +# open file and call dump_file to dumpkeys to tempfile +proc open_and_dump_subfile { + dbname dbenv txn outfile checkfunc dump_func beg cont subdb} { + source ./include.tcl + + if { $dbenv == "NULL" } { + set db [berkdb open -rdonly -unknown $dbname $subdb] + error_check_good dbopen [is_valid_db $db] TRUE + } else { + set db [berkdb open -env $dbenv -rdonly -unknown $dbname $subdb] + error_check_good dbopen [is_valid_db $db] TRUE + } + $dump_func $db $txn $outfile $checkfunc $beg $cont + error_check_good db_close [$db close] 0 +} + +# Sequentially read a file and call checkfunc on each key/data pair. +# Dump the keys out to the file specified by outfile. +proc dump_file { db txn outfile checkfunc } { + source ./include.tcl + + dump_file_direction $db $txn $outfile $checkfunc "-first" "-next" +} + +proc dump_file_direction { db txn outfile checkfunc start continue } { + source ./include.tcl + + set outf [open $outfile w] + # Now we will get each key from the DB and dump to outfile + set c [eval {$db cursor} $txn] + error_check_good db_cursor [is_valid_cursor $c $db] TRUE + for {set d [$c get $start] } { [llength $d] != 0 } { + set d [$c get $continue] } { + set kd [lindex $d 0] + set k [lindex $kd 0] + set d2 [lindex $kd 1] + $checkfunc $k $d2 + puts $outf $k + # XXX: Geoff Mainland + # puts $outf "$k $d2" + } + close $outf + error_check_good curs_close [$c close] 0 +} + +proc dump_binkey_file { db txn outfile checkfunc } { + source ./include.tcl + + dump_binkey_file_direction $db $txn $outfile $checkfunc \ + "-first" "-next" +} +proc dump_bin_file { db txn outfile checkfunc } { + source ./include.tcl + + dump_bin_file_direction $db $txn $outfile $checkfunc "-first" "-next" +} + +# Note: the following procedure assumes that the binary-file-as-keys were +# inserted into the database by put_file_as_key, and consist of the file +# name followed by the file contents as key, to ensure uniqueness. +proc dump_binkey_file_direction { db txn outfile checkfunc begin cont } { + source ./include.tcl + + set d1 $testdir/d1 + + set outf [open $outfile w] + + # Now we will get each key from the DB and dump to outfile + set c [eval {$db cursor} $txn] + error_check_good db_cursor [is_valid_cursor $c $db] TRUE + + set inf $d1 + for {set d [$c get $begin] } { [llength $d] != 0 } \ + {set d [$c get $cont] } { + set kd [lindex $d 0] + set keyfile [lindex $kd 0] + set data [lindex $kd 1] + + set ofid [open $d1 w] + fconfigure $ofid -translation binary + + # Chop off the first few bytes--that's the file name, + # added for uniqueness in put_file_as_key, which we don't + # want in the regenerated file. + set namelen [string length $data] + set keyfile [string range $keyfile $namelen end] + puts -nonewline $ofid $keyfile + close $ofid + + $checkfunc $data $d1 + puts $outf $data + flush $outf + } + close $outf + error_check_good curs_close [$c close] 0 + fileremove $d1 +} + +proc dump_bin_file_direction { db txn outfile checkfunc begin cont } { + source ./include.tcl + + set d1 $testdir/d1 + + set outf [open $outfile w] + + # Now we will get each key from the DB and dump to outfile + set c [eval {$db cursor} $txn] + + for {set d [$c get $begin] } \ + { [llength $d] != 0 } {set d [$c get $cont] } { + set k [lindex [lindex $d 0] 0] + set data [lindex [lindex $d 0] 1] + set ofid [open $d1 w] + fconfigure $ofid -translation binary + puts -nonewline $ofid $data + close $ofid + + $checkfunc $k $d1 + puts $outf $k + } + close $outf + error_check_good curs_close [$c close] 0 + fileremove -f $d1 +} + +proc make_data_str { key } { + set datastr "" + for {set i 0} {$i < 10} {incr i} { + append datastr $key + } + return $datastr +} + +proc error_check_bad { func result bad {txn 0}} { + if { [binary_compare $result $bad] == 0 } { + if { $txn != 0 } { + $txn abort + } + flush stdout + flush stderr + error "FAIL:[timestamp] $func returned error value $bad" + } +} + +proc error_check_good { func result desired {txn 0} } { + if { [binary_compare $desired $result] != 0 } { + if { $txn != 0 } { + $txn abort + } + flush stdout + flush stderr + error "FAIL:[timestamp]\ + $func: expected $desired, got $result" + } +} + +# Locks have the prefix of their manager. +proc is_substr { l mgr } { + if { [string first $mgr $l] == -1 } { + return 0 + } else { + return 1 + } +} + +proc release_list { l } { + + # Now release all the locks + foreach el $l { + set ret [$el put] + error_check_good lock_put $ret 0 + } +} + +proc debug { {stop 0} } { + global __debug_on + global __debug_print + global __debug_test + + set __debug_on 1 + set __debug_print 1 + set __debug_test $stop +} + +# Check if each key appears exactly [llength dlist] times in the file with +# the duplicate tags matching those that appear in dlist. +proc dup_check { db txn tmpfile dlist {extra 0}} { + source ./include.tcl + + set outf [open $tmpfile w] + # Now we will get each key from the DB and dump to outfile + set c [eval {$db cursor} $txn] + set lastkey "" + set done 0 + while { $done != 1} { + foreach did $dlist { + set rec [$c get "-next"] + if { [string length $rec] == 0 } { + set done 1 + break + } + set key [lindex [lindex $rec 0] 0] + set fulldata [lindex [lindex $rec 0] 1] + set id [id_of $fulldata] + set d [data_of $fulldata] + if { [string compare $key $lastkey] != 0 && \ + $id != [lindex $dlist 0] } { + set e [lindex $dlist 0] + error "FAIL: \tKey \ + $key, expected dup id $e, got $id" + } + error_check_good dupget.data $d $key + error_check_good dupget.id $id $did + set lastkey $key + } + # + # Some tests add an extra dup (like overflow entries) + # Check id if it exists. + if { $extra != 0} { + set okey $key + set rec [$c get "-next"] + if { [string length $rec] != 0 } { + set key [lindex [lindex $rec 0] 0] + # + # If this key has no extras, go back for + # next iteration. + if { [string compare $key $lastkey] != 0 } { + set key $okey + set rec [$c get "-prev"] + } else { + set fulldata [lindex [lindex $rec 0] 1] + set id [id_of $fulldata] + set d [data_of $fulldata] + error_check_bad dupget.data1 $d $key + error_check_good dupget.id1 $id $extra + } + } + } + if { $done != 1 } { + puts $outf $key + } + } + close $outf + error_check_good curs_close [$c close] 0 +} + +# Parse duplicate data entries of the form N:data. Data_of returns +# the data part; id_of returns the numerical part +proc data_of {str} { + set ndx [string first ":" $str] + if { $ndx == -1 } { + return "" + } + return [ string range $str [expr $ndx + 1] end] +} + +proc id_of {str} { + set ndx [string first ":" $str] + if { $ndx == -1 } { + return "" + } + + return [ string range $str 0 [expr $ndx - 1]] +} + +proc nop { {args} } { + return +} + +# Partial put test procedure. +# Munges a data val through three different partial puts. Stores +# the final munged string in the dvals array so that you can check +# it later (dvals should be global). We take the characters that +# are being replaced, make them capitals and then replicate them +# some number of times (n_add). We do this at the beginning of the +# data, at the middle and at the end. The parameters are: +# db, txn, key -- as per usual. Data is the original data element +# from which we are starting. n_replace is the number of characters +# that we will replace. n_add is the number of times we will add +# the replaced string back in. +proc partial_put { method db txn gflags key data n_replace n_add } { + global dvals + source ./include.tcl + + # Here is the loop where we put and get each key/data pair + # We will do the initial put and then three Partial Puts + # for the beginning, middle and end of the string. + + eval {$db put} $txn {$key [chop_data $method $data]} + + # Beginning change + set s [string range $data 0 [ expr $n_replace - 1 ] ] + set repl [ replicate [string toupper $s] $n_add ] + + # This is gross, but necessary: if this is a fixed-length + # method, and the chopped length of $repl is zero, + # it's because the original string was zero-length and our data item + # is all nulls. Set repl to something non-NULL. + if { [is_fixed_length $method] && \ + [string length [chop_data $method $repl]] == 0 } { + set repl [replicate "." $n_add] + } + + set newstr [chop_data $method $repl[string range $data $n_replace end]] + set ret [eval {$db put} $txn {-partial [list 0 $n_replace] \ + $key [chop_data $method $repl]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags $txn {$key}] + error_check_good get $ret [list [list $key [pad_data $method $newstr]]] + + # End Change + set len [string length $newstr] + set spl [expr $len - $n_replace] + # Handle case where $n_replace > $len + if { $spl < 0 } { + set spl 0 + } + + set s [string range $newstr [ expr $len - $n_replace ] end ] + # Handle zero-length keys + if { [string length $s] == 0 } { set s "A" } + + set repl [ replicate [string toupper $s] $n_add ] + set newstr [chop_data $method \ + [string range $newstr 0 [expr $spl - 1 ] ]$repl] + + set ret [eval {$db put} $txn \ + {-partial [list $spl $n_replace] $key [chop_data $method $repl]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags $txn {$key}] + error_check_good get $ret [list [list $key [pad_data $method $newstr]]] + + # Middle Change + set len [string length $newstr] + set mid [expr $len / 2 ] + set beg [expr $mid - [expr $n_replace / 2] ] + set end [expr $beg + $n_replace - 1] + set s [string range $newstr $beg $end] + set repl [ replicate [string toupper $s] $n_add ] + set newstr [chop_data $method [string range $newstr 0 \ + [expr $beg - 1 ] ]$repl[string range $newstr [expr $end + 1] end]] + + set ret [eval {$db put} $txn {-partial [list $beg $n_replace] \ + $key [chop_data $method $repl]}] + error_check_good put $ret 0 + + set ret [eval {$db get} $gflags $txn {$key}] + error_check_good get $ret [list [list $key [pad_data $method $newstr]]] + + set dvals($key) [pad_data $method $newstr] +} + +proc replicate { str times } { + set res $str + for { set i 1 } { $i < $times } { set i [expr $i * 2] } { + append res $res + } + return $res +} + +proc repeat { str n } { + set ret "" + while { $n > 0 } { + set ret $str$ret + incr n -1 + } + return $ret +} + +proc isqrt { l } { + set s [expr sqrt($l)] + set ndx [expr [string first "." $s] - 1] + return [string range $s 0 $ndx] +} + +# If we run watch_procs multiple times without an intervening +# testdir cleanup, it's possible that old sentinel files will confuse +# us. Make sure they're wiped out before we spawn any other processes. +proc sentinel_init { } { + source ./include.tcl + + set filelist {} + set ret [catch {glob $testdir/begin.*} result] + if { $ret == 0 } { + set filelist $result + } + + set ret [catch {glob $testdir/end.*} result] + if { $ret == 0 } { + set filelist [concat $filelist $result] + } + + foreach f $filelist { + fileremove $f + } +} + +proc watch_procs { {delay 30} {max 3600} } { + source ./include.tcl + + set elapsed 0 + while { 1 } { + + tclsleep $delay + incr elapsed $delay + + # Find the list of processes withoutstanding sentinel + # files (i.e. a begin.pid and no end.pid). + set beginlist {} + set endlist {} + set ret [catch {glob $testdir/begin.*} result] + if { $ret == 0 } { + set beginlist $result + } + set ret [catch {glob $testdir/end.*} result] + if { $ret == 0 } { + set endlist $result + } + + set bpids {} + catch {unset epids} + foreach begfile $beginlist { + lappend bpids [string range $begfile \ + [string length $testdir/begin.] end] + } + foreach endfile $endlist { + set epids([string range $endfile \ + [string length $testdir/end.] end]) 1 + } + + # The set of processes that we still want to watch, $l, + # is the set of pids that have begun but not ended + # according to their sentinel files. + set l {} + foreach p $bpids { + if { [info exists epids($p)] == 0 } { + lappend l $p + } + } + + set rlist {} + foreach i $l { + set r [ catch { exec $KILL -0 $i } result ] + if { $r == 0 } { + lappend rlist $i + } + } + if { [ llength $rlist] == 0 } { + break + } else { + puts "[timestamp] processes running: $rlist" + } + + if { $elapsed > $max } { + # We have exceeded the limit; kill processes + # and report an error + set rlist {} + foreach i $l { + set r [catch { exec $KILL $i } result] + if { $r == 0 } { + lappend rlist $i + } + } + error_check_good "Processes still running" \ + [llength $rlist] 0 + } + } + puts "All processes have exited." +} + +# These routines are all used from within the dbscript.tcl tester. +proc db_init { dbp do_data } { + global a_keys + global l_keys + source ./include.tcl + + set txn "" + set nk 0 + set lastkey "" + + set a_keys() BLANK + set l_keys "" + + set c [$dbp cursor] + for {set d [$c get -first] } { [llength $d] != 0 } { + set d [$c get -next] } { + set k [lindex [lindex $d 0] 0] + set d2 [lindex [lindex $d 0] 1] + incr nk + if { $do_data == 1 } { + if { [info exists a_keys($k)] } { + lappend a_keys($k) $d2] + } else { + set a_keys($k) $d2 + } + } + + lappend l_keys $k + } + error_check_good curs_close [$c close] 0 + + return $nk +} + +proc pick_op { min max n } { + if { $n == 0 } { + return add + } + + set x [berkdb random_int 1 12] + if {$n < $min} { + if { $x <= 4 } { + return put + } elseif { $x <= 8} { + return get + } else { + return add + } + } elseif {$n > $max} { + if { $x <= 4 } { + return put + } elseif { $x <= 8 } { + return get + } else { + return del + } + + } elseif { $x <= 3 } { + return del + } elseif { $x <= 6 } { + return get + } elseif { $x <= 9 } { + return put + } else { + return add + } +} + +# random_data: Generate a string of random characters. +# If recno is 0 - Use average to pick a length between 1 and 2 * avg. +# If recno is non-0, generate a number between 1 and 2 ^ (avg * 2), +# that will fit into a 32-bit integer. +# If the unique flag is 1, then make sure that the string is unique +# in the array "where". +proc random_data { avg unique where {recno 0} } { + upvar #0 $where arr + global debug_on + set min 1 + set max [expr $avg+$avg-1] + if { $recno } { + # + # Tcl seems to have problems with values > 30. + # + if { $max > 30 } { + set max 30 + } + set maxnum [expr int(pow(2, $max))] + } + while {1} { + set len [berkdb random_int $min $max] + set s "" + if {$recno} { + set s [berkdb random_int 1 $maxnum] + } else { + for {set i 0} {$i < $len} {incr i} { + append s [int_to_char [berkdb random_int 0 25]] + } + } + + if { $unique == 0 || [info exists arr($s)] == 0 } { + break + } + } + + return $s +} + +proc random_key { } { + global l_keys + global nkeys + set x [berkdb random_int 0 [expr $nkeys - 1]] + return [lindex $l_keys $x] +} + +proc is_err { desired } { + set x [berkdb random_int 1 100] + if { $x <= $desired } { + return 1 + } else { + return 0 + } +} + +proc pick_cursput { } { + set x [berkdb random_int 1 4] + switch $x { + 1 { return "-keylast" } + 2 { return "-keyfirst" } + 3 { return "-before" } + 4 { return "-after" } + } +} + +proc random_cursor { curslist } { + global l_keys + global nkeys + + set x [berkdb random_int 0 [expr [llength $curslist] - 1]] + set dbc [lindex $curslist $x] + + # We want to randomly set the cursor. Pick a key. + set k [random_key] + set r [$dbc get "-set" $k] + error_check_good cursor_get:$k [is_substr Error $r] 0 + + # Now move forward or backward some hops to randomly + # position the cursor. + set dist [berkdb random_int -10 10] + + set dir "-next" + set boundary "-first" + if { $dist < 0 } { + set dir "-prev" + set boundary "-last" + set dist [expr 0 - $dist] + } + + for { set i 0 } { $i < $dist } { incr i } { + set r [ record $dbc get $dir $k ] + if { [llength $d] == 0 } { + set r [ record $dbc get $k $boundary ] + } + error_check_bad dbcget [llength $r] 0 + } + return { [linsert r 0 $dbc] } +} + +proc record { args } { +# Recording every operation makes tests ridiculously slow on +# NT, so we are commenting this out; for debugging purposes, +# it will undoubtedly be useful to uncomment this. +# puts $args +# flush stdout + return [eval $args] +} + +proc newpair { k data } { + global l_keys + global a_keys + global nkeys + + set a_keys($k) $data + lappend l_keys $k + incr nkeys +} + +proc rempair { k } { + global l_keys + global a_keys + global nkeys + + unset a_keys($k) + set n [lsearch $l_keys $k] + error_check_bad rempair:$k $n -1 + set l_keys [lreplace $l_keys $n $n] + incr nkeys -1 +} + +proc changepair { k data } { + global l_keys + global a_keys + global nkeys + + set a_keys($k) $data +} + +proc changedup { k olddata newdata } { + global l_keys + global a_keys + global nkeys + + set d $a_keys($k) + error_check_bad changedup:$k [llength $d] 0 + + set n [lsearch $d $olddata] + error_check_bad changedup:$k $n -1 + + set a_keys($k) [lreplace $a_keys($k) $n $n $newdata] +} + +# Insert a dup into the a_keys array with DB_KEYFIRST. +proc adddup { k olddata newdata } { + global l_keys + global a_keys + global nkeys + + set d $a_keys($k) + if { [llength $d] == 0 } { + lappend l_keys $k + incr nkeys + set a_keys($k) { $newdata } + } + + set ndx 0 + + set d [linsert d $ndx $newdata] + set a_keys($k) $d +} + +proc remdup { k data } { + global l_keys + global a_keys + global nkeys + + set d [$a_keys($k)] + error_check_bad changedup:$k [llength $d] 0 + + set n [lsearch $d $olddata] + error_check_bad changedup:$k $n -1 + + set a_keys($k) [lreplace $a_keys($k) $n $n] +} + +proc dump_full_file { db txn outfile checkfunc start continue } { + source ./include.tcl + + set outf [open $outfile w] + # Now we will get each key from the DB and dump to outfile + set c [eval {$db cursor} $txn] + error_check_good dbcursor [is_valid_cursor $c $db] TRUE + + for {set d [$c get $start] } { [string length $d] != 0 } { + set d [$c get $continue] } { + set k [lindex [lindex $d 0] 0] + set d2 [lindex [lindex $d 0] 1] + $checkfunc $k $d2 + puts $outf "$k\t$d2" + } + close $outf + error_check_good curs_close [$c close] 0 +} + +proc int_to_char { i } { + global alphabet + + return [string index $alphabet $i] +} + +proc dbcheck { key data } { + global l_keys + global a_keys + global nkeys + global check_array + + if { [lsearch $l_keys $key] == -1 } { + error "FAIL: Key |$key| not in list of valid keys" + } + + set d $a_keys($key) + + if { [info exists check_array($key) ] } { + set check $check_array($key) + } else { + set check {} + } + + if { [llength $d] > 1 } { + if { [llength $check] != [llength $d] } { + # Make the check array the right length + for { set i [llength $check] } { $i < [llength $d] } \ + {incr i} { + lappend check 0 + } + set check_array($key) $check + } + + # Find this data's index + set ndx [lsearch $d $data] + if { $ndx == -1 } { + error "FAIL: \ + Data |$data| not found for key $key. Found |$d|" + } + + # Set the bit in the check array + set check_array($key) [lreplace $check_array($key) $ndx $ndx 1] + } elseif { [string compare $d $data] != 0 } { + error "FAIL: \ + Invalid data |$data| for key |$key|. Expected |$d|." + } else { + set check_array($key) 1 + } +} + +# Dump out the file and verify it +proc filecheck { file txn } { + global check_array + global l_keys + global nkeys + global a_keys + source ./include.tcl + + if { [info exists check_array] == 1 } { + unset check_array + } + + open_and_dump_file $file NULL $txn $file.dump dbcheck dump_full_file \ + "-first" "-next" + + # Check that everything we checked had all its data + foreach i [array names check_array] { + set count 0 + foreach j $check_array($i) { + if { $j != 1 } { + puts -nonewline "Key |$i| never found datum" + puts " [lindex $a_keys($i) $count]" + } + incr count + } + } + + # Check that all keys appeared in the checked array + set count 0 + foreach k $l_keys { + if { [info exists check_array($k)] == 0 } { + puts "filecheck: key |$k| not found. Data: $a_keys($k)" + } + incr count + } + + if { $count != $nkeys } { + puts "filecheck: Got $count keys; expected $nkeys" + } +} + +proc esetup { dir } { + source ./include.tcl + + set ret [berkdb envremove -home $dir] + + fileremove -f $dir/file0 $dir/file1 $dir/file2 $dir/file3 + set mp [memp $dir 0644 -create -cachesize { 0 10240 }] + set lp [lock_open "" -create 0644] + error_check_good memp_close [$mp close] 0 + error_check_good lock_close [$lp close] 0 +} + +proc cleanup { dir env } { + global gen_upgrade + global upgrade_dir + global upgrade_be + global upgrade_method + global upgrade_name + source ./include.tcl + + if { $gen_upgrade == 1 } { + set vers [berkdb version] + set maj [lindex $vers 0] + set min [lindex $vers 1] + + if { $upgrade_be == 1 } { + set version_dir "$maj.${min}be" + } else { + set version_dir "$maj.${min}le" + } + + set dest $upgrade_dir/$version_dir/$upgrade_method/$upgrade_name + + catch {exec mkdir -p $dest} + catch {exec sh -c "mv $dir/*.db $dest"} + catch {exec sh -c "mv $dir/__dbq.* $dest"} + } + +# check_handles + set remfiles {} + set ret [catch { glob $dir/* } result] + if { $ret == 0 } { + foreach file $result { + # + # We: + # - Ignore any env-related files, which are + # those that have __db.* or log.* if we are + # running in an env. + # - Call 'dbremove' on any databases. + # Remove any remaining temp files. + # + switch -glob -- $file { + */__db.* - + */log.* { + if { $env != "NULL" } { + continue + } else { + lappend remfiles $file + } + } + *.db { + set envargs "" + if { $env != "NULL"} { + set file [file tail $file] + set envargs " -env $env " + } + + # If a database is left in a corrupt + # state, dbremove might not be able to handle + # it (it does an open before the remove). + # Be prepared for this, and if necessary, + # just forcibly remove the file with a warning + # message. + set ret [catch \ + {eval {berkdb dbremove} $envargs $file} res] + if { $ret != 0 } { + puts \ + "FAIL: dbremove in cleanup failed: $res" + lappend remfiles $file + } + } + default { + lappend remfiles $file + } + } + } + if {[llength $remfiles] > 0} { + eval fileremove -f $remfiles + } + } +} + +proc log_cleanup { dir } { + source ./include.tcl + + set files [glob -nocomplain $dir/log.*] + if { [llength $files] != 0} { + foreach f $files { + fileremove -f $f + } + } +} + +proc env_cleanup { dir } { + source ./include.tcl + + set stat [catch {berkdb envremove -home $dir} ret] + # + # If something failed and we are left with a region entry + # in /dev/shmem that is zero-length, the envremove will + # succeed, and the shm_unlink will succeed, but it will not + # remove the zero-length entry from /dev/shmem. Remove it + # using fileremove or else all other tests using an env + # will immediately fail. + # + if { $is_qnx_test == 1 } { + set region_files [glob -nocomplain /dev/shmem/$dir*] + if { [llength $region_files] != 0 } { + foreach f $region_files { + fileremove -f $f + } + } + } + log_cleanup $dir + cleanup $dir NULL +} + +proc remote_cleanup { server dir localdir } { + set home [file tail $dir] + error_check_good cleanup:remove [berkdb envremove -home $home \ + -server $server] 0 + catch {exec rsh $server rm -f $dir/*} ret + cleanup $localdir NULL +} + +proc help { cmd } { + if { [info command $cmd] == $cmd } { + set is_proc [lsearch [info procs $cmd] $cmd] + if { $is_proc == -1 } { + # Not a procedure; must be a C command + # Let's hope that it takes some parameters + # and that it prints out a message + puts "Usage: [eval $cmd]" + } else { + # It is a tcl procedure + puts -nonewline "Usage: $cmd" + set args [info args $cmd] + foreach a $args { + set is_def [info default $cmd $a val] + if { $is_def != 0 } { + # Default value + puts -nonewline " $a=$val" + } elseif {$a == "args"} { + # Print out flag values + puts " options" + args + } else { + # No default value + puts -nonewline " $a" + } + } + puts "" + } + } else { + puts "$cmd is not a command" + } +} + +# Run a recovery test for a particular operation +# Notice that we catch the return from CP and do not do anything with it. +# This is because Solaris CP seems to exit non-zero on occasion, but +# everything else seems to run just fine. +proc op_recover { encodedop dir env_cmd dbfile cmd msg } { + global log_log_record_types + global recd_debug + global recd_id + global recd_op + source ./include.tcl + + #puts "op_recover: $encodedop $dir $env_cmd $dbfile $cmd $msg" + + set init_file $dir/t1 + set afterop_file $dir/t2 + set final_file $dir/t3 + + set op "" + set op2 "" + if { $encodedop == "prepare-abort" } { + set op "prepare" + set op2 "abort" + } elseif { $encodedop == "prepare-commit" } { + set op "prepare" + set op2 "commit" + } else { + set op $encodedop + } + + puts "\t$msg $encodedop" + + # Keep track of the log types we've seen + if { $log_log_record_types == 1} { + logtrack_read $dir + } + + # Save the initial file and open the environment and the file + catch { file copy -force $dir/$dbfile $dir/$dbfile.init } res + copy_extent_file $dir $dbfile init + + set env [eval $env_cmd] + set db [berkdb open -env $env $dbfile] + error_check_good dbopen [is_valid_db $db] TRUE + + # Dump out file contents for initial case + set tflags "" + open_and_dump_file $dbfile $env $tflags $init_file nop \ + dump_file_direction "-first" "-next" + + set t [$env txn] + error_check_bad txn_begin $t NULL + error_check_good txn_begin [is_substr $t "txn"] 1 + + # Now fill in the db, tmgr, and the txnid in the command + set exec_cmd $cmd + + set i [lsearch $cmd ENV] + if { $i != -1 } { + set exec_cmd [lreplace $exec_cmd $i $i $env] + } + + set i [lsearch $cmd TXNID] + if { $i != -1 } { + set exec_cmd [lreplace $exec_cmd $i $i $t] + } + + set i [lsearch $exec_cmd DB] + if { $i != -1 } { + set exec_cmd [lreplace $exec_cmd $i $i $db] + } + + # To test DB_CONSUME, we need to expect a record return, not "0". + set i [lsearch $exec_cmd "-consume"] + if { $i != -1 } { + set record_exec_cmd_ret 1 + } else { + set record_exec_cmd_ret 0 + } + + # For the DB_APPEND test, we need to expect a return other than + # 0; set this flag to be more lenient in the error_check_good. + set i [lsearch $exec_cmd "-append"] + if { $i != -1 } { + set lenient_exec_cmd_ret 1 + } else { + set lenient_exec_cmd_ret 0 + } + + # Execute command and commit/abort it. + set ret [eval $exec_cmd] + if { $record_exec_cmd_ret == 1 } { + error_check_good "\"$exec_cmd\"" [llength [lindex $ret 0]] 2 + } elseif { $lenient_exec_cmd_ret == 1 } { + error_check_good "\"$exec_cmd\"" [expr $ret > 0] 1 + } else { + error_check_good "\"$exec_cmd\"" $ret 0 + } + + set record_exec_cmd_ret 0 + set lenient_exec_cmd_ret 0 + + # Sync the file so that we can capture a snapshot to test + # recovery. + error_check_good sync:$db [$db sync] 0 + + catch { file copy -force $dir/$dbfile $dir/$dbfile.afterop } res + copy_extent_file $dir $dbfile afterop + + #set tflags "-txn $t" + open_and_dump_file $dir/$dbfile.afterop NULL $tflags \ + $afterop_file nop dump_file_direction \ + "-first" "-next" + #puts "\t\t\tExecuting txn_$op:$t" + error_check_good txn_$op:$t [$t $op] 0 + if { $op2 != "" } { + #puts "\t\t\tExecuting txn_$op2:$t" + error_check_good txn_$op2:$t [$t $op2] 0 + } + + switch $encodedop { + "commit" { puts "\t\tCommand executed and committed." } + "abort" { puts "\t\tCommand executed and aborted." } + "prepare" { puts "\t\tCommand executed and prepared." } + "prepare-commit" { + puts "\t\tCommand executed, prepared, and committed." + } + "prepare-abort" { + puts "\t\tCommand executed, prepared, and aborted." + } + } + + # Dump out file and save a copy. + error_check_good sync:$db [$db sync] 0 + open_and_dump_file $dir/$dbfile NULL $tflags $final_file nop \ + dump_file_direction "-first" "-next" + + catch { file copy -force $dir/$dbfile $dir/$dbfile.final } res + copy_extent_file $dir $dbfile final + + # If this is an abort or prepare-abort, it should match the + # original file. + # If this was a commit or prepare-commit, then this file should + # match the afterop file. + # If this was a prepare without an abort or commit, we still + # have transactions active, and peering at the database from + # another environment will show data from uncommitted transactions. + # Thus we just skip this in the prepare-only case; what + # we care about are the results of a prepare followed by a + # recovery, which we test later. + if { $op == "commit" || $op2 == "commit" } { + filesort $afterop_file $afterop_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(post-$op,pre-commit):diff($afterop_file,$final_file) \ + [filecmp $afterop_file.sort $final_file.sort] 0 + } elseif { $op == "abort" || $op2 == "abort" } { + filesort $init_file $init_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(initial,post-$op):diff($init_file,$final_file) \ + [filecmp $init_file.sort $final_file.sort] 0 + } else { + # Make sure this really is a prepare-only + error_check_good assert:prepare-only $encodedop "prepare" + } + + # Running recovery on this database should not do anything. + # Flush all data to disk, close the environment and save the + # file. + error_check_good close:$db [$db close] 0 + + # If all we've done is a prepare, then there's still a + # transaction active, and an env close will return DB_RUNRECOVERY + if { $encodedop == "prepare" } { + catch {$env close} ret + error_check_good env_close \ + [is_substr $ret DB_RUNRECOVERY] 1 + } else { + reset_env $env + } + + berkdb debug_check + puts -nonewline "\t\tRunning recovery ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + } + puts -nonewline "complete ... " + + error_check_good db_verify [verify_dir $testdir "\t\t" 0 1] 0 + + puts "verified" + + berkdb debug_check + set env [eval $env_cmd] + error_check_good dbenv [is_valid_widget $env env] TRUE + open_and_dump_file $dir/$dbfile NULL $tflags $final_file nop \ + dump_file_direction "-first" "-next" + if { $op == "commit" || $op2 == "commit" } { + filesort $afterop_file $afterop_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(post-$op,pre-commit):diff($afterop_file,$final_file) \ + [filecmp $afterop_file.sort $final_file.sort] 0 + } else { + filesort $init_file $init_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(initial,post-$op):diff($init_file,$final_file) \ + [filecmp $init_file.sort $final_file.sort] 0 + } + + # Now close the environment, substitute a file that will need + # recovery and try running recovery again. + reset_env $env + if { $op == "commit" || $op2 == "commit" } { + catch { file copy -force $dir/$dbfile.init $dir/$dbfile } res + move_file_extent $dir $dbfile init copy + } else { + catch { file copy -force $dir/$dbfile.afterop $dir/$dbfile } res + move_file_extent $dir $dbfile afterop copy + } + + berkdb debug_check + puts -nonewline \ + "\t\tRunning recovery on pre-op database ... " + flush stdout + + set stat [catch {exec $util_path/db_recover -h $dir -c} result] + if { $stat == 1 } { + error "FAIL: Recovery error: $result." + } + puts -nonewline "complete ... " + + error_check_good db_verify_preop [verify_dir $testdir "\t\t" 0 1] 0 + + puts "verified" + + set env [eval $env_cmd] + + open_and_dump_file $dir/$dbfile NULL $tflags $final_file nop \ + dump_file_direction "-first" "-next" + if { $op == "commit" || $op2 == "commit" } { + filesort $final_file $final_file.sort + filesort $afterop_file $afterop_file.sort + error_check_good \ + diff(post-$op,recovered):diff($afterop_file,$final_file) \ + [filecmp $afterop_file.sort $final_file.sort] 0 + } else { + filesort $init_file $init_file.sort + filesort $final_file $final_file.sort + error_check_good \ + diff(initial,post-$op):diff($init_file,$final_file) \ + [filecmp $init_file.sort $final_file.sort] 0 + } + + # This should just close the environment, not blow it away. + reset_env $env +} + +proc populate { db method txn n dups bigdata } { + source ./include.tcl + + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < $n } { + if { [is_record_based $method] == 1 } { + set key [expr $count + 1] + } elseif { $dups == 1 } { + set key duplicate_key + } else { + set key $str + } + if { $bigdata == 1 && [berkdb random_int 1 3] == 1} { + set str [replicate $str 1000] + } + + set ret [$db put -txn $txn $key $str] + error_check_good db_put:$key $ret 0 + incr count + } + close $did + return 0 +} + +proc big_populate { db txn n } { + source ./include.tcl + + set did [open $dict] + set count 0 + while { [gets $did str] != -1 && $count < $n } { + set key [replicate $str 50] + set ret [$db put -txn $txn $key $str] + error_check_good db_put:$key $ret 0 + incr count + } + close $did + return 0 +} + +proc unpopulate { db txn num } { + source ./include.tcl + + set c [eval {$db cursor} "-txn $txn"] + error_check_bad $db:cursor $c NULL + error_check_good $db:cursor [is_substr $c $db] 1 + + set i 0 + for {set d [$c get -first] } { [llength $d] != 0 } { + set d [$c get -next] } { + $c del + incr i + if { $num != 0 && $ >= $num } { + break + } + } + error_check_good cursor_close [$c close] 0 + return 0 +} + +proc reset_env { env } { + error_check_good env_close [$env close] 0 +} + +# This routine will let us obtain a ring of deadlocks. +# Each locker will get a lock on obj_id, then sleep, and +# then try to lock (obj_id + 1) % num. +# When the lock is finally granted, we release our locks and +# return 1 if we got both locks and DEADLOCK if we deadlocked. +# The results here should be that 1 locker deadlocks and the +# rest all finish successfully. +proc ring { myenv locker_id obj_id num } { + source ./include.tcl + + if {[catch {$myenv lock_get write $locker_id $obj_id} lock1] != 0} { + puts $errorInfo + return ERROR + } else { + error_check_good lockget:$obj_id [is_substr $lock1 $myenv] 1 + } + + tclsleep 30 + set nextobj [expr ($obj_id + 1) % $num] + set ret 1 + if {[catch {$myenv lock_get write $locker_id $nextobj} lock2] != 0} { + if {[string match "*DEADLOCK*" $lock2] == 1} { + set ret DEADLOCK + } else { + set ret ERROR + } + } else { + error_check_good lockget:$obj_id [is_substr $lock2 $myenv] 1 + } + + # Now release the first lock + error_check_good lockput:$lock1 [$lock1 put] 0 + + if {$ret == 1} { + error_check_bad lockget:$obj_id $lock2 NULL + error_check_good lockget:$obj_id [is_substr $lock2 $myenv] 1 + error_check_good lockput:$lock2 [$lock2 put] 0 + } + return $ret +} + +# This routine will create massive deadlocks. +# Each locker will get a readlock on obj_id, then sleep, and +# then try to upgrade the readlock to a write lock. +# When the lock is finally granted, we release our first lock and +# return 1 if we got both locks and DEADLOCK if we deadlocked. +# The results here should be that 1 locker succeeds in getting all +# the locks and everyone else deadlocks. +proc clump { myenv locker_id obj_id num } { + source ./include.tcl + + set obj_id 10 + if {[catch {$myenv lock_get read $locker_id $obj_id} lock1] != 0} { + puts $errorInfo + return ERROR + } else { + error_check_good lockget:$obj_id \ + [is_valid_lock $lock1 $myenv] TRUE + } + + tclsleep 30 + set ret 1 + if {[catch {$myenv lock_get write $locker_id $obj_id} lock2] != 0} { + if {[string match "*DEADLOCK*" $lock2] == 1} { + set ret DEADLOCK + } else { + set ret ERROR + } + } else { + error_check_good \ + lockget:$obj_id [is_valid_lock $lock2 $myenv] TRUE + } + + # Now release the first lock + error_check_good lockput:$lock1 [$lock1 put] 0 + + if {$ret == 1} { + error_check_good \ + lockget:$obj_id [is_valid_lock $lock2 $myenv] TRUE + error_check_good lockput:$lock2 [$lock2 put] 0 + } + return $ret + } + +proc dead_check { t procs dead clean other } { + error_check_good $t:$procs:other $other 0 + switch $t { + ring { + error_check_good $t:$procs:deadlocks $dead 1 + error_check_good $t:$procs:success $clean \ + [expr $procs - 1] + } + clump { + error_check_good $t:$procs:deadlocks $dead \ + [expr $procs - 1] + error_check_good $t:$procs:success $clean 1 + } + default { + error "Test $t not implemented" + } + } +} + +proc rdebug { id op where } { + global recd_debug + global recd_id + global recd_op + + set recd_debug $where + set recd_id $id + set recd_op $op +} + +proc rtag { msg id } { + set tag [lindex $msg 0] + set tail [expr [string length $tag] - 2] + set tag [string range $tag $tail $tail] + if { $id == $tag } { + return 1 + } else { + return 0 + } +} + +proc zero_list { n } { + set ret "" + while { $n > 0 } { + lappend ret 0 + incr n -1 + } + return $ret +} + +proc check_dump { k d } { + puts "key: $k data: $d" +} + +proc reverse { s } { + set res "" + for { set i 0 } { $i < [string length $s] } { incr i } { + set res "[string index $s $i]$res" + } + + return $res +} + +proc is_valid_widget { w expected } { + # First N characters must match "expected" + set l [string length $expected] + incr l -1 + if { [string compare [string range $w 0 $l] $expected] != 0 } { + return $w + } + + # Remaining characters must be digits + incr l 1 + for { set i $l } { $i < [string length $w] } { incr i} { + set c [string index $w $i] + if { $c < "0" || $c > "9" } { + return $w + } + } + + return TRUE +} + +proc is_valid_db { db } { + return [is_valid_widget $db db] +} + +proc is_valid_env { env } { + return [is_valid_widget $env env] +} + +proc is_valid_cursor { dbc db } { + return [is_valid_widget $dbc $db.c] +} + +proc is_valid_lock { lock env } { + return [is_valid_widget $lock $env.lock] +} + +proc is_valid_mpool { mpool env } { + return [is_valid_widget $mpool $env.mp] +} + +proc is_valid_page { page mpool } { + return [is_valid_widget $page $mpool.pg] +} + +proc is_valid_txn { txn env } { + return [is_valid_widget $txn $env.txn] +} + +proc is_valid_mutex { m env } { + return [is_valid_widget $m $env.mutex] +} + +proc send_cmd { fd cmd {sleep 2}} { + source ./include.tcl + + puts $fd "set v \[$cmd\]" + puts $fd "puts \$v" + puts $fd "flush stdout" + flush $fd + berkdb debug_check + tclsleep $sleep + + set r [rcv_result $fd] + return $r +} + +proc rcv_result { fd } { + set r [gets $fd result] + error_check_bad remote_read $r -1 + + return $result +} + +proc send_timed_cmd { fd rcv_too cmd } { + set c1 "set start \[timestamp -r\]; " + set c2 "puts \[expr \[timestamp -r\] - \$start\]" + set full_cmd [concat $c1 $cmd ";" $c2] + + puts $fd $full_cmd + puts $fd "flush stdout" + flush $fd + return 0 +} + +# +# The rationale behind why we have *two* "data padding" routines is outlined +# below: +# +# Both pad_data and chop_data truncate data that is too long. However, +# pad_data also adds the pad character to pad data out to the fixed length +# record length. +# +# Which routine you call does not depend on the length of the data you're +# using, but on whether you're doing a put or a get. When we do a put, we +# have to make sure the data isn't longer than the size of a record because +# otherwise we'll get an error (use chop_data). When we do a get, we want to +# check that db padded everything correctly (use pad_data on the value against +# which we are comparing). +# +# We don't want to just use the pad_data routine for both purposes, because +# we want to be able to test whether or not db is padding correctly. For +# example, the queue access method had a bug where when a record was +# overwritten (*not* a partial put), only the first n bytes of the new entry +# were written, n being the new entry's (unpadded) length. So, if we did +# a put with key,value pair (1, "abcdef") and then a put (1, "z"), we'd get +# back (1,"zbcdef"). If we had used pad_data instead of chop_data, we would +# have gotten the "correct" result, but we wouldn't have found this bug. +proc chop_data {method data} { + global fixed_len + + if {[is_fixed_length $method] == 1 && \ + [string length $data] > $fixed_len} { + return [eval {binary format a$fixed_len $data}] + } else { + return $data + } +} + +proc pad_data {method data} { + global fixed_len + + if {[is_fixed_length $method] == 1} { + return [eval {binary format a$fixed_len $data}] + } else { + return $data + } +} + +proc make_fixed_length {method data {pad 0}} { + global fixed_len + global fixed_pad + + if {[is_fixed_length $method] == 1} { + if {[string length $data] > $fixed_len } { + error_check_bad make_fixed_len:TOO_LONG 1 1 + } + while { [string length $data] < $fixed_len } { + set data [format $data%c $fixed_pad] + } + } + return $data +} + +# shift data for partial +# pad with fixed pad (which is NULL) +proc partial_shift { data offset direction} { + global fixed_len + + set len [expr $fixed_len - 1] + + if { [string compare $direction "right"] == 0 } { + for { set i 1} { $i <= $offset } {incr i} { + set data [binary format x1a$len $data] + } + } elseif { [string compare $direction "left"] == 0 } { + for { set i 1} { $i <= $offset } {incr i} { + set data [string range $data 1 end] + set data [binary format a$len $data] + } + } + return $data +} + +# string compare does not always work to compare +# this data, nor does expr (==) +# specialized routine for comparison +# (for use in fixed len recno and q) +proc binary_compare { data1 data2 } { + if { [string length $data1] != [string length $data2] || \ + [string compare -length \ + [string length $data1] $data1 $data2] != 0 } { + return 1 + } else { + return 0 + } +} + +proc convert_method { method } { + switch -- $method { + -btree - + -dbtree - + -ddbtree - + -rbtree - + BTREE - + DB_BTREE - + DB_RBTREE - + RBTREE - + bt - + btree - + db_btree - + db_rbtree - + rbt - + rbtree { return "-btree" } + + -dhash - + -hash - + DB_HASH - + HASH - + db_hash - + h - + hash { return "-hash" } + + -queue - + DB_QUEUE - + QUEUE - + db_queue - + q - + qam - + queue { return "-queue" } + + -queueextent - + QUEUEEXTENT - + qe - + qamext - + -queueext - + queueextent - + queueext { return "-queue" } + + -frecno - + -recno - + -rrecno - + DB_FRECNO - + DB_RECNO - + DB_RRECNO - + FRECNO - + RECNO - + RRECNO - + db_frecno - + db_recno - + db_rrecno - + frec - + frecno - + rec - + recno - + rrec - + rrecno { return "-recno" } + + default { error "FAIL:[timestamp] $method: unknown method" } + } +} + +# If recno-with-renumbering or btree-with-renumbering is specified, then +# fix the arguments to specify the DB_RENUMBER/DB_RECNUM option for the +# -flags argument. +proc convert_args { method {largs ""} } { + global fixed_len + global fixed_pad + global gen_upgrade + global upgrade_be + source ./include.tcl + + if { [string first - $largs] == -1 &&\ + [string compare $largs ""] != 0 } { + set errstring "args must contain a hyphen; does this test\ + have no numeric args?" + puts "FAIL:[timestamp] $errstring" + return -code return + } + + if { $gen_upgrade == 1 && $upgrade_be == 1 } { + append largs " -lorder 4321 " + } elseif { $gen_upgrade == 1 && $upgrade_be != 1 } { + append largs " -lorder 1234 " + } + + if { [is_rrecno $method] == 1 } { + append largs " -renumber " + } elseif { [is_rbtree $method] == 1 } { + append largs " -recnum " + } elseif { [is_dbtree $method] == 1 } { + append largs " -dup " + } elseif { [is_ddbtree $method] == 1 } { + append largs " -dup " + append largs " -dupsort " + } elseif { [is_dhash $method] == 1 } { + append largs " -dup " + } elseif { [is_queueext $method] == 1 } { + append largs " -extent 2 " + } + + if {[is_fixed_length $method] == 1} { + append largs " -len $fixed_len -pad $fixed_pad " + } + return $largs +} + +proc is_btree { method } { + set names { -btree BTREE DB_BTREE bt btree } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_dbtree { method } { + set names { -dbtree } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_ddbtree { method } { + set names { -ddbtree } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_rbtree { method } { + set names { -rbtree rbtree RBTREE db_rbtree DB_RBTREE rbt } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_recno { method } { + set names { -recno DB_RECNO RECNO db_recno rec recno} + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_rrecno { method } { + set names { -rrecno rrecno RRECNO db_rrecno DB_RRECNO rrec } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_frecno { method } { + set names { -frecno frecno frec FRECNO db_frecno DB_FRECNO} + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_hash { method } { + set names { -hash DB_HASH HASH db_hash h hash } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_dhash { method } { + set names { -dhash } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_queue { method } { + if { [is_queueext $method] == 1 } { + return 1 + } + + set names { -queue DB_QUEUE QUEUE db_queue q queue qam } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_queueext { method } { + set names { -queueextent queueextent QUEUEEXTENT qe qamext \ + queueext -queueext } + if { [lsearch $names $method] >= 0 } { + return 1 + } else { + return 0 + } +} + +proc is_record_based { method } { + if { [is_recno $method] || [is_frecno $method] || + [is_rrecno $method] || [is_queue $method] } { + return 1 + } else { + return 0 + } +} + +proc is_fixed_length { method } { + if { [is_queue $method] || [is_frecno $method] } { + return 1 + } else { + return 0 + } +} + +# Sort lines in file $in and write results to file $out. +# This is a more portable alternative to execing the sort command, +# which has assorted issues on NT [#1576]. +# The addition of a "-n" argument will sort numerically. +proc filesort { in out { arg "" } } { + set i [open $in r] + + set ilines {} + while { [gets $i line] >= 0 } { + lappend ilines $line + } + + if { [string compare $arg "-n"] == 0 } { + set olines [lsort -integer $ilines] + } else { + set olines [lsort $ilines] + } + + close $i + + set o [open $out w] + foreach line $olines { + puts $o $line + } + + close $o +} + +# Print lines up to the nth line of infile out to outfile, inclusive. +# The optional beg argument tells us where to start. +proc filehead { n infile outfile { beg 0 } } { + set in [open $infile r] + set out [open $outfile w] + + # Sed uses 1-based line numbers, and so we do too. + for { set i 1 } { $i < $beg } { incr i } { + if { [gets $in junk] < 0 } { + break + } + } + + for { } { $i <= $n } { incr i } { + if { [gets $in line] < 0 } { + break + } + puts $out $line + } + + close $in + close $out +} + +# Remove file (this replaces $RM). +# Usage: fileremove filenames =~ rm; fileremove -f filenames =~ rm -rf. +proc fileremove { args } { + set forceflag "" + foreach a $args { + if { [string first - $a] == 0 } { + # It's a flag. Better be f. + if { [string first f $a] != 1 } { + return -code error "bad flag to fileremove" + } else { + set forceflag "-force" + } + } else { + eval {file delete $forceflag $a} + } + } +} + +proc findfail { args } { + foreach a $args { + if { [file exists $a] == 0 } { + continue + } + set f [open $a r] + while { [gets $f line] >= 0 } { + if { [string first FAIL $line] == 0 } { + close $f + return 1 + } + } + close $f + } + return 0 +} + +# Sleep for s seconds. +proc tclsleep { s } { + # On Windows, the system time-of-day clock may update as much + # as 55 ms late due to interrupt timing. Don't take any + # chances; sleep extra-long so that when tclsleep 1 returns, + # it's guaranteed to be a new second. + after [expr $s * 1000 + 56] +} + +# Compare two files, a la diff. Returns 1 if non-identical, 0 if identical. +proc filecmp { file_a file_b } { + set fda [open $file_a r] + set fdb [open $file_b r] + + set nra 0 + set nrb 0 + + # The gets can't be in the while condition because we'll + # get short-circuit evaluated. + while { $nra >= 0 && $nrb >= 0 } { + set nra [gets $fda aline] + set nrb [gets $fdb bline] + + if { $nra != $nrb || [string compare $aline $bline] != 0} { + close $fda + close $fdb + return 1 + } + } + + close $fda + close $fdb + return 0 +} + +# Verify all .db files in the specified directory. +proc verify_dir { \ + {directory "./TESTDIR"} { pref "" } { noredo 0 } { quiet 0 } } { + # If we're doing database verification between tests, we don't + # want to do verification twice without an intervening cleanup--some + # test was skipped. Always verify by default (noredo == 0) so + # that explicit calls to verify_dir during tests don't require + # cleanup commands. + if { $noredo == 1 } { + if { [file exists $directory/NOREVERIFY] == 1 } { + if { $quiet == 0 } { + puts "Skipping verification." + } + return + } + set f [open $directory/NOREVERIFY w] + close $f + } + + if { [catch {glob $directory/*.db} dbs] != 0 } { + # No files matched + return + } + if { [file exists /dev/stderr] == 1 } { + set errfilearg "-errfile /dev/stderr " + } else { + set errfilearg "" + } + set errpfxarg {-errpfx "FAIL: verify" } + set errarg $errfilearg$errpfxarg + set ret 0 + foreach db $dbs { + if { [catch {eval {berkdb dbverify} $errarg $db} res] != 0 } { + puts $res + puts "FAIL:[timestamp] Verification of $db failed." + set ret 1 + } else { + error_check_good verify:$db $res 0 + if { $quiet == 0 } { + puts "${pref}Verification of $db succeeded." + } + } + } + return $ret +} + +# Generate randomly ordered, guaranteed-unique four-character strings that can +# be used to differentiate duplicates without creating duplicate duplicates. +# (test031 & test032) randstring_init is required before the first call to +# randstring and initializes things for up to $i distinct strings; randstring +# gets the next string. +proc randstring_init { i } { + global rs_int_list alphabet + + # Fail if we can't generate sufficient unique strings. + if { $i > [expr 26 * 26 * 26 * 26] } { + set errstring\ + "Duplicate set too large for random string generator" + puts "FAIL:[timestamp] $errstring" + return -code return $errstring + } + + set rs_int_list {} + + # generate alphabet array + for { set j 0 } { $j < 26 } { incr j } { + set a($j) [string index $alphabet $j] + } + + # Generate a list with $i elements, { aaaa, aaab, ... aaaz, aaba ...} + for { set d1 0 ; set j 0 } { $d1 < 26 && $j < $i } { incr d1 } { + for { set d2 0 } { $d2 < 26 && $j < $i } { incr d2 } { + for { set d3 0 } { $d3 < 26 && $j < $i } { incr d3 } { + for { set d4 0 } { $d4 < 26 && $j < $i } \ + { incr d4 } { + lappend rs_int_list \ + $a($d1)$a($d2)$a($d3)$a($d4) + incr j + } + } + } + } + + # Randomize the list. + set rs_int_list [randomize_list $rs_int_list] +} + +# Randomize a list. Returns a randomly-reordered copy of l. +proc randomize_list { l } { + set i [llength $l] + + for { set j 0 } { $j < $i } { incr j } { + # Pick a random element from $j to the end + set k [berkdb random_int $j [expr $i - 1]] + + # Swap it with element $j + set t1 [lindex $l $j] + set t2 [lindex $l $k] + + set l [lreplace $l $j $j $t2] + set l [lreplace $l $k $k $t1] + } + + return $l +} + +proc randstring {} { + global rs_int_list + + if { [info exists rs_int_list] == 0 || [llength $rs_int_list] == 0 } { + set errstring "randstring uninitialized or used too often" + puts "FAIL:[timestamp] $errstring" + return -code return $errstring + } + + set item [lindex $rs_int_list 0] + set rs_int_list [lreplace $rs_int_list 0 0] + + return $item +} + +# Takes a variable-length arg list, and returns a list containing the list of +# the non-hyphenated-flag arguments, followed by a list of each alphanumeric +# flag it finds. +proc extractflags { args } { + set inflags 1 + set flags {} + while { $inflags == 1 } { + set curarg [lindex $args 0] + if { [string first "-" $curarg] == 0 } { + set i 1 + while {[string length [set f \ + [string index $curarg $i]]] > 0 } { + incr i + if { [string compare $f "-"] == 0 } { + set inflags 0 + break + } else { + lappend flags $f + } + } + set args [lrange $args 1 end] + } else { + set inflags 0 + } + } + return [list $args $flags] +} + +# Wrapper for berkdb open, used throughout the test suite so that we can +# set an errfile/errpfx as appropriate. +proc berkdb_open { args } { + set errargs {} + if { [file exists /dev/stderr] == 1 } { + append errargs " -errfile /dev/stderr " + append errargs " -errpfx \\F\\A\\I\\L " + } + + eval {berkdb open} $errargs $args +} + +# Version without errpfx/errfile, used when we're expecting a failure. +proc berkdb_open_noerr { args } { + eval {berkdb open} $args +} + +proc check_handles { {outf stdout} } { + global ohandles + + set handles [berkdb handles] + if {[llength $handles] != [llength $ohandles]} { + puts $outf "WARNING: Open handles during cleanup: $handles" + } + set ohandles $handles +} + +proc open_handles { } { + return [llength [berkdb handles]] +} + +proc move_file_extent { dir dbfile tag op } { + set files [get_extfiles $dir $dbfile $tag] + foreach extfile $files { + set i [string last "." $extfile] + incr i + set extnum [string range $extfile $i end] + set dbq [make_ext_filename $dir $dbfile $extnum] + # + # We can either copy or rename + # + file $op -force $extfile $dbq + } +} + +proc copy_extent_file { dir dbfile tag { op copy } } { + set files [get_extfiles $dir $dbfile ""] + foreach extfile $files { + set i [string last "." $extfile] + incr i + set extnum [string range $extfile $i end] + file $op -force $extfile $dir/__dbq.$dbfile.$tag.$extnum + } +} + +proc get_extfiles { dir dbfile tag } { + if { $tag == "" } { + set filepat $dir/__dbq.$dbfile.\[0-9\]* + } else { + set filepat $dir/__dbq.$dbfile.$tag.\[0-9\]* + } + return [glob -nocomplain -- $filepat] +} + +proc make_ext_filename { dir dbfile extnum } { + return $dir/__dbq.$dbfile.$extnum +} + +# All pids for Windows 9X are negative values. When we want to have +# unsigned int values, unique to the process, we'll take the absolute +# value of the pid. This avoids unsigned/signed mistakes, yet +# guarantees uniqueness, since each system has pids that are all +# either positive or negative. +# +proc sanitized_pid { } { + set mypid [pid] + if { $mypid < 0 } { + set mypid [expr - $mypid] + } + puts "PID: [pid] $mypid\n" + return $mypid +} + +# +# Extract the page size field from a stat record. Return -1 if +# none is found. +# +proc get_pagesize { stat } { + foreach field $stat { + set title [lindex $field 0] + if {[string compare $title "Page size"] == 0} { + return [lindex $field 1] + } + } + return -1 +} diff --git a/bdb/test/txn.tcl b/bdb/test/txn.tcl new file mode 100644 index 00000000000..904ef5fdca0 --- /dev/null +++ b/bdb/test/txn.tcl @@ -0,0 +1,181 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1996, 1997, 1998, 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: txn.tcl,v 11.12 2000/12/31 19:26:23 bostic Exp $ +# +# Options are: +# -dir <directory in which to store memp> +# -max <max number of concurrent transactions> +# -iterations <iterations> +# -stat +proc txn_usage {} { + puts "txn -dir <directory> -iterations <number of ops> \ + -max <max number of transactions> -stat" +} + +proc txntest { args } { + source ./include.tcl + + # Set defaults + set iterations 50 + set max 1024 + set dostat 0 + set flags "" + for { set i 0 } { $i < [llength $args] } {incr i} { + switch -regexp -- [lindex $args $i] { + -d.* { incr i; set testdir [lindex $args $i] } + -f.* { incr i; set flags [lindex $args $i] } + -i.* { incr i; set iterations [lindex $args $i] } + -m.* { incr i; set max [lindex $args $i] } + -s.* { set dostat 1 } + default { + puts -nonewline "FAIL:[timestamp] Usage: " + txn_usage + return + } + } + } + if { $max < $iterations } { + set max $iterations + } + + # Now run the various functionality tests + txn001 $testdir $max $iterations $flags + txn002 $testdir $max $iterations +} + +proc txn001 { dir max ntxns flags} { + source ./include.tcl + + puts "Txn001: Basic begin, commit, abort" + + # Open environment + env_cleanup $dir + + set env [eval {berkdb \ + env -create -mode 0644 -txn -txn_max $max -home $dir} $flags] + error_check_good evn_open [is_valid_env $env] TRUE + txn001_suba $ntxns $env + txn001_subb $ntxns $env + txn001_subc $ntxns $env + # Close and unlink the file + error_check_good env_close:$env [$env close] 0 +} + +proc txn001_suba { ntxns env } { + source ./include.tcl + + # We will create a bunch of transactions and commit them. + set txn_list {} + set tid_list {} + puts "Txn001.a: Beginning/Committing $ntxns Transactions in $env" + for { set i 0 } { $i < $ntxns } { incr i } { + set txn [$env txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + + lappend txn_list $txn + + set tid [$txn id] + error_check_good tid_check [lsearch $tid_list $tid] -1 + + lappend tid_list $tid + } + + # Now commit them all + foreach t $txn_list { + error_check_good txn_commit:$t [$t commit] 0 + } +} + +proc txn001_subb { ntxns env } { + # We will create a bunch of transactions and abort them. + set txn_list {} + set tid_list {} + puts "Txn001.b: Beginning/Aborting Transactions" + for { set i 0 } { $i < $ntxns } { incr i } { + set txn [$env txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + + lappend txn_list $txn + + set tid [$txn id] + error_check_good tid_check [lsearch $tid_list $tid] -1 + + lappend tid_list $tid + } + + # Now abort them all + foreach t $txn_list { + error_check_good txn_abort:$t [$t abort] 0 + } +} + +proc txn001_subc { ntxns env } { + # We will create a bunch of transactions and commit them. + set txn_list {} + set tid_list {} + puts "Txn001.c: Beginning/Prepare/Committing Transactions" + for { set i 0 } { $i < $ntxns } { incr i } { + set txn [$env txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + + lappend txn_list $txn + + set tid [$txn id] + error_check_good tid_check [lsearch $tid_list $tid] -1 + + lappend tid_list $tid + } + + # Now prepare them all + foreach t $txn_list { + error_check_good txn_prepare:$t [$t prepare] 0 + } + + # Now commit them all + foreach t $txn_list { + error_check_good txn_commit:$t [$t commit] 0 + } + +} + +# Verify that read-only transactions do not create any log records +proc txn002 { dir max ntxns } { + source ./include.tcl + + puts "Txn002: Read-only transaction test" + + env_cleanup $dir + set env [berkdb \ + env -create -mode 0644 -txn -txn_max $max -home $dir] + error_check_good dbenv [is_valid_env $env] TRUE + + # We will create a bunch of transactions and commit them. + set txn_list {} + set tid_list {} + puts "Txn002.a: Beginning/Committing Transactions" + for { set i 0 } { $i < $ntxns } { incr i } { + set txn [$env txn] + error_check_good txn_begin [is_valid_txn $txn $env] TRUE + + lappend txn_list $txn + + set tid [$txn id] + error_check_good tid_check [lsearch $tid_list $tid] -1 + + lappend tid_list $tid + } + + # Now commit them all + foreach t $txn_list { + error_check_good txn_commit:$t [$t commit] 0 + } + + # Now verify that there aren't any log records. + set r [$env log_get -first] + error_check_good log_get:$r [llength $r] 0 + + error_check_good env_close:$r [$env close] 0 +} diff --git a/bdb/test/update.tcl b/bdb/test/update.tcl new file mode 100644 index 00000000000..81fc9ba9e2c --- /dev/null +++ b/bdb/test/update.tcl @@ -0,0 +1,92 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: update.tcl,v 11.9 2000/10/27 13:23:56 sue Exp $ +source ./include.tcl +global update_dir +set update_dir "$test_path/update_test" + +proc update { } { + source ./include.tcl + global update_dir + + foreach version [glob $update_dir/*] { + regexp \[^\/\]*$ $version version + foreach method [glob $update_dir/$version/*] { + regexp \[^\/\]*$ $method method + foreach file [glob $update_dir/$version/$method/*] { + regexp (\[^\/\]*)\.tar\.gz$ $file dummy name + foreach endianness {"le" "be"} { + puts "Update:\ + $version $method $name $endianness" + set ret [catch {_update $update_dir $testdir $version $method $name $endianness 1 1} message] + if { $ret != 0 } { + puts $message + } + } + } + } + } +} + +proc _update { source_dir temp_dir \ + version method file endianness do_db_load_test do_update_test } { + source include.tcl + global errorInfo + + cleanup $temp_dir NULL + + exec sh -c \ +"gzcat $source_dir/$version/$method/$file.tar.gz | (cd $temp_dir && tar xf -)" + + if { $do_db_load_test } { + set ret [catch \ + {exec $util_path/db_load -f "$temp_dir/$file.dump" \ + "$temp_dir/update.db"} message] + error_check_good \ + "Update load: $version $method $file $message" $ret 0 + + set ret [catch \ + {exec $util_path/db_dump -f "$temp_dir/update.dump" \ + "$temp_dir/update.db"} message] + error_check_good \ + "Update dump: $version $method $file $message" $ret 0 + + error_check_good "Update diff.1.1: $version $method $file" \ + [filecmp "$temp_dir/$file.dump" "$temp_dir/update.dump"] 0 + error_check_good \ + "Update diff.1.2: $version $method $file" $ret "" + } + + if { $do_update_test } { + set ret [catch \ + {berkdb open -update "$temp_dir/$file-$endianness.db"} db] + if { $ret == 1 } { + if { ![is_substr $errorInfo "version upgrade"] } { + set fnl [string first "\n" $errorInfo] + set theError \ + [string range $errorInfo 0 [expr $fnl - 1]] + error $theError + } + } else { + error_check_good dbopen [is_valid_db $db] TRUE + error_check_good dbclose [$db close] 0 + + set ret [catch \ + {exec $util_path/db_dump -f \ + "$temp_dir/update.dump" \ + "$temp_dir/$file-$endianness.db"} message] + error_check_good "Update\ + dump: $version $method $file $message" $ret 0 + + error_check_good \ + "Update diff.2: $version $method $file" \ + [filecmp "$temp_dir/$file.dump" \ + "$temp_dir/update.dump"] 0 + error_check_good \ + "Update diff.2: $version $method $file" $ret "" + } + } +} diff --git a/bdb/test/upgrade.tcl b/bdb/test/upgrade.tcl new file mode 100644 index 00000000000..0d2f656bcf9 --- /dev/null +++ b/bdb/test/upgrade.tcl @@ -0,0 +1,279 @@ +# See the file LICENSE for redistribution information. +# +# Copyright (c) 1999, 2000 +# Sleepycat Software. All rights reserved. +# +# $Id: upgrade.tcl,v 11.16 2000/10/27 13:23:56 sue Exp $ + +source ./include.tcl + +global upgrade_dir +# set upgrade_dir "$test_path/upgrade_test" +set upgrade_dir "$test_path/upgrade/databases" + +global gen_upgrade +set gen_upgrade 0 + +global upgrade_dir +global upgrade_be +global upgrade_method + +proc upgrade { { archived_test_loc "DEFAULT" } } { + source ./include.tcl + global upgrade_dir + + set saved_upgrade_dir $upgrade_dir + + puts -nonewline "Upgrade test: " + if { $archived_test_loc == "DEFAULT" } { + puts "using default archived databases in $upgrade_dir." + } else { + set upgrade_dir $archived_test_loc + puts "using archived databases in $upgrade_dir." + } + + foreach version [glob $upgrade_dir/*] { + if { [string first CVS $version] != -1 } { continue } + regexp \[^\/\]*$ $version version + foreach method [glob $upgrade_dir/$version/*] { + regexp \[^\/\]*$ $method method + foreach file [glob $upgrade_dir/$version/$method/*] { + regexp (\[^\/\]*)\.tar\.gz$ $file dummy name + + cleanup $testdir NULL + #puts "$upgrade_dir/$version/$method/$name.tar.gz" + set curdir [pwd] + cd $testdir + set tarfd [open "|tar xf -" w] + cd $curdir + + catch {exec gunzip -c "$upgrade_dir/$version/$method/$name.tar.gz" >@$tarfd} + close $tarfd + + set f [open $testdir/$name.tcldump {RDWR CREAT}] + close $f + + # It may seem suboptimal to exec a separate + # tclsh for each subtest, but this is + # necessary to keep the testing process + # from consuming a tremendous amount of + # memory. + if { [file exists $testdir/$name-le.db] } { + set ret [catch {exec $tclsh_path\ + << "source $test_path/test.tcl;\ + _upgrade_test $testdir $version\ + $method\ + $name le"} message] + puts $message + if { $ret != 0 } { + #exit + } + } + + if { [file exists $testdir/$name-be.db] } { + set ret [catch {exec $tclsh_path\ + << "source $test_path/test.tcl;\ + _upgrade_test $testdir $version\ + $method\ + $name be"} message] + puts $message + if { $ret != 0 } { + #exit + } + } + + set ret [catch {exec $tclsh_path\ + << "source $test_path/test.tcl;\ + _db_load_test $testdir $version $method\ + $name"} message] + puts $message + if { $ret != 0 } { + #exit + } + + } + } + } + set upgrade_dir $saved_upgrade_dir + + # Don't provide a return value. + return +} + +proc _upgrade_test { temp_dir version method file endianness } { + source include.tcl + global errorInfo + + puts "Upgrade: $version $method $file $endianness" + + set ret [berkdb upgrade "$temp_dir/$file-$endianness.db"] + error_check_good dbupgrade $ret 0 + + upgrade_dump "$temp_dir/$file-$endianness.db" "$temp_dir/temp.dump" + + error_check_good "Upgrade diff.$endianness: $version $method $file" \ + [filecmp "$temp_dir/$file.tcldump" "$temp_dir/temp.dump"] 0 +} + +proc _db_load_test { temp_dir version method file } { + source include.tcl + global errorInfo + + puts "db_load: $version $method $file" + + set ret [catch \ + {exec $util_path/db_load -f "$temp_dir/$file.dump" \ + "$temp_dir/upgrade.db"} message] + error_check_good \ + "Upgrade load: $version $method $file $message" $ret 0 + + upgrade_dump "$temp_dir/upgrade.db" "$temp_dir/temp.dump" + + error_check_good "Upgrade diff.1.1: $version $method $file" \ + [filecmp "$temp_dir/$file.tcldump" "$temp_dir/temp.dump"] 0 +} + +proc gen_upgrade { dir } { + global gen_upgrade + global upgrade_dir + global upgrade_be + global upgrade_method + global runtests + source ./include.tcl + + set gen_upgrade 1 + set upgrade_dir $dir + + foreach upgrade_be { 0 1 } { + foreach i "btree rbtree hash recno rrecno queue frecno" { + puts "Running $i tests" + set upgrade_method $i + set start 1 + for { set j $start } { $j <= $runtests } {incr j} { + if [catch {exec $tclsh_path \ + << "source $test_path/test.tcl;\ + global upgrade_be;\ + set upgrade_be $upgrade_be;\ + run_method -$i $j $j"} res] { + puts "FAIL: [format "test%03d" $j] $i" + } + puts $res + cleanup $testdir NULL + } + } + } + + set gen_upgrade 0 +} + +proc upgrade_dump { database file {stripnulls 0} } { + global errorInfo + + set db [berkdb open $database] + set dbc [$db cursor] + + set f [open $file w+] + fconfigure $f -encoding binary -translation binary + + # + # Get a sorted list of keys + # + set key_list "" + set pair [$dbc get -first] + + while { 1 } { + if { [llength $pair] == 0 } { + break + } + set k [lindex [lindex $pair 0] 0] + lappend key_list $k + set pair [$dbc get -next] + } + + # Discard duplicated keys; we now have a key for each + # duplicate, not each unique key, and we don't want to get each + # duplicate multiple times when we iterate over key_list. + set uniq_keys "" + foreach key $key_list { + if { [info exists existence_list($key)] == 0 } { + lappend uniq_keys $key + } + set existence_list($key) 1 + } + set key_list $uniq_keys + + set key_list [lsort -command _comp $key_list] + + # + # Get the data for each key + # + set i 0 + foreach key $key_list { + set pair [$dbc get -set $key] + if { $stripnulls != 0 } { + # the Tcl interface to db versions before 3.X + # added nulls at the end of all keys and data, so + # we provide functionality to strip that out. + set key [strip_null $key] + } + set data_list {} + catch { while { [llength $pair] != 0 } { + set data [lindex [lindex $pair 0] 1] + if { $stripnulls != 0 } { + set data [strip_null $data] + } + lappend data_list [list $data] + set pair [$dbc get -nextdup] + } } + #lsort -command _comp data_list + set data_list [lsort -command _comp $data_list] + puts -nonewline $f [binary format i [string length $key]] + puts -nonewline $f $key + puts -nonewline $f [binary format i [llength $data_list]] + for { set j 0 } { $j < [llength $data_list] } { incr j } { + puts -nonewline $f [binary format i [string length [concat [lindex $data_list $j]]]] + puts -nonewline $f [concat [lindex $data_list $j]] + } + if { [llength $data_list] == 0 } { + puts "WARNING: zero-length data list" + } + incr i + } + + close $f +} + +proc _comp { a b } { + if { 0 } { + # XXX + set a [strip_null [concat $a]] + set b [strip_null [concat $b]] + #return [expr [concat $a] < [concat $b]] + } else { + set an [string first "\0" $a] + set bn [string first "\0" $b] + + if { $an != -1 } { + set a [string range $a 0 [expr $an - 1]] + } + if { $bn != -1 } { + set b [string range $b 0 [expr $bn - 1]] + } + } + #puts "$a $b" + return [string compare $a $b] +} + +proc strip_null { str } { + set len [string length $str] + set last [expr $len - 1] + + set termchar [string range $str $last $last] + if { [string compare $termchar \0] == 0 } { + set ret [string range $str 0 [expr $last - 1]] + } else { + set ret $str + } + + return $ret +} diff --git a/bdb/test/upgrade/README b/bdb/test/upgrade/README new file mode 100644 index 00000000000..1afada2ecf4 --- /dev/null +++ b/bdb/test/upgrade/README @@ -0,0 +1,85 @@ + The Berkeley DB Upgrade Tests + +Quick ref: + + Running the tests: + (in tclsh) + % source ../test/test.tcl + % upgrade + + Generating the test databases: + (in tclsh) + % source ../test/test.tcl + % gen_upgrade /where/you/want/them + + (in your shell) + $ cd /where/you/want/them + $ perl $db_dir/upgrade/scripts/pack-3.0.pl + $ mv 3.0 $db_dir/upgrade/databases + +What they are: + +The DB upgrade tests are a framework for testing two main features of +Berkeley DB: the db_dump utility, and the "DB_UPGRADE" flag to DB->open. +They work by taking a tarred, gzipped set of test databases and dumps, and +verifying that the set of items is the same in the original database (as +dumped by the version of DB that created it) as in the upgraded one, +and is the same in the original database and in a new database generated by +db_loading a db_dump. + +In db 3.X and higher, the upgrade test is repeated on a database with +the opposite endianness to the system the database was generated on. + +How to generate test databases: + +Ordinarily, this is something that only very rarely has to occur; +an archive of upgrade test databases can and should be kept, so ideally +the generation step only needs to be done once for each major DB release. + +To generate the test databases, execute the command "gen_upgrade <dir>" +inside a tclsh. The method tests will run twice, once for each endianness, +and all the databases will be saved in a hierarchy named by <dir>. + +Once the databases have been built, the archives expected by the upgrade tests +must be built using the "pack" script, in upgrade/scripts/pack-<version>.pl. +This script must be edited slightly to specify the location on a given system +of the DB source tree and utilities; it then converts the set of databases +under the current working directory into a set of .tar.gz files containing +the databases as well as flat files with their contents in item-by-item and +db_dump formats. + +How to run the upgrade tests: + +Run "upgrade" from tclsh in the DB build directory. By default, this +looks in upgrade/databases, in the DB source tree. An optional first argument +can be used to specify an alternate directory. + +A note on 2.X tests: + +The 2.X packing script, as well as a patch against a 2.6.6 test directory +to allow it to generate test databases, is in upgrade/generate-2.X. + +Note that the upgrade tests can be *run* on an the 2.X test archives +without anything in this directory. It is provided only for +archival reasons, in case there is ever reason to generate a new +set of test databases. + +XXX: Note also that it quite likely has paths hard-coded for a specific +system that is not yours. + +Known Issues: + +1. The following 2.X databases trigger a bug in the db 2.X hash code. +This bug affects only empty and near-empty databases, and has been +corrected in db 3.X, but it will prevent the following from passing +the db_dump test. (They have been removed from the canonical database +collection.) + + 2.X hash -- test026 + 2.X hash -- test038 + 2.X hash -- test039 + 2.X hash -- test040 + +2. The 2.X recno versions of test043 cannot be made to pass the db_dump +test because the 2.X version of db_dump has no -k flag and cannot preserve +sparsely populated databases. diff --git a/bdb/test/upgrade/generate-2.X/pack-2.6.6.pl b/bdb/test/upgrade/generate-2.X/pack-2.6.6.pl new file mode 100644 index 00000000000..f031d46ca62 --- /dev/null +++ b/bdb/test/upgrade/generate-2.X/pack-2.6.6.pl @@ -0,0 +1,114 @@ +#!/usr/bin/perl + +use strict; +use Archive::Tar; + +my $subdir; +my $file; +my $archive_name; + +my $version = "2.6.6"; +my $build_dir = "/work/db/upgrade/db-2.6.6/build_unix"; +my $db_dump_path = "$build_dir/db_dump"; +my $pwd = `pwd`; + +$| = 1; + +chomp( $pwd ); + +opendir( DIR, $version . "le" ) || die; +while( $subdir = readdir( DIR ) ) +{ + if( $subdir !~ m{^\.\.?$} ) + { + opendir( SUBDIR, $version . "le/$subdir" ) || die; + while( $file = readdir( SUBDIR ) ) + { + if( $file !~ m{^\.\.?$} ) + { + print "[" . localtime() . "] " . "$subdir $file", "\n"; + + eval + { + my $data; + my $archive; + + system( "mkdir", "-p", "$version/$subdir" ); + $file =~ m{(.*)\.}; + $archive_name = "$1"; + $archive_name =~ s{Test}{test}; + $archive = Archive::Tar->new(); + $archive->add_data( "$archive_name-le.db", + read_file( $version . "le/$subdir/$file" ) ); +# $archive->add_data( "$archive_name-be.db", +# read_file( $version . "be/$subdir/$file" ) ); + $archive->add_data( "$archive_name.dump", + db_dump( "$pwd/$version" . "le/$subdir/$file" ) ); + $data = tcl_dump( "$pwd/$version" . "le/$subdir/$file" ); + $archive->add_data( "$archive_name.tcldump", $data ); + $archive->write( "$version/$subdir/$archive_name.tar.gz", 9 ); + }; + if( $@ ) + { + print( "Could not process $file: $@\n" ); + } + } + } + } +} + +sub read_file +{ + my ($file) = @_; + my $data; + + open( FILE, "<$file" ) || die; + read( FILE, $data, -s $file ); + close( file ); + + return $data; +} + +sub db_dump +{ + my ($file) = @_; + + #print $file, "\n"; + unlink( "temp.dump" ); + system( "sh", "-c", "$db_dump_path $file >temp.dump" ) && die; + if( -e "temp.dump" ) + { + return read_file( "temp.dump" ); + } + else + { + die "db_dump failure: $file\n"; + } +} + +sub tcl_dump +{ + my ($file) = @_; + my $up_dump_args = ""; + + if ($file =~ /test012/) { + $up_dump_args .= "1"; + } + + unlink( "temp.dump" ); + open( TCL, "|$build_dir/dbtest" ); +print TCL <<END; +cd $build_dir +source ../test/test.tcl +upgrade_dump $file $pwd/temp.dump $up_dump_args +END + close( TCL ); + if( -e "temp.dump" ) + { + return read_file( "temp.dump" ); + } + else + { + die "TCL dump failure: $file\n"; + } +} diff --git a/bdb/test/upgrade/generate-2.X/test-2.6.patch b/bdb/test/upgrade/generate-2.X/test-2.6.patch new file mode 100644 index 00000000000..557e8061eae --- /dev/null +++ b/bdb/test/upgrade/generate-2.X/test-2.6.patch @@ -0,0 +1,379 @@ +diff -crN test.orig/test.tcl test/test.tcl +*** test.orig/test.tcl Fri Dec 11 14:56:26 1998 +--- test/test.tcl Mon Oct 4 15:26:16 1999 +*************** +*** 8,13 **** +--- 8,14 ---- + source ./include.tcl + source ../test/testutils.tcl + source ../test/byteorder.tcl ++ source ../test/upgrade.tcl + + set testdir ./TESTDIR + if { [file exists $testdir] != 1 } { +*************** +*** 114,119 **** +--- 115,124 ---- + global debug_print + global debug_on + global runtests ++ ++ global __method ++ set __method $method ++ + if { $stop == 0 } { + set stop $runtests + } +diff -crN test.orig/testutils.tcl test/testutils.tcl +*** test.orig/testutils.tcl Tue Dec 15 07:58:51 1998 +--- test/testutils.tcl Wed Oct 6 17:40:45 1999 +*************** +*** 680,690 **** +--- 680,698 ---- + + proc cleanup { dir } { + source ./include.tcl ++ global __method ++ global errorInfo + # Remove the database and environment. + txn_unlink $dir 1 + memp_unlink $dir 1 + log_unlink $dir 1 + lock_unlink $dir 1 ++ ++ catch { exec mkdir -p /work/upgrade/2.6/$__method } res ++ puts $res ++ catch { exec sh -c "mv $dir/*.db /work/upgrade/2.6/$__method" } res ++ puts $res ++ + set ret [catch { glob $dir/* } result] + if { $ret == 0 } { + eval exec $RM -rf $result +diff -crN test.orig/upgrade.tcl test/upgrade.tcl +*** test.orig/upgrade.tcl Wed Dec 31 19:00:00 1969 +--- test/upgrade.tcl Mon Oct 18 21:22:39 1999 +*************** +*** 0 **** +--- 1,322 ---- ++ # See the file LICENSE for redistribution information. ++ # ++ # Copyright (c) 1999 ++ # Sleepycat Software. All rights reserved. ++ # ++ # @(#)upgrade.tcl 11.1 (Sleepycat) 8/23/99 ++ # ++ source ./include.tcl ++ global gen_upgrade ++ set gen_upgrade 0 ++ global upgrade_dir ++ set upgrade_dir "/work/upgrade/DOTEST" ++ global upgrade_be ++ global upgrade_method ++ ++ proc upgrade { } { ++ source ./include.tcl ++ global upgrade_dir ++ ++ foreach version [glob $upgrade_dir/*] { ++ regexp \[^\/\]*$ $version version ++ foreach method [glob $upgrade_dir/$version/*] { ++ regexp \[^\/\]*$ $method method ++ foreach file [glob $upgrade_dir/$version/$method/*] { ++ puts $file ++ regexp (\[^\/\]*)\.tar\.gz$ $file dummy name ++ foreach endianness {"le" "be"} { ++ puts "Update: $version $method $name $endianness" ++ set ret [catch {_upgrade $upgrade_dir $testdir $version $method $name $endianness 1 1} message] ++ if { $ret != 0 } { ++ puts $message ++ } ++ } ++ } ++ } ++ } ++ } ++ ++ proc _upgrade { source_dir temp_dir version method file endianness do_db_load_test do_upgrade_test } { ++ source include.tcl ++ global errorInfo ++ ++ cleanup $temp_dir ++ ++ exec tar zxf "$source_dir/$version/$method/$file.tar.gz" -C $temp_dir ++ ++ if { $do_db_load_test } { ++ set ret [catch \ ++ {exec ./db_load -f "$temp_dir/$file.dump" \ ++ "$temp_dir/upgrade.db"} message] ++ error_check_good \ ++ "Update load: $version $method $file $message" $ret 0 ++ ++ set ret [catch \ ++ {exec ./db_dump -f "$temp_dir/upgrade.dump" \ ++ "$temp_dir/upgrade.db"} message] ++ error_check_good \ ++ "Update dump: $version $method $file $message" $ret 0 ++ ++ error_check_good "Update diff.1.1: $version $method $file" \ ++ [catch { exec $CMP "$temp_dir/$file.dump" "$temp_dir/upgrade.dump" } ret] 0 ++ error_check_good "Update diff.1.2: $version $method $file" $ret "" ++ } ++ ++ if { $do_upgrade_test } { ++ set ret [catch {berkdb open -upgrade "$temp_dir/$file-$endianness.db"} db] ++ if { $ret == 1 } { ++ if { ![is_substr $errorInfo "version upgrade"] } { ++ set fnl [string first "\n" $errorInfo] ++ set theError [string range $errorInfo 0 [expr $fnl - 1]] ++ error $theError ++ } ++ } else { ++ error_check_good dbopen [is_valid_db $db] TRUE ++ error_check_good dbclose [$db close] 0 ++ ++ set ret [catch \ ++ {exec ./db_dump -f "$temp_dir/upgrade.dump" \ ++ "$temp_dir/$file-$endianness.db"} message] ++ error_check_good \ ++ "Update dump: $version $method $file $message" $ret 0 ++ ++ error_check_good "Update diff.2: $version $method $file" \ ++ [catch { exec $CMP "$temp_dir/$file.dump" "$temp_dir/upgrade.dump" } ret] 0 ++ error_check_good "Update diff.2: $version $method $file" $ret "" ++ } ++ } ++ } ++ ++ proc gen_upgrade { dir } { ++ global gen_upgrade ++ global upgrade_dir ++ global upgrade_be ++ global upgrade_method ++ global __method ++ global runtests ++ source ./include.tcl ++ set tclsh_path "/work/db/upgrade/db-2.6.6/build_unix/dbtest" ++ ++ set gen_upgrade 1 ++ set upgrade_dir $dir ++ ++ foreach upgrade_be { 0 1 } { ++ foreach i "rrecno" { ++ # "hash btree rbtree hash recno rrecno" ++ puts "Running $i tests" ++ set upgrade_method $i ++ for { set j 1 } { $j <= $runtests } {incr j} { ++ if [catch {exec $tclsh_path \ ++ << "source ../test/test.tcl; \ ++ run_method $i $j $j"} res] { ++ puts "FAIL: [format "test%03d" $j] $i" ++ } ++ puts $res ++ set __method $i ++ cleanup $testdir ++ } ++ } ++ } ++ ++ set gen_upgrade 0 ++ } ++ ++ proc upgrade_dump { database file {with_binkey 0} } { ++ source ./include.tcl ++ global errorInfo ++ ++ set is_recno 0 ++ ++ set db [dbopen $database 0 0600 DB_UNKNOWN] ++ set dbc [$db cursor 0] ++ ++ set f [open $file w+] ++ fconfigure $f -encoding binary -translation binary ++ ++ # ++ # Get a sorted list of keys ++ # ++ set key_list "" ++ if { [catch {set pair [$dbc get "" $DB_FIRST]}] != 0 } { ++ set pair [$dbc get 0 $DB_FIRST] ++ set is_recno 1 ++ } ++ ++ while { 1 } { ++ if { [llength $pair] == 0 } { ++ break ++ } ++ lappend key_list [list [lindex $pair 0]] ++ set pair [$dbc get 0 $DB_NEXT] ++ } ++ ++ ++ # Discard duplicated keys; we now have a key for each ++ # duplicate, not each unique key, and we don't want to get each ++ # duplicate multiple times when we iterate over key_list. ++ set uniq_keys {} ++ foreach key $key_list { ++ if { [info exists existence_list($key)] == 0 } { ++ lappend uniq_keys [list $key] ++ } ++ set existence_list($key) 1 ++ } ++ set key_list $uniq_keys ++ ++ set key_list [lsort -command _comp $key_list] ++ ++ #foreach llave $key_list { ++ # puts $llave ++ #} ++ ++ # ++ # Get the data for each key ++ # ++ ++ for { set i 0 } { $i < [llength $key_list] } { incr i } { ++ set key [concat [lindex $key_list $i]] ++ # XXX Gross awful hack. We want to DB_SET in the vast ++ # majority of cases, but DB_SET can't handle binary keys ++ # in the 2.X Tcl interface. So we look manually and linearly ++ # for the key we want if with_binkey == 1. ++ if { $with_binkey != 1 } { ++ set pair [$dbc get $key $DB_SET] ++ } else { ++ set pair [_search_binkey $key $dbc] ++ } ++ if { $is_recno != 1 } { ++ set key [upgrade_convkey $key $dbc] ++ } ++ #puts "pair:$pair:[lindex $pair 1]" ++ set data [lindex $pair 1] ++ set data [upgrade_convdata $data $dbc] ++ set data_list [list $data] ++ catch { while { $is_recno == 0 } { ++ set pair [$dbc get 0 $DB_NEXT_DUP] ++ if { [llength $pair] == 0 } { ++ break ++ } ++ ++ set data [lindex $pair 1] ++ set data [upgrade_convdata $data $dbc] ++ lappend data_list [list $data] ++ } } ++ set data_list [lsort -command _comp $data_list] ++ puts -nonewline $f [binary format i [string length $key]] ++ puts -nonewline $f $key ++ puts -nonewline $f [binary format i [llength $data_list]] ++ for { set j 0 } { $j < [llength $data_list] } { incr j } { ++ puts -nonewline $f [binary format i [string length [concat [lindex $data_list $j]]]] ++ puts -nonewline $f [concat [lindex $data_list $j]] ++ } ++ } ++ ++ close $f ++ } ++ ++ proc _comp { a b } { ++ # return expr [[concat $a] < [concat $b]] ++ return [string compare [concat $a] [concat $b]] ++ } ++ ++ # Converts a key to the format of keys in the 3.X Tcl interface ++ proc upgrade_convkey { key dbc } { ++ source ./include.tcl ++ ++ # Stick a null on the end. ++ set k "$key\0" ++ ++ set tmp $testdir/gb0 ++ ++ # Attempt a dbc getbinkey to get any additional parts of the key. ++ set dbt [$dbc getbinkey $tmp 0 $DB_CURRENT] ++ ++ set tmpid [open $tmp r] ++ fconfigure $tmpid -encoding binary -translation binary ++ set cont [read $tmpid] ++ ++ set k $k$cont ++ ++ close $tmpid ++ ++ exec $RM -f $tmp ++ ++ return $k ++ } ++ ++ # Converts a datum to the format of data in the 3.X Tcl interface ++ proc upgrade_convdata { data dbc } { ++ source ./include.tcl ++ set is_partial 0 ++ ++ # Get the datum out of "data" ++ if { [llength $data] == 1 } { ++ set d [lindex $data 0] ++ } elseif { [llength $data] == 2 } { ++ # It was a partial return; the first arg is the number of nuls ++ set d [lindex $data 1] ++ set numnul [lindex $data 0] ++ while { $numnul > 0 } { ++ set d "\0$d" ++ incr numnul -1 ++ } ++ ++ # The old Tcl getbin and the old Tcl partial put ++ # interface are incompatible; we'll wind up returning ++ # the datum twice if we try a getbin now. So ++ # set a flag to avoid it. ++ set is_partial 1 ++ ++ } else { ++ set d $data ++ } ++ ++ ++ if { $is_partial != 1 } { ++ ++ # Stick a null on the end. ++ set d "$d\0" ++ ++ set tmp $testdir/gb1 ++ ++ # Attempt a dbc getbin to get any additional parts of the datum ++ # the Tcl interface has neglected. ++ set dbt [$dbc getbin $tmp 0 $DB_CURRENT] ++ ++ set tmpid [open $tmp r] ++ fconfigure $tmpid -encoding binary -translation binary ++ set cont [read $tmpid] ++ ++ set d $d$cont ++ ++ #puts "$data->$d" ++ ++ close $tmpid ++ } ++ ++ return [list $d] ++ } ++ ++ # Implement the DB_SET functionality, stupidly, in terms of DB_NEXT and ++ # manual comparisons. We have to use this instead of DB_SET with ++ # binary keys, as the old Tcl interface can't handle binary keys but DB_SET ++ # requires them. So instead, we page through using DB_NEXT, which returns ++ # the binary keys only up to the first null, and compare to our specified ++ # key, which is similarly truncated. ++ # ++ # This is really slow, but is seldom used. ++ proc _search_binkey { key dbc } { ++ #puts "doing _search_binkey $key $dbc" ++ source ./include.tcl ++ set dbt [$dbc get 0 $DB_FIRST] ++ while { [llength $dbt] != 0 } { ++ set curkey [lindex $dbt 0] ++ if { [string compare $key $curkey] == 0 } { ++ return $dbt ++ } ++ set dbt [$dbc get 0 $DB_NEXT] ++ } ++ ++ # We didn't find it. Return an empty list. ++ return {} ++ } diff --git a/bdb/test/wordlist b/bdb/test/wordlist new file mode 100644 index 00000000000..03ea15f7277 --- /dev/null +++ b/bdb/test/wordlist @@ -0,0 +1,10001 @@ +cooperate +benighted +apologist's +addresser +cataract +colonially +atoned +avow +bathroom +anaesthesia +columnated +bogs +astral +barbed +captives +acclaims +adjutants +affidavits +baptisms +bubbling +classic +allaying +component +battlement +backtrack + +courage +bore +advertisement +attests +bunny's +airlifts +cajole +cataloging +airily +collected +abridged +compel +aftermath +barrow +approve +chillier +bequest +attendant +abjures +adjudication +banished +asymptotes +borrower +caustic +claim +cohabitation +corporacies +buoy +benchmark's +averting +anecdote's +caress +annihilate +cajoles +anywhere +apparitions +coves +bribed +casually +clue's +asserted +architects +abstained +attitude +accumulating +coalesced +angelic +agnostic +breathed +bother +congregating +amatory +caging +countryside +chapel +buttonhole +bartenders +bridging +bombardment +accurately +confirmed +alleviated +acquiring +bruise +antelope +albums +allusive +corker +cavity's +compliment +climb +caterpillar +almond +authenticated +balkan +assembly's +acidity +abases +bonny +been +abbots +abductor's +aerials +cancels +chalked +beeps +affirms +contrariness +clearest +appropriations +critiquing +affluence +bouts +abiding +comprises +brunches +biology +conceptualization's +assaying +abutter +adorable +beatable +appenders +aggressors +agrarian +bottleneck +angled +beholds +bereaved +creation +animated +candied +bar +aeronautics +cousin's +cleaver +alienation +billet +bungler +contention +businessman +braids +assert +boisterous +consolidate +breathing +ballot +averted +conscientiously +bellow +brazenness +coaches +bulldog +classify +checksum +almond's +cornered +caskets +capacitors +beefer +connoisseurs +consisted +adore +circumvented +colonels +addenda +boost +compatibility's +bumblebee +commonest +containment +active +absorption's +creaks +administer +beset +aborted +aforesaid +aridity +broken +azimuths +aerial +addition's +aggrieve +anthology +circuitous +checks +alley's +beam +boss +corrupting +absolutes +asteroid's +bandstands +beatitude's +analogue's +busts +confession +bedstead +affairs +blackmailers +collared +buckboard +assassin +accessor +adjudging +binders +constituent's +blister +aromas +approved +absorbent +barbarously +cat's +builder +brandish +assailing +constitute +christening +acutely +amount +blurry +blocks +advertise +chain +brigade's +confusion +beds +arrangers +colonizers +beautifying +bankruptcy +bedazzles +candidates +clearness +admonishment's +behind +abbreviations +basting +ballasts +amateurism +celled +constituted +bonfire +bugled +advisee's +battled +budded +burners +causeway's +calibrate +brambly +befuddles +azure +busiest +admiringly +appropriator +accumulator +cables +abhor +civil +botulinus +creaked +bismuth +astronomical +abscissas +bodice +aunt +cascades +cares +comradeship +assemblages +boater +bellmen +admission's +ambitious +baldness +abortive +controlled +chinked +coded +courtrooms +arteriolar +cooler's +cared +brewer +christians +barbecues +contacts +blackjack's +buzzing +blasters +accords +braziers +allegretto +catered +breveting +cleaning +amicably +bummed +consulted +allegro's +accumulator's +compartmented +condemned +concludes +bitwise +cheered +appropriator's +accessors +casting +carolina's +accompanying +budding +correspond +bach's +angel's +bearing +arresters +biweekly +character +badgering +cantankerous +avalanching +adjudges +barometer +append +continuations +burped +boxtop's +abstention +amp +axiomatized +bimonthlies +aghast +arresting +breakwater's +continuing +bridle +bobbin's +antagonistically +blindly +biochemical +biologically +antifundamentalist +confer +cloudiness +bonded +comfortingly +caption +blackmailed +bidders +breakpoint +brigadier +criminals +coyotes +casserole's +annex +cereals +breadboxes +belgian +conductivity +counterexample +anarchist +couches +atavistic +clipped +button +axiomatic +capping +correcting +chase +chastise +angle +burnished +beauteously +antipodes +crippling +crowns +amends +bah +brigadiers +alleged +correctives +bristles +buzzards +barbs +bagel +adaptation +caliber +browner +apprehensions +bonnet +anachronistically +composites +bothered +assurer +arc +chaser +bastards +calmed +bunches +apocalypse +countably +crowned +contrivance +boomerang's +airplane's +boarded +consumption +attuning +blamed +cooing +annihilation +abused +absence +coin +coronaries +applicatively +binomial +ablates +banishes +boating +companions +bilking +captivate +comment +claimants +admonish +ameliorated +bankruptcies +author +cheat +chocolates +botch +averring +beneath +crudely +creeping +acolytes +ass's +cheese's +checksum's +chillers +bracelet +archenemy +assistantship +baroque +butterfly +coolie's +anecdote +coring +cleansing +accreditation +ceaselessly +attitudes +bag +belong +assented +aped +constrains +balalaikas +consent +carpeting +conspiracy +allude +contradictory +adverb's +constitutive +arterial +admirable +begot +affectation +antiquate +attribution +competition's +bovine +commodores +alerters +abatements +corks +battlements +cave +buoys +credible +bowdlerizes +connector +amorphously +boredom +bashing +creams +arthropods +amalgamated +ballets +chafe +autograph +age +aid +colleague's +atrocious +carbonizing +chutes +barbecued +circuits +bandages +corporations +beehive +bandwagon +accommodated +councillor's +belted +airdrop +confrontations +chieftain's +canonicalization +amyl +abjectness +choke +consider +adjuster +crossover's +agreeing +consolations +capitalizers +binges +annihilating +callers +coordinate +banshees +biscuits +absorbency +corollary +corresponded +aristocrat's +banally +cruiser +bathtub's +abbreviated +balkiness +crew +acidulous +air +birdies +canvassing +concretion +blackjacks +controller's +aquarius +charm +clip +awarder +consistently +calibrated +bushwhacking +avaricious +ceaselessness +basically +accolades +adduction +commending +consulates +certifiable +admire +bankers +appropriateness +bandlimits +chill +adds +constable +chirping +cologne +cowardice +baklava +amusedly +blackberry +crises +bedeviling +botching +backbend +attaining +continuity +artistry +beginner +cleaner's +adores +commemorating +amusement +burial +bungalow's +abstinence +contractually +advancement's +conjecture +buckling +conferrer +cherub's +belonged +classifications +baseball +carbonation +craved +bans +aphid +arbor +ague +acropolis +applied +aspired +calibrating +abundance +appeased +chanted +ascent +convenes +beep +bottles +aborigines +clips +acquainting +aiming +creditor's +abolitionists +cloves +containments +bungling +bunt +anchors +brazed +communicator's +brew +accumulate +addicting +actively +befog +anachronisms +bumblers +closest +calculators +absurdity +colleagues +college +assesses +conflicted +associational +betide +conceptualization +adjutant +alliances +corresponding +barometers +cot +brooch's +coiled +arboreal +convicted +artless +certificates +bourbon +astonish +bust +correlate +amounts +anal +abstraction's +corns +conqueror's +boldly +bob's +beer +blanks +corpses +contingent +blackly +backed +appearances +cancers +actuating +apprehension's +colorings +anglicanism +armament +armer +bizarre +begotten +actions +archly +capriciously +clue +contractor +contributions +agendas +coached +blamable +annoyers +coupons +brooked +assortment +axes +celebrates +courageously +baroqueness +blasphemous +asserter +contents +correctly +challenged +bulldoze +casement +acknowledge +bitterness +belongs +allotments +chalice's +bequest's +adjacent +consumer's +conservatively +coalition +background's +backache +befouls +brushfire's +analysts +branch +airways +awaiting +breakfast +anoints +baying +contrary +bilge +chasm's +babes +afresh +centerpiece's +barked +coffin +assumed +actresses +accentuating +aching +abet +balancers +consumptively +cagers +backing +angiography +chord's +cheapened +bewailed +arson +begged +convergent +bowlers +conflicting +confiscated +bitch +bloody +brushfires +bleach +computation's +choppers +circuitously +chancing +bunker +concept's +alacrity +boyhood +ammo +bobwhites +carter +ardent +bier +airway's +brownies +aura +cannibalizing +confirms +australian +barrage +closures +assertive +abstainer +bicarbonate +clone +back +cipher +crown +cannibalizes +away +crafty +airings +amtrak +comical +burnish +continuum +apparition +apologizing +blot +blacker +characters +built +apparent +applicative +assiduous +attorneys +affectionately +bobbing +baggy +comic's +attempt +appealers +amortize +bonanza +backwards +bowers +anemometer +ambulance's +creeps +abduction's +coal +chiller +adjudications +clogging +ascending +bookkeeper +crawlers +battery's +artifacts +attributions +amusements +aftermost +allophones +bemoaned +comptroller +bugger's +buoyancy +booboo +award +amplifying +certify +bivariate +attunes +asteroidal +chant +collectively +chasteness +chapels +copiousness +benign +armies +competing +buss +awakened +breakpoint's +conceptualizing +cleansers +acorns +conveyance's +bluer +battle +budges +characteristically +be +contour +beguiling +awarding +armhole +airship's +bathtub +breathable +crowded +compiles +certain +brutalizing +bacteria +baronies +abode +blacksmith +brinkmanship +capitalizations +cousin +botany +avionic +companion +consists +connoisseur's +avalanched +claimant's +backstitches +affixes +bikes +atomically +cowed +asleep +becomingly +acorn's +complainers +appreciated +cross +cringed +booting +attitudinal +broadcasting +childishly +breeze's +craven +boll +clause's +burden +appendages +atemporal +allah +carnival's +anchorage +adjures +besought +abounding +crucifying +arrangements +antiquarians +burrows +antipode +canvas +constable's +coopers +ascended +companionship +bakery's +bayonets +conclusively +boasters +beneficiaries +conspicuous +contriver +architecture +breakthroughs +brownie's +blur +academics +antagonist +contemplates +arena +caravan's +administers +comprehensively +convey +bigot +blitz +bibliography's +coerced +assail +amazons +banned +alabaster +concluding +bouquet +barks +acquaintances +astonishment +constraint +backpack's +breakthroughes +blocking +accomplishers +catastrophe +bushels +algae +ailment's +anemometers +beginning's +chefs +converse +cornerstone +astound +assuring +adornment +anyone +alumni +club +bestselling +businessmen +constructed +attendee's +cooped +ablute +chronicler +alaska +clam +canonicals +concerned +aligned +creek +burrow +allay +admirals +blackens +compressing +confirm +cows +battleship's +belched +affixing +chalices +choirs +absentee's +baseboard's +apportionment +adheres +accounts +chef +access +clearings +accompanists +concentrating +ado +bathos +bailiff +continuance +ball +bearer +congress +cites +can't +balloon +crams +consults +bungled +bike's +apes +assassinations +colt's +consecrate +ancients +chick +analyst +adsorbing +burntly +accompanist's +apprehensive +bengal +boughs +ankles +anchored +benefits +accommodation +amiss +brink +chewers +blueberry's +chairs +adjoin +bivalve +autobiography's +automated +comparisons +climbed +artists +congruent +cold +atonement +cashier +armageddon +allocations +bereavements +bumblebees +blew +busboys +bottoming +alternations +apprenticed +bestial +cinder's +consumption's +abbey's +amended +continued +birefringent +barbados +ability's +compulsory +antler +centerpieces +accountant's +arrogant +ballads +ascenders +appliers +adjustment's +blabbed +baits +activity's +clod's +adjudicating +bleak +commutes +bumming +beating +cohesiveness +branded +acknowledger +communications +blockhouses +booklets +consenters +creek's +consulting +binary +coaster +ascription +bushwhack +boggles +affidavit's +arrangement's +congressionally +convenient +avoider +abaft +bootlegger's +befriending +ceases +carbonizes +clumps +commented +competence +conversing +butting +astonishing +armful +allegory's +crisis +critiques +concurred +conservative +aristotelian +blizzard's +corner +amateur's +compare +affiliations +bestseller +batch +cleanly +assayed +bravos +bowls +conceptualized +babe's +algorithm's +baptist +cheeks +conquerer +bidder's +behaving +briefcase's +analogues +amply +attitude's +apple +crossable +ambushed +besmirches +creditors +bandwagons +continentally +adjuncts +concerns +agers +cop +amoebas +bisected +bombing +appendices +cocking +bused +babied +compounds +asserts +believably +alert +apostate +catalysts +aureomycin +convex +beetle's +banishing +agitating +bystanders +bow +connotes +blanch +charmingly +animal's +baritones +brier +astronomer +company's +balding +actually +aunt's +avalanches +acquisition +base +compilations +bathtubs +actualization +chanced +atom +banged +befuddled +apologized +componentwise +britisher +began +conservationist +actuate +crosser +appended +bitten +ambivalence +acetate +conversions +buzzwords +askance +abolishing +birdied +creeds +anglers +colossal +bereft +chock +apprentice +cooper +besmirching +allocating +antiques +bikini's +bonders +afflictive +augmentation +atheist +bucket +bibliophile +annexes +beguiles +birdbaths +amendments +animators +asymptotically +communally +barber +biographers +arguable +confidant +apologies +adorns +contacting +coarsest +artichokes +arraign +absorbing +alden +commercially +cabbage's +coincides +clumping +cents +alleviater +buzzard +braked +anesthetized +bugling +capitalist +befriended +appreciatively +boomtown's +cozier +critic's +correspondent +bard +attenuator +bake +brings +chews +anechoic +brutal +colder +buckshot +canvassers +analytic +allies +alloys +awake +alienates +bin's +crimes +constructible +classifiers +bulb +cream +banquet +axiomatize +adjourn +converted +auditioned +comfortably +bandwidth +cannibalize +ascensions +bussing +balloons +contenders +commemoration +aspersions +consultation +cashes +belting +augurs +architectural +bluebird's +breastworks +absconded +bullets +bloodstain's +blunder +astronautics +coo +approves +authority +assure +amsterdam +acquitted +adversity +celebrate +bred +bridged +bloc's +bullied +affinity +breezes +baptistry's +constitutions +avouch +amazingly +consolation +abnormality +clashes +buttes +buzzard's +breathers +chipmunk +contented +carol's +armers +amazedly +comprehends +canonicalize +breakthrough +arbitrator +butterfat +cases +besiegers +affianced +amelia +bush +airplane +annulled +bike +alternated +attackers +convene +aficionado +anachronism's +crude +carelessness +akin +combated +assisting +clocker +attacked +briefed +antic's +attendants +attracting +cope +allotting +bandwidths +add +assaulting +breakage +climes +arrival's +burp +accelerator +capacitance +arabians +bankruptcy's +archeological +coins +browbeating +chasm +cardinalities +compartmentalize +courter +assess +abreaction +brakes +compatibly +compression +characterizable +briefing's +alto's +classifiable +contrast +correlation +colonial +applying +authorizers +contesters +basely +cherries +clicking +cornfield's +alarmingly +conferences +business's +banker +bloomed +airfield +attracts +building +commutative +atomization +competitions +boatsmen +acquirable +arkansas +command +beings +compactors +anodize +arguments +conforming +adsorption +accustomed +blends +bowstring's +blackout +appender +buggy +bricklaying +chart +calmer +cage +attractive +causation's +athenian +advise +cranks +containers +besotter +beret +attender +cone +bills +aligns +brushlike +brownest +bosom's +berth +accountably +bequeathed +affirmatively +boundless +alleyways +commute +bendable +abhors +calculation +affidavit +answerable +bellicose +counterfeiting +admiral's +chisel +bridesmaids +believers +aggregated +conspicuously +abased +armenian +conspirator +canonical +assignable +barrage's +clearance's +casts +administratively +befoul +chaffer +amazer +colorer +broaching +crevice +aniline +coursing +compassionate +adhesive +bibliographies +corrects +augments +between +causer +amorist +cellist's +acoustical +baseless +cigarettes +astuteness +appropriators +convincing +bellhop's +bemoaning +calmingly +chronologically +castles +algebraically +appointees +academic +blunderings +assassins +barrel +accuracy +amortized +ballpark +acrobat's +brazier's +abortively +coarser +airfields +contester +circus's +creased +amorphous +accomplisher +blabs +butchers +crackles +bachelor +aviators +chariot's +circumflex +binocular +alienating +artificially +agreement's +aglow +afghan +abrupt +annihilates +apologetic +barge +betters +algorithms +conjurer +chargeable +brindle +alphabetizes +coder +availing +bandpass +arrogance +convent's +advertiser +connected +basso +breakfaster +comic +congenial +beau +courters +adapters +abruptly +chemicals +bringed +creaming +butterer +attained +actuals +averred +brainwash +centerpiece +blabbermouth +byproduct's +adaptable +automata +art +cheery +beheld +beehive's +claimed +crucial +brokenness +agility +combating +cleft +amenity +after +configuration +contrasting +coarsely +brass +barnstormed +bowel +bridesmaid's +cornfield +crazing +autocracies +adult +conceptualizations +corroboration +bedders +arroyo +alarmist +boatman +chests +burglary +budgets +canary's +arraigning +chin +barnstorms +blamers +brimful +calculate +cellular +contended +challenges +brusque +bikinis +arithmetics +chairpersons +class +aircraft +capably +centralize +awhile +compacting +courteous +archaeologist's +cram +adagio +affronts +amplitude's +bureau's +audaciously +autism +blueberries +an +chips +confiner +chopper's +chronology +breaching +bead +amass +camouflage +compensation +aspect +broker +atrophy +balk +bloodless +barnyard +benefactor's +airdrops +caused +anthem +activist's +bottomless +arrogates +avoided +bouncy +clarified +articulate +almoner +communists +blokes +butternut +clockings +barium +blows +criticism's +associations +brute +bleeds +alliteration's +bluestocking +boxwood +clearer +allegiance +conceptualizes +captivating +bolshevik's +belabored +biographic +contaminates +chanticleer's +adjusted +childhood +arguing +cape +conversantly +compensating +collaborations +arraignment's +blasted +charging +aggregation +apprentices +bird +codifiers +ballistic +breve +bells +carolina +chalk +buckles +boyfriend's +adorn +accoutrements +availability +antisymmetry +blades +alluded +asterisks +bookcases +additive +consents +advanced +balalaika +coders +caliph +alundum +are +controllable +blazing +clattered +asiatic +axiomatizes +ace +coining +column +auditor's +carol +concatenated +arrayed +capital +cautioner +clan +beauteous +abbreviate +asteroids +canal's +consolidation +closets +concealer +crevices +abed +complex +conviction's +abide +arrests +begrudges +adolescent +conceals +cells +circles +bravest +compromiser +bagels +areas +afore +allergies +arrangement +attraction's +amulets +abstraction +captured +crouched +brothers +cash +achieving +bastard +compete +boiling +beaching +amphetamines +clerking +congestion +alleviates +angry +bared +comprehended +bloodstain +constituency's +automating +aerial's +counterfeit +besotted +basses +biofeedback +compilation's +band +consulate +appellant +cough +antennae +contend +anniversary +boor +artifactually +aerobics +booths +chubbiest +consumable +assignments +bromide's +confined +breakers +alongside +courtier +boisterously +bilaterally +alternation +auspiciously +arbitrated +condemning +burns +correspondents +composition +cavalierly +coverlets +capacities +clatter +apotheoses +cartography +ceased +capitalized +auditor +appendicitis +chops +barony +anemometry +befouled +briefer +chest +begetting +bloats +bookseller's +commitment +confides +carcass's +battering +altruistically +ballots +adornments +broaden +angularly +coefficient +cataloged +brae +advantage +anthems +calculated +counseling +agitate +accentuated +camel +ambivalent +bedposts +beacons +chubbier +cheerer +assumes +concord +autumns +convention's +alpha +adulterates +arbiters +archaically +criteria +achilles +cheaper +bulling +associators +bloater +brawler +ability +adherents +commonwealth +coyote's +centrally +bequeathing +abandonment +circumstantially +courteously +borrow +countermeasure's +capricious +allied +anagram's +absorptive +assuage +asset +booked +aspects +commits +crates +capacitive +condones +assimilates +carriage +competitor's +cocoons +aggravated +caravans +arbitrator's +baked +balanced +annihilated +addressable +autonomous +bandwagon's +contesting +burrowing +coroutines +abjection +correctable +applauded +bragged +code +aggressiveness +cluttered +attacking +chide +am +coasters +blizzard +contentment +altruism +certifier +capturing +combinators +carefree +activate +blindfolding +assassinating +approximate +biplane's +aplenty +arteriosclerosis +concentrates +antisymmetric +assurances +anarchist's +ascend +advancing +atrocities +butt's +bearable +craftiness +categorized +barn +contributor's +arises +bushy +bisque +coasted +bargaining +area's +couples +cabs +barter +bulletin +chisels +broadcasters +contingency +bywords +antimicrobial +coexisted +blinding +arithmetize +coweringly +convince +competed +bauble's +crab +boggling +advocacy +atlas +assembled +ancient +bloodstream +balking +bin +bully +affirm +cruelest +atone +conserved +confession's +bat +captive +aster +blames +colonel's +bones +borderline +cleanses +classified +crudest +contiguity +bailing +ablaze +bender +attendee +clobbers +aliasing +autopilot +coolers +cache +allayed +barnyards +britons +appointment +adaptor +blockers +abridges +bloodiest +betrothal +bombards +bony +bus +canary +antinomy +awash +comrades +ablating +collectible +boats +brand +church +bandy +adhering +barred +ammunition +chime +accompaniment's +battleground's +composing +caveats +armor +amoeba +composure +collides +avowed +banding +counsels +asymmetric +abbreviates +balky +adjudicates +anointing +accursed +copse +action +construction's +accents +ambition's +caressing +cosmetic +accession +clutters +censures +allusions +belittled +armchair +abode's +conception's +ascribe +aliases +ancestry +ax +companionable +aright +boxed +brighteners +alloy's +checkable +arraignments +bed +bunkhouses +abbeys +ceasing +companies +cherishing +chunk's +barony's +chinning +burdens +briskness +beggarly +beloved +clambered +constitutionality +beguiled +archers +alleyway +apostle's +consulate's +antiformant +categories +construct +aliments +acquired +blotted +alterations +adolescent's +cranes +bluntest +accusation +chafer +airstrips +abolished +bothersome +churchly +airy +bedded +awareness +alliterative +arose +amputates +civilization's +arenas +certifying +aspirators +carbon's +bunching +aerates +bilked +checking +cloned +administrations +canvasses +colorless +chamber +circumspectly +benedictine +advisedly +classifier +approachable +banners +concurrently +chores +agape +convention +bindings +budget +comedies +ants +ambassadors +chroniclers +carrots +colorful +bulkhead's +coherence +buyer +aggressions +congressional +commoners +cheapen +concealed +columnates +anarchy +actress's +baseboards +creature's +centuries +barbarian +concrete +bicycles +acceptably +acclimating +biceps +bloodhound's +becalmed +apostle +bible +conjunctive +comb +ballers +bickering +adulterous +austrian +applicable +blackberries +creasing +catalogs +avert +asparagus +cambridge +bird's +belgians +admonished +admirations +conscientious +crescent's +connectives +blissful +commenting +bagged +assimilate +abounded +copyright's +advancement +axiom's +compilation +circumlocution's +catheter +chances +concretely +codification +browned +clustering +bum's +clauses +boundlessness +arteriole's +alfresco +begrudged +blustered +anglican +adjoined +bamboo +bathed +consortium +carrot's +cloak +album +bunglers +approbate +colored +aim +cowboy +alienate +cleverest +ambiguous +confrontation's +clear +africa +bowline's +astronauts +belayed +censorship +animation +bedrooms +chasms +compared +cogitated +barbarians +accomplices +columnizes +beaming +busied +counterpointing +aluminum +coconut's +acclamation +chokers +biomedicine +basalt +buckwheat +cardinality's +bafflers +arid +chap's +abound +biblical +backbone +anticipation +condemner +angular +advisability +believing +boiler +arclike +abetter +bespeaks +axiomatically +coarse +auditions +bludgeoning +clam's +chief +arrow +cementing +anxiety +aberrations +brushes +cherub +corollary's +bunters +beefers +barbiturate +circumlocution +conjoined +charities +coverage +campaigner +burrowed +barracks +bristling +accomplice +abandoned +bull +caked +century's +bantu +bristled +airer +bench +bevy +chamberlain's +attention +cloning +camouflaging +alder +counter +credibly +approvingly +breakup +artillery +celestially +bail +baker +bullish +canvass +conversationally +bringers +augment +creditably +butterers +botswana +contemptible +bribing +adumbrate +barb +calico +alludes +amplified +chills +cloak's +aver +arthropod's +budgeter +bereavement +cellars +crewing +blackmailer +ayes +bedsteads +breachers +bazaar +centered +celebrity +blameless +abscissa +aerators +awaited +british +adversary +cowslip +buttons +confusing +buggy's +belts +canceled +addresses +bribes +condoning +bonneted +coarsen +amazement +angels +chemise +carbonates +apostolic +bandit's +contending +consummate +counterclockwise +beneficence +benefitted +contradicts +comfortabilities +anemone +conductive +articles +bookcase +burst +baptizes +countless +costs +agonizes +byte +creeper +begs +bunnies +attract +able +calories +baskets +american +brunt +cognition +closing +chef's +backbone's +complicates +cloister +bedsprings +arrays +brigs +archbishop +buckler +clove +catholic's +bellboys +chairmen +clap +clarifications +ambuscade +bight +bellyfull +allowance's +academy's +acquiescence +ambush +catches +at +billion +contact +bees +adopters +approximately +chiseled +attributively +criers +codification's +cowslips +contradictions +buttock's +categorically +counterpart's +confessor +appreciably +adjusts +altitude +construe +cancer +bay +aristocratic +alleviaters +binoculars +axiomatizing +changer +bustle +civic +bostonians +crops +authorizations +cogitation +baptize +caressed +abase +ariser +axiomatization +aggravates +confiscation +bowdlerize +backspaced +alters +clarity +blots +bland +belligerent's +burgher +cardinally +bookcase's +buggers +byte's +avarice +crowding +beriberi +allegories +coronets +cell +calculative +adduce +amperes +bladders +adages +contests +cognizant +actuates +ambiguity +brighten +concert +conviction +booty +ashtray +braves +blouses +avoiders +confederate +bombings +couplings +convictions +attractiveness +chronicled +corers +anger +covertly +aural +asynchrony +arrowheads +breakdown's +bulletins +ceremonialness +clipper +bracelets +anthropomorphically +benedict +connecting +bacterium +achievers +abutter's +autocorrelate +coupling +blanketer +continental +assignment +conundrum +arab +besides +cheerful +blowup +bastion +arrive +combines +agar +cookie +astronaut's +constraint's +article's +confiscations +bounded +adjudicate +belligerently +boron +brownness +adept +creep +abduction +accosting +asylum +autographed +clash +chiseler +clumsily +capitally +braking +absenting +bagatelle's +comet +basked +anything +buffeted +absentia +bounty +carols +characteristic's +constructive +comforting +aflame +brainwashed +booby +aspirations +adjudge +behaviorism +computability +assessment +consultations +bowstring +acknowledgment +arranger +chancellor +attest +compresses +concessions +asymmetrically +administering +clamoring +arraigned +archived +admonition +actor's +aimers +colorers +booklet +calibers +affix +bushel's +atomizes +creeks +bleedings +casuals +archives +certainly +animate +cons +affiliate +answered +coyote +coughed +alligator's +antagonized +arousal +assisted +aerated +competently +conquering +acclaimed +assign +announcer +controllers +amalgamation +comfort +antihistorical +availed +balsa +annoyed +basted +asymptomatically +cropped +combinational +barging +conversant +causality +botches +bedspread +considerately +bookstores +climate +blessing +accordion's +cdr +bonanza's +construing +bearings +bluster +backspaces +babyish +countermeasure +crime +battered +audit +associating +corps +application +archangel's +aided +breasted +compelled +acrobats +breakfasts +chronologies +beet's +averts +convergence +attributable +adverbial +churns +arrest +breastwork +beefs +brownie +create +contradistinctions +coordinators +abandoning +byline +beatitude +autosuggestibility +bipartite +annals +assents +conceives +amalgams +cleft's +clicked +appointers +bible's +boots +caret +attaches +controversy's +combinatorial +bazaars +cardinals +bored +catering +christian's +ashman +consequence's +austere +clay +birthday's +amongst +arbitrariness +brainstorms +chateaus +coaxer +applause +cautiousness +adorned +compromises +creatures +compliance +apartheid +archiving +amoeba's +communal +comedian's +aggressive +crop +ante +better +chalice +aristocrats +circling +belittle +abortion's +coldly +certification +befriends +courthouse +anesthesia +accorder +athletic +blithe +bedder +abasements +councils +beware +abductor +assonant +clench +aspersion +abortion +abating +birches +breakpoints +acyclic +ablate +canners +cistern +boxtop +composite +cloudless +computation +chastely +abusing +bunker's +compounding +alveolar +chaplains +bias +audiological +capability's +bangle +barren +antidote's +cranking +baptizing +bond +borders +automobile's +allegoric +chargers +baltic +autumn +columns +absolute +connoisseur +cranberry +contiguous +consoled +confirmations +argot +blouse +annotated +callous +astounded +crashed +autonavigators +chivalry +columnating +beefed +convincer +allegorical +bagger +assume +containable +artistically +calibration +architectonic +campaigns +addressability +crazier +buy +brightener +bastion's +blurb +awaits +commands +chocolate +bleaching +antenna +blowers +chorused +composers +assigners +aspires +coils +bid +application's +clamped +bedding +awkwardly +coppers +costumes +borax +caged +candler +badges +clutches +consign +apprised +buys +adiabatically +aggregately +canned +abstract +acrimony +coax +analytically +absurd +alluring +contradicted +aspersion's +bribe +boos +chattererz +backache's +complying +continent +cohabitate +causation +astronomer's +cities +bookie +bleating +cracking +bicameral +convoluted +adjustable +ambulance +can +boulders +consideration +announces +briars +antipode's +bartered +ancestor +biplanes +characterize +crested +bum +bridling +consolable +bungles +coffee +buffets +congratulation +commitment's +adequately +clown +capacitor's +broomsticks +agglutinate +activations +asians +canon's +authenticity +complexities +cripple +bracket +counselor's +beatably +bounced +baton's +crankiest +barbell's +caster +casseroles +ballad's +bob +batched +attenuated +beakers +biologist +bleary +condescend +blondes +augustness +boldface +battlefronts +acumen +bolting +articulatory +butyrate +bowel's +backwater's +colonel +creating +authorized +bijection +accruing +admirably +correctness +citadels +clasps +bandlimit +bib +appalachia +contrives +bundle +audiology +circumventing +blinker +choked +bilks +clears +affirmations +arbitrating +bites +bootstraps +capitals +commuters +billeted +authentication +choice +attentively +aggressor +arterioles +crowds +chestnut +backstitched +attachments +assimilating +bewilderment +atrophied +chintz +blackjack +armadillos +bonfire's +ballast +agonies +busier +coefficient's +adventurous +ballet's +coil +chewed +come +bonder +catalogue +coursed +arise +biennium +ceremony's +blanching +appraisers +acolyte +argues +beholden +appanage +astatine +banana's +coons +civilians +bodyguard +archipelago +bug's +candles +antique's +accidently +blighted +belgium +besieged +burned +abuse +asian +chute +awkwardness +abasing +bottler +ardently +blab +breakwater +cavity +cheated +befall +according +chronicle +airframes +bats +choring +authorize +consumed +chatter +annunciated +capers +anomalous +clustered +burner +acquaintance's +badger's +basic +affectations +buzzy +coast +attendances +activating +beams +cohesive +attainable +barbecueing +beautiful +acronyms +communion +client +atypical +antagonists +conservations +arguers +agglomerate +antigen +battalion +ambition +countered +assistant +classed +arming +alveoli +buff's +backplanes +busted +bermuda +converting +brutish +boot +acidities +confrontation +chapel's +berlin +ascender +behead +buddy's +commandment +actuated +brilliancy +chance +bedrock's +bridgeheads +arable +avid +arteries +caresser +ballyhoo +attested +african +comradely +consciences +commencing +antennas +annulments +bobolink's +advisee +acceptance +crack +ascendent +appendage's +accommodates +accumulated +clones +apocryphal +ages +cluster +capitols +camper +beading +amble +buffeting +circumspect +advances +analyzes +courier's +aperiodic +appealer +atonally +attentive +conspire +appropriating +armed +allergic +agglomeration +consternation +blinks +audibly +aspirins +bunions +adverbs +armload +bet's +caring +carryover +coordinator's +afterthoughts +allays +abided +brownish +baiting +capitalism +coined +conspirators +automatic +contradistinction +conductor's +backstitching +conjure +casings +accountant +clinched +constrain +alcohol +bee +anticompetitive +britain +bade +camera's +antimony +activated +burglarizes +compatible +cotyledon's +artificiality +bath +citadel +archivist +chandelier +addiction +ampersand +bitterer +constructively +afield +bing +attractor's +cringe +allergy's +bigots +assimilation +ate +capitalization +abridge +buzzword +befit +bandlimited +commandant +alabama +acculturated +brightening +bulldozing +cooky +bunks +centers +bespectacled +adherent's +abducts +another's +condensation +billeting +bye +chess +craziest +ballgown's +archaism +consorted +chinned +cowl +beat +bootlegger +bravado +classically +bulging +browbeat +accommodate +borne +bronzed +artifice +arcade +become +backlog +addressers +amphitheaters +befogging +crochet +aiding +celebrated +conversational +backbends +authentications +advertisement's +blockade +bulldozes +contraction's +bricklayer's +brain +conveying +anemia +chronology's +channeling +caution +commanding +crosses +artisan +conditions +admired +authenticator +airships +blunter +bridesmaid +counseled +cheeriness +chiefs +boils +clerical +atrocity's +balls +ambled +canvases +consoles +abscessed +abetting +blitzkrieg +bottlers +beveled +condemn +alumna +cords +admittance +annotates +citing +corrector +appreciative +branching +betrays +buttoned +ailment +boulevards +bottlenecks +chamberlains +bedbug +covenant's +crispness +considering +broadcasts +audubon +arousing +correction +barrack +closure +contrastingly +brittleness +assassin's +bursa +bungalows +balked +conceptual +carcasses +arabia +blueprint's +affectingly +consorting +buses +auger +appointed +brute's +bosoms +anyway +arrowed +anaphorically +clarify +approachability +assistance +buzzes +commonplace +bluebonnet's +adroitness +availers +aquifers +architecture's +action's +backgrounds +abduct +attired +briber +admissibility +cease +beck +auctioneers +birdbath's +atomic +crossing +considerate +biconvex +bulge +bedridden +arising +aggression's +cherish +bureaucratic +abater +amputating +atop +climber +clutched +afford +bisections +bonnets +commendations +bloke +abundant +clamp +aloes +aboard +atheistic +advantageously +buffs +chimney's +cheerily +benefactor +ample +bushwhacked +captain +buckskins +contextually +antiquarian's +browns +bubble +ban's +brine +acculturates +anhydrously +beaver's +advantaged +bibliographic +clasping +clattering +coerce +colorado +airmen +bandlimiting +balks +boners +attached +chosen +convened +bordello +composer +botanist +backtracks +civilization +commutativity +bloodshed +cohere +bunkhouse +archdiocese +boycotted +crosswords +bedspread's +anteaters +cove +apothecary +chute's +addressee +climatically +blower +bane +cask's +beetling +ambiguities +before +abstain +arachnids +bucket's +amateurs +blackouts +adverb +butchery +conjunction's +barricade +audiologists +aphorism +complete +butts +bishops +allotment's +confusingly +channeller's +blanches +bragging +bathe +comedians +celestial +citizens +couple +backpack +aphasic +brothels +axles +cancellations +bonus's +consolidates +authoritative +axle's +acclimatization +carolinas +chime's +antibiotic +bisons +biographically +achieve +bleachers +bicentennial +behavioral +accomplish +concealment +biddies +antitoxins +arriving +apprehend +affluent +cliffs +bleached +astronomers +connection +bride +backs +bog's +casket's +continual +ampere +cat +alternator +cotton +athletes +communicant's +best +befuddling +benefactors +appease +annoyingly +context +astonished +cracked +amnesty +autumn's +binder +babying +contributory +assumption +cowls +cocks +airless +consummated +atypically +beneficially +chairing +accusative +commanded +bufferrer's +alerter +arbiter +civilly +charms +backscattering +cheater +bushes +caverns +chieftain +calf +comparing +aurora +butyl +cower +bemoans +baptistry +carpenter's +capes +bordered +arrows +blocker +crest +appeal +arabic +conventions +axis +brains +bookkeeper's +circle +cooks +circumlocutions +adventists +barringer +affording +anatomically +basements +barbarities +configuration's +contributes +collaborating +beach +comet's +bakes +assigns +ballerina +cheapens +clinging +conquered +bisecting +closenesses +bugle +boatmen +beatings +complicator +bight's +banister's +archaic +anthropologists +clams +beginners +committee's +communicants +alone +bounteously +bastes +ascertain +alphabetical +bringing +batters +amazon's +constituent +benders +being +constitutionally +audiometric +blast +copings +bailiffs +colts +coolies +airlift's +boomerang +bifocal +clothes +cashiers +congenially +billows +boilerplate +biochemistry +betting +brimmed +complementers +breading +bragger +adducting +bisectors +abrogates +criticized +comrade +bucolic +birthright +blurs +challenger +complicated +bluebonnet +biscuit's +classmates +campus's +boundary +bedbug's +adjustor's +acre +bicycling +awe +additions +baiter +authorizes +beautify +copier +buffet +belfries +acquisitions +brooch +crickets +caterpillars +beefsteak +complicating +bedpost +criminal +celebrity's +bookseller +christened +coerces +clamors +all +boatyard's +canoe's +begin +anaerobic +bushing +agreers +concedes +countermeasures +beg +agglutinin +bunted +ammonium +aspiration's +bathrobes +changeable +beached +bestowal +beaner +catsup +admires +clockwise +agile +alarms +ached +chinks +buffer's +cartesian +annunciate +chanticleer +avenue +anchor +alliterations +blanking +bargained +breathtaking +crime's +assiduity +argentina +contiguously +aqua +bested +borderlands +appetite +captive's +bipolar +conceal +counters +costumed +arrestingly +bunting +blight +champagne +brusquely +address +bloodhounds +associative +creed +arithmetical +balustrade's +belabors +complementing +checkout +archivers +badlands +behaviors +ampoules +bridgehead's +antiquarian +clumsiness +considerable +apportions +anglicans +appealingly +barfly's +absorptions +awards +congregates +cloister's +armour +avoid +correctively +chucks +burps +bums +berry +batches +administration +atones +bishop's +blonde's +casualty's +cores +bodied +alter +assonance +apprise +antitoxin +avariciously +checkpoint's +affirmative +conjures +angstrom +aesthetically +canyon +binge +crazed +breastwork's +aids +boston +conceits +announcement's +beechen +accessory +authorities +constrained +automation +anaplasmosis +commander +commendation's +belabor +cornfields +artemis +asphalt +contracted +brochure +crafted +allegedly +alien's +auditory +blowfish +adducible +confederations +annuals +britches +acquaintance +appallingly +abounds +burglarproof +crossers +bayous +brisk +authority's +covetousness +averse +accomplished +aromatic +admiral +bijective +avenging +bran +boatyards +beseeching +challenging +bares +acts +abductions +compendium +compulsion's +calendar's +clad +blockage +conventional +craze +cajoling +acceptability +bungalow +buff +cramps +attackable +calculator's +asp +braved +colors +balling +contaminate +crackling +comes +complimenters +across +astronomy +aborigine +bobwhite's +autopilot's +chattered +appall +autonavigator +bashed +acoustics +beachhead's +apartments +convenience +blackout's +bands +autonomously +amounters +centripetal +achievable +astringency +attuned +concatenating +copyright +coding +assumption's +anastomoses +confiscate +asking +beneficial +adhesions +busboy +bronzes +audacity +bruises +crash +beau's +circuit's +aborts +baubles +beliefs +assuaged +costed +blinking +characterized +bowled +block +conquests +confesses +amusers +ceiling +berets +berliner +abstentions +child +authoritatively +closeness +bushel +considered +communicates +cheerlessly +autofluorescence +aquarium +affects +appurtenances +airbag +approaches +admonishments +bets +bounden +courtly +bodybuilder's +campus +brainstorm +americans +chairperson's +botanical +askew +amazon +bleed +clime's +cooperations +commonness +boatloads +blinked +courtyard +adapted +aforethought +backwater +burr +cathode +awaking +buzzed +bridgeable +arrives +adventuring +beseech +attrition +copied +colon +client's +bandstand's +advice +baptistries +antithetical +alcohol's +contradicting +ambidextrous +belches +category +bluntness +coupon's +assimilations +comfortable +caller +affliction's +attends +compactest +baler +beacon +blind +bleakness +beseeches +courts +couch +consequential +adulterers +craving +biggest +astray +bigoted +barfly +charges +ambiguity's +commentary +crankily +cowerer +carnival +bachelor's +bituminous +continuance's +calamities +claws +apiece +century +ascendancy +charts +animations +aggression +chickadee's +carve +confidence +actor +bubbled +becalming +convulsion +chivalrous +brightest +centralized +beautifies +amateurishness +birthrights +alligator +circumstantial +constructors +conceptions +arranging +cart +cent +ager +congruence +carrot +chariots +cloudier +captivity +conquerers +compartmentalizes +condensing +celebrities +chalks +accordance +chilled +conversations +apples +conceiving +average +blessed +creator +ant +cling +annoyer +aviation +cohesively +correspondences +boor's +apprehended +bessel +both +characterizes +bards +cots +acculturating +cemeteries +carting +alcohols +bitterest +ascetic's +conducts +caking +airspace +autocrats +ashes +chimes +broadcaster +commuter +basket +borderland's +broadened +boyish +allegretto's +ban +bidder +christen +blessings +bury +arranged +choir's +apathetic +boring +aryan +appearing +binds +cooperates +bounces +airspeed +complicators +adapting +babbled +agglomerates +bedraggled +addictions +bolt +calmly +blur's +boatload's +anesthetic +bugs +colt +completing +boxer +billers +affronting +absurdity's +chides +comparatively +braided +clipper's +cot's +calves +articulations +branchings +attraction +concatenates +alligators +cake +boom +crashing +afar +abler +beamed +adverse +adrenaline +agriculture +beehives +crankier +courthouses +advises +consigns +bisect +azimuth's +carpets +arthropod +brewery's +commonalities +altruist +astride +appreciate +carved +briefs +admitter +celery +congregate +clocking +assassinated +adding +canvasser +civics +contemptuously +calculates +advisees +bumbling +algorithmically +cloudy +algebras +addiction's +cop's +assurers +confidently +affector +analyzers +chimneys +burdening +antitrust +admix +avoidance +choking +coexists +accustoms +cellar +anchovy +constructor's +confinements +consequently +accelerations +accoutrement +churchman +biller +affected +brigades +cremating +corridor's +bagging +ah +berating +collective +acuteness +arrestors +cab's +border +agitation +animism +arches +alveolus +cessation's +averrer +abash +counterrevolution +attesting +animateness +bawdy +americana +bloodstained +applicator +annotating +annunciator +clamored +acting +aerosols +axiomatization's +brags +coalesces +avocation +combining +crazily +bravery +burying +adored +airfield's +accounting +broadeners +anise +chimney +added +avenges +bellicosity +cranberries +arsenic +communities +comparable +bunkered +architect +alphabetically +beautified +apogees +communist +anatomical +complexity +accost +autographing +browsing +ameliorate +bookers +bandaging +clinical +appellants +counteract +clairvoyantly +bootstrap's +canner +boastful +attainer +ash +beaded +brake +barest +befriend +burglarproofing +allegorically +bunts +believes +accession's +buck +boathouse's +byword's +anthracite +accuse +conjunction +burping +commandant's +creativity +affirming +bark +amuses +balcony's +auditors +counsel +clamber +borates +cowboy's +bickered +boors +combing +biting +breeze +crowder +corn +bloke's +bombast +bookstore +blared +bedlam +carbohydrate +coops +bundles +blistering +antarctic +anterior +bilinear +chocolate's +context's +alternating +annoyance +constancy +ambivalently +buddy +brutalize +bobbin +alleles +commotion +attributes +airborne +creed's +bolstering +coaxed +airframe +breaker +accept +abashes +attentional +contributor +comparability +auscultating +cocked +computationally +buffered +career's +analyzable +absently +courtyard's +buildups +apportioned +balkanized +annulling +cremation +buffetings +conditional +confided +airliner +bulldozer +approaching +anagram +apollonian +canaries +bloat +bluebird +collision +cool +connectedness +abasement +artisan's +avoidably +clerks +afflict +briton +corroborates +cameras +counted +boldest +burglars +brutes +brows +abhorrent +configuring +averaged +ace's +buying +abandon +bayou +cottons +auditioning +amplifies +clippers +brainstorm's +alto +brutalities +bunch +agricultural +bursts +blunting +archer +activity +carefulness +bedroom's +concomitant +balm's +artificer +barking +breathy +babies +acacia +bodies +cap's +criticised +conversed +crewed +ascendant +budgeting +coroutine's +charmed +bellboy's +conservatism +butler +acculturation +conclusion's +adapt +cellist +contempt +adumbrates +borrowed +confounds +allegiance's +blabbermouths +accrues +captor +coop +baseballs +cottages +apartment's +assertiveness +assent +artfully +bagger's +abolishment +acetylene +accessory's +blackbird +baptist's +consist +cavern +buttock +corporal's +autoregressive +bailiff's +birds +corder +bracketing +antlered +barbiturates +county's +addicted +agglutinated +abashed +competitively +captains +bloating +accepts +choose +ashamed +backyard's +apiary +contradiction +balalaika's +arctic +broom +anvils +coffee's +alliance's +agitator's +change +adjusters +cremates +complexes +bodyguard's +burl +antithyroid +ambient +airfoil +apricots +athleticism +abjectly +bankrupts +answerers +alternatively +confronter +breaking +baronial +cannibalized +appetites +breaded +blackboard's +battlegrounds +cosine +barrenness +abbreviation +budging +boolean +acrobatics +again +ashtrays +clashed +contingent's +compulsion +bedazzled +collapsing +comparison's +businesses +compassionately +achievement +buffering +candlesticks +austerely +awls +associate +absolved +annexed +airway +clipping +counselors +conscience +attempters +constructing +biases +cautioners +comma's +cosines +char +auscultates +afire +comely +amity +beverage's +anew +ballplayer's +adulterated +authorship +alterers +burdened +attributive +afflictions +blinded +barrier's +attachment +brotherhood +bridegroom +atoms +cobweb's +copes +controversies +complexion +crawling +atomized +adjust +accuracies +concern +cinders +authorization +appraisingly +bladder's +cooked +cowers +batter +commissioner +close +burglar's +allocated +anvil +aftershock +abrogating +chemistries +advisable +conduct +committee +blaring +appalling +braveness +alertly +artificialities +brevet +collision's +arizona +bower +creamers +awnings +arsenals +crane +city +contemplative +catheters +administrators +attorney +churned +attractions +columnation +bobbed +centipedes +bostonian's +apprises +buries +allege +botulism +adobe +ambassador's +covenants +boon +asynchronously +bigness +axial +chaffing +battleships +ant's +anthropological +accent +brushing +brassy +consumptions +battleship +absorb +beckons +brook +connectors +clinches +accesses +beaters +archaicness +bursitis +chided +bomb +assimilated +addicts +convening +arianists +counting +altar's +confusions +attachment's +clipping's +amazing +corset +bossed +attach +commandingly +animatedly +allegations +assuages +annulment +compress +aptitude +absurdities +autobiographic +aspect's +concentrator +burgesses +anagrams +bedeviled +assemblers +convinced +commentary's +agglomerated +biological +callousness +axolotl's +atmospheres +authoritarian +cancer's +above +charting +aldermen +battler +cistern's +bouncer +amassed +conquest +altering +arrogantly +brokenly +comparator +counsellor's +attenders +cackle +criticize +authored +ably +believed +compelling +accepter +cleansed +afflicted +backslash +computed +almighty +attache +braes +carriage's +benediction +brigadier's +contemporariness +boomtown +amplitudes +breakwaters +clod +catch +bar's +activist +caves +assenting +camp +attainments +brotherliness +continuances +appearance +applicator's +browbeats +banjos +addendum +became +adduces +armadillo +brothel +almanac +courageous +assault +chunk +coaching +atheist's +blunted +aperiodicity +congresses +boastfully +burglarproofed +broadest +bashfulness +affect +acne +bottleneck's +criticisms +corrupts +colonized +closeted +canonicalizing +auditorium +antenna's +awfully +anti +consumes +agonize +algebra's +championing +blush +bugger +antagonize +beethoven +blase +boycotts +compensatory +bugged +boroughs +anatomic +batons +arguably +affricates +appreciations +cavalry +alumna's +arcing +backpacks +braces +contextual +coupon +chillingly +allocates +abuts +contribution +commodity +admonishing +coolly +cabinet's +collapsed +confessions +adjured +capriciousness +chastising +babe +aerodynamics +accepting +concept +contour's +consequentialities +birthday +bankrupted +birthed +benefit +concentrations +azalea +channels +chestnuts +contenting +antedate +censors +contagious +abbot's +channellers +apt +commend +avocation's +admonition's +abolition +confederation +carried +clumsy +coincidences +bumper +burr's +bugles +bribers +attainably +consume +comma +creativeness +accuser +bombs +abbey +baffled +aside +clip's +appeases +compass +bundling +abstractionism +confide +creases +apropos +confronted +corrective +concurrencies +autocratic +alien +attending +antagonistic +broadcast +asymptote's +belied +breasts +contrapositives +coiner +accordingly +cohering +computers +cow +bibs +ancestral +controller +attacker +alerts +coconut +agency +alerted +alcoholism +ammoniac +actinometers +acquitter +bud +cessation +alleging +centralizes +articulators +council's +carvings +arduously +blown +anode's +arrogate +bisects +centimeters +burgeoning +course +appointee's +ascribable +communicate +contrivance's +adoptions +attune +acres +abyss's +corporal +certifiers +analyze +augusta +bestseller's +checkpoint +coexist +attainers +argon +bearded +crudeness +averaging +brick +adducing +annulment's +chicks +blocked +cisterns +afoul +affiliates +briskly +adhesion +ascertainable +appeasement +blueprints +agreements +blindfolds +communicator +characterization +annoyances +breeches +brushed +clinic +competes +chuckled +cradled +balmy +antisubmarine +alternate +armpits +barn's +conjuncts +adhere +allows +counteracted +appetizer +capturers +cleanse +avant +abbe +corpse's +arduousness +badge +begets +contemplated +caveat +copiously +athena +aggrieving +alibi +accumulation +basket's +aftershocks +bass +conjuncted +chaps +brunch +colonials +bibbed +clusters +antagonizing +constituencies +combings +bearish +continuously +adequacy +brow's +catalog +alderman +comedic +chemists +concernedly +conceded +alarm +arced +buckle +confidingly +coherent +closes +buffoon +brace +adjustably +crackers +contamination +burgess's +aerobic +constitutes +baptismal +broadness +blimps +concatenation +claiming +bard's +aerosolize +adjoins +copies +coats +boggle +corroborated +concreteness +bill +cautions +bantam +bearably +armchair's +birthright's +cravat's +cone's +courtiers +asunder +bulletin's +biopsies +alley +contrive +blasphemies +amuser +ballerinas +blushed +causticly +brandy +blinkers +complimenting +crimsoning +angola +apprehensiveness +bolster +columnate +byproducts +berths +accusal +chubby +arrived +camps +blemish's +anaconda +cook +airfoils +atlantic +boosted +converge +availer +appalachians +coffin's +boarding +alga +crouch +columnizing +consul's +chastises +angling +apple's +billiard +attentiveness +adroit +apprehensible +cereal +blouse's +browning +bodybuilder +coaxing +assertion's +connective's +commemorated +accountability +crooked +blips +chandeliers +aristocracy +bangs +coke +abutment +community +calculus +congregated +crepe +compromised +airlines +contributing +contingencies +coordinated +alginate +batted +contender +alma +antagonisms +accompanied +airport +administrator's +appraisal +breadbox +condemnation +backlog's +available +consequents +crooks +commonwealths +barring +channeller +crucially +archaeological +charming +adventist +credits +appetizing +breads +clients +climbing +aloneness +abstractness +appearer +astute +clockers +antagonizes +agonized +bastard's +conjectured +aqueducts +aureole +boatswains +conjured +chauffeur +complementer +behold +bustards +bivouac +cluck +anus +bless +catastrophic +bounty's +allowed +answer +concealers +brainchild's +coercion +buzzword's +bordellos +appertain +applier +couriers +aesthetic's +craft +capacitances +capped +coupler +category's +anvil's +conquest's +checksums +clucking +bronchus +acrimonious +changeably +accenting +argued +conditioning +brewing +backwardness +cascaded +atomize +contours +arianist +apart +conflict +carefully +banshee's +conveys +arbitrates +amphitheater's +amen +alimony +bound +buzz +courtroom +apparently +coalescing +circulating +amounter +bypasses +breadth +choral +completion +arisen +anticipating +bilges +contractions +bedspring +commune +blacklisted +beagle +alkaline +atolls +carelessly +blimp +corking +brevity +alterable +canada +bear +bluntly +cartridges +connoted +countries +corroborate +consecration +corrupted +appreciating +combatant's +alkalis +affecting +blues +casserole +ballad +bewitches +common +as +because +bathroom's +anchorages +beguile +connect +convenience's +counteracting +assorted +care +contains +centimeter +ancestors +briefings +busses +churchyards +breakable +amortizing +courthouse's +click +courses +ajar +county +covet +confidences +capitalizer +agog +backtracking +copious +bestsellers +chilliness +bringer +browse +centipede +bawled +bricklayer +breath +assailants +abysses +command's +characterizer +calculating +america's +aurally +contain +alias +commentators +confounded +appending +accidents +chatters +coordinates +bleeder +blueness +badger +bolsters +astounding +capitalist's +conservation's +commences +aimed +bun +comparators +competition +bauble +backbend's +bled +assassinate +chop +anemometer's +cobbler +coldness +audiometry +affinity's +amalgamates +cowardly +consolidating +beads +brackish +bookings +accuses +bog +compartmentalizing +clutching +calming +collars +clambers +banqueting +beaked +authoring +correspondence +apostrophes +affirmation's +bespeak +costing +brought +complainer +battalions +asymmetry +boathouse +canyon's +awarded +amplitude +anarchical +anticipatory +bolder +cooperatives +caterer +adviser +balkanizing +augur +cannibal's +balustrades +attaching +collector's +commercials +capaciously +coincidence's +bumps +ascot +bale +blackmail +baby +aftereffect +bloomers +buttresses +avenues +climaxes +aqueduct +cater +brainchild +avail +bypassed +bowl +california +cements +boxes +brained +bedevils +captors +acuity +ascends +breakthrough's +assigner +caner +bequests +ceilings +axers +bookshelf +autistic +celebrations +axons +chiding +asterisk +allophonic +blindingly +cherubim +boaster +confining +anxious +clowning +advisement +approach +anesthetic's +crescent +alertedly +birdbath +beardless +bras +auspices +choosers +approval's +afflicts +corrosion +arpeggio's +bodyweight +cranky +battlefront +affirmation +churchyard's +aeroacoustic +anders +adjustment +baneful +citation's +acetone +blend +binuclear +boner +annotation +announce +claimable +contemporary +clothing +acquitting +choosing +attacher +bananas +binaural +arrestor's +aches +conclude +collaborators +await +blaspheme +bequeaths +crows +balconies +begging +conducting +abstracts +assignee's +causations +approximation +articulated +considerably +apricot's +afferent +assertively +bonding +calms +cranberry's +cost +captaining +agenda +corridors +complaint +christens +aggravate +countess +arbitrators +ascribing +breech's +bellwether's +burglarized +confinement's +animating +adjectives +cannister's +bemoan +cleanest +acme +cheapest +activities +allophone +boy +belaboring +captions +compactor's +actuator's +befouling +arachnid's +computerizes +compile +absorption +bridled +absorber +convicts +birch +alkaloid's +cannot +bacilli +charitableness +abated +ceaseless +beavers +bookshelves +commensurate +appreciates +basil +cartoons +aides +buxom +cages +cantor's +acceptances +antiquated +amalgamate +babyhood +beers +conforms +bouquets +canner's +baste +cashed +argue +butcher +backbones +absolve +crib's +cafes +abstracted +book +committees +authentically +conference +antisera +bourgeoisie +attribute +biddy +autobiographies +chivalrousness +coverlet +ambiguously +calorie +anhydrous +alignments +around +archfool +advance +bedpost's +affective +contained +amain +bromides +clogs +bricker +arduous +consistent +amidst +confess +complain +anniversaries +coasting +cobwebs +aries +benchmark +aviaries +bombard +boxers +ashtray's +assyriology +blaze +ablative +chaos +burro +arguer +ashamedly +crier +allocator's +aggressively +carts +advisory +airship +alkali's +backup +chaining +continue +cartoon +circumference +breadwinners +autonomy +banking +armored +cabin +chunks +antigens +blistered +airers +breakaway +belief's +belays +coveting +auburn +careful +anybody +bumbled +cautious +adopter +ballplayers +anteater +citadel's +avails +agent's +caliphs +bridgehead +already +caterpillar's +coachman +centralizing +alphabet +concede +barbell +breadboard +ballast's +activators +attendance +blandly +calculator +codeword +addressee's +avenue's +alcoves +alternately +admonishes +concentrate +crossbars +adjoining +basset +carbons +beast +blonde +castle +clarification +bitch's +abrasion's +books +amputate +bicycler +aphonic +arraigns +acquiesce +buster +chaperon +advisements +buyer's +attack +birthdays +blazed +confuser +crag +ballet +airports +bison +counterexamples +arteriole +colony's +adamantly +blunders +chivalrously +adult's +authors +amplifiers +counterfeited +complicity +astrophysical +axolotl +bash +battleground +butterfly's +axioms +allegory +blitzes +blindfold +bufferrers +approximating +byways +computations +alight +avoiding +assurance's +barrages +canonicalized +callously +auditing +authenticating +bag's +asters +artistic +bonanzas +applaud +certainties +auto's +concession's +cascade +chubbiness +churchyard +afternoons +antigen's +baron's +amphibian +banister +capitalize +approval +appropriated +bureaucrat's +covets +cloisters +circulate +bivalve's +beta +collector +among +cane +birdlike +attenuating +conjunctions +appliance's +coral +crucify +abnormal +combined +classroom +buckskin +commissions +abolishments +arching +croak +americium +associates +car's +assuringly +agreer +anticoagulation +closure's +corkers +attend +alphabet's +awakening +composedly +attracted +construed +cricket's +applicability +autonavigator's +chloroplast's +ashen +beggars +corporation +another +conflicts +bootlegs +archeologist +alcove's +agitates +cargoes +creditor +cops +advisably +coronation +bourgeois +crochets +cropper's +cramp's +adulterer's +corroborations +changing +combinatorics +calm +comprehensible +blooms +coolness +copying +blacksmiths +commodore +compulsions +clump +afterward +crucified +brooder +buckets +accelerating +accented +boat +adventitious +baseline's +courier +calamity's +atoll's +brutalizes +bundled +chairperson +cheeses +continuation +celebrating +apologists +behest +bumpers +consonants +circulation +betraying +commuting +breezily +circumstance +coughing +benefiting +conquerors +chemically +commencement +adjustors +angel +congratulate +conspired +causally +bud's +conquers +augmented +bereaving +advisor +articulation +angler +admission +bide +competitors +amusement's +collecting +adder +arithmetized +cheek's +apostrophe +blockages +clockwork +bubbly +apricot +adjudicated +banter +amused +breacher +bracketed +aimer +comprehending +bunkers +canton +arcane +absent +capitol +consequence +cognitive +abjuring +clever +coronet +anathema +artichoke +controls +credulous +acid +crawled +coupled +boomtowns +aspen +acted +anyhow +burdensome +backdrop's +apocalyptic +cornerstone's +cautiously +blisters +conveniences +arbor's +accessories +alleges +clubs +accompaniment +blazes +annually +clique's +beamers +ballgown +autumnal +acreage +conjunct +balances +consoling +canvas's +competent +aggrieves +although +afraid +clearly +cognizance +acoustic +colleague +causing +absences +closers +airs +cinder +adversaries +altruistic +brews +ceremonially +appraisal's +commissioners +army's +assists +acceptor +comparison +cooling +conveniently +couching +changes +clinic's +confronting +adjunct's +blandness +alternates +bunter +consequent +clean +autos +accumulators +carver +aprons +awful +bobbins +blasphemy +assuming +abscess +assemble +cabinet +atomics +blacklists +audacious +assay +anthropology +barnstorm +awl +bumping +assembles +capture +compensates +coverable +amend +array +continually +absented +cigarette +antiresonance +backspace +branched +appellate +courtroom's +alienated +austerity +cement +asked +antelopes +cottager +bluebonnets +booze +amendment's +backslashes +begun +bijections +cafe's +boatload +collect +appeals +belittles +befit's +beauty +arrogated +academia +contagion +blemishes +coverlet's +comfortability +antecedent +controllably +congressman +complicate +coincide +arrears +clumped +credited +buffoon's +catholic +accompanist +beauty's +aster's +blatantly +bothering +bewilder +canceling +carbonizer +accentuation +backstairs +anticipations +bestowed +civilian +blooming +blunts +airlocks +argo +blueprint +aristocrat +cakes +complements +ale +camping +army +adrift +bengali +barely +blasphemes +briefcase +brooches +ailments +blazers +crevice's +bankrupt +archiver +articulator +alphabets +bonds +colliding +candidate +cashier's +bellwethers +airstrip +announcers +calendars +corrupter +aqueduct's +axiom +bathing +blusters +ascribed +admittedly +angrily +analytical +contraption +convertibility +abysmal +cathedral's +aversion's +algol +articulately +breveted +bickers +chatterer +adoptive +bijectively +cloudiest +coarseness +carted +cocktail's +capacious +anion +buffoons +bleeding +bedrock +adventurer +compositions +camouflages +brittle +chip's +aloe +chorus +cargo +critical +biographer's +abject +blasphemousness +charmer +betray +blacking +awoke +allele +bags +claimant +clover +biographies +confound +advertises +crafter +cripples +bygone +concentric +couldn't +contentions +acrid +costume +aft +aesthetic +bandits +adducts +constellations +coffer's +created +commercial +art's +cookie's +ammonia +adjunct +articulateness +congratulated +crags +brandishes +annual +byword +affection's +college's +aboriginal +bikini +buttering +allotter +console +advent +activates +beverage +april +acceptable +barrel's +boys +attractor +azimuth +critics +ballooner +aren't +adulterating +criticise +abeyance +automatically +collaborative +capabilities +crawls +anomaly's +climaxed +animately +aroma +belie +attires +argumentation +baseboard +bluebirds +cactus +byproduct +balancer +beholder +conservationist's +betrayer +agony +accusingly +convict +coaxes +breeds +agitated +championship +brevets +auscultate +counselling +cornerstones +america +canoes +aspirator +compensate +antiseptic +bereave +absinthe +compose +collide +alabamian +candid +civilized +clamps +authoritarianism +colonist +bugging +bins +abashing +battlers +canning +berate +assembler +amateurish +boasted +angriest +bluffs +colonize +balcony +bleat +bustard's +attenuate +contagiously +bicep +babel +beatniks +brush +analogy's +audiologist +assessment's +camera +arbitrary +alleyway's +concession +constructions +accompanies +accretion's +aroused +charcoaled +belated +bottom +bloodshot +bisques +advocate +arabs +cathodes +adamant +challenge +absurdly +abolitionist +cleavers +bludgeons +bassinet +clause +coiling +cask +boob +azalea's +afghanistan +carriages +blade's +bobby +asinine +acclaiming +absorbed +blacken +cheating +bootleg +anonymous +addict +astonishes +awry +adequate +categorization +casks +blaster +aspirants +abscesses +airing +assumptions +capitalists +board +asynchronism +body +aye +contraction +athens +arsine +cohabitations +below +bows +aviator's +ampoule +connective +adapter +authenticate +blackboard +brilliant +appoints +attics +conquer +boning +comestible +camped +blonds +aisle +coals +billboards +characterizers +crow +clout +admirer +actuarially +abstruse +accessing +bonfires +clenched +characteristic +catching +chars +canons +barrier +championed +butterflies +completely +calendar +artwork +abjections +burgher's +correlates +arrivals +accepters +circuses +breadboards +accomplishment +analyzed +appropriates +cancel +bordering +aperture +civilizing +assortments +blackest +blitz's +copy +commenced +admirers +cheers +croppers +cliff's +circumstance's +bibles +buttressed +consecutively +birefringence +automaton +cheerless +chopping +ballooned +convent +acknowledgers +appointing +belies +comeliness +bangle's +communication +bisector +avocations +clique +brainstem +campusses +allocators +bramble's +assaults +commemorate +appendix +agent +apportioning +bottled +artifact's +block's +archery +bagatelles +candies +catched +cognitively +creepers +concentrated +bout +balustrade +abodes +carrying +confirming +cannibal +chinners +carbonate +anguish +butt +colons +ablated +corporation's +cock +convincers +beret's +bluish +compressive +authenticates +commemorative +bureaucracies +coinage +coach +assigning +concentrators +capitalizing +appraisals +belaying +candy +blossomed +bricks +atonal +analogue +caters +barbaric +applique +clink +audio +actress +assyrian +apprehension +conversation +apsis +bedevil +comics +affricate +comings +buttress +angering +buckboards +bombed +adversely +adequacies +commended +causeways +adherers +codes +aquaria +ape +bulks +compactly +brainwashes +bleats +commandants +conditionally +adjourns +clobbering +allowances +buildings +complemented +blanker +algeria +brief +creak +adductor +categorizer +approacher +argument's +clocked +bedazzle +cause +coordinator +buildup +countenance +abhorrer +backtracked +bogus +closer +broilers +chirps +adjournment +belles +bitingly +befogged +contexts +amorous +breeding +abortions +blockage's +alternatives +bouncing +beryl +ballistics +banters +carpenters +auction +bowdlerizing +brazen +bonuses +circulated +adultery +archival +bears +baptized +burglaries +borrowing +barbarous +casher +adolescents +atrophic +busily +aerating +coatings +athenians +casing +consuming +alphanumeric +beaches +bisection's +conjecturing +aspirate +biography's +accompany +bureaucrat +broomstick's +colony +coalesce +clock +bequeath +collaborates +belonging +configured +burlesques +anode +consenter +bug +counterpoint +counts +bangladesh +analogical +accident +bulky +affinities +abysmally +boorish +assiduously +cannisters +autocollimator +bassinet's +barrelling +blurts +carbonize +candle +act +addressees +constraints +boast +complaining +coziness +avocado +coolest +blank +beadles +anytime +covetous +appellant's +angers +academies +ageless +chased +constitution +consonant's +boosting +ascetics +aerosol +apse +blushes +clang +confers +confidentiality +coolie +colon's +chickadees +badminton +argonaut +constituting +aloha +contracts +broomstick +brackets +attendant's +connection's +conciseness +abstractor's +composes +chaste +assures +conjuring +barbital +bunion +bases +clowns +barrelled +audience +auctioneer +complexly +aviator +conjectures +backscatters +cheerfulness +communicating +agreement +bricklayers +bilabial +abstruseness +cobol +cooperating +admit +blundering +accelerates +assaulted +concealing +anachronism +bowels +butane +anniversary's +converts +convoyed +climates +barriers +clubbing +additives +bask +confessing +caravan +colonizes +continuous +cheerlessness +boggled +armpit's +bridgework +allegro +cricket +cannon +adoption +clanging +auscultations +billowed +alphabetize +airlift +appointee +boyfriend +chaotic +corrections +bonus +contrasted +convulsion's +confessors +adumbrating +autocrat's +coronary +authentic +barley +brawling +aegis +appends +bolshevism +charted +applicant +aileron +considers +chin's +alkyl +amendment +boulevard's +avian +breather +canyons +cannon's +apportion +badgered +augers +advisers +censuses +beveling +aught +arthogram +anonymity +appliance +atmospheric +anesthetizing +ambulances +blustering +burnt +chestnut's +collects +aliment +anxieties +championship's +channeled +arrival +amassing +corpse +bedtime +blackbirds +cats +constants +chemistry +brewery +brother's +boasts +accentual +bellwether +bely +courted +baroness +configure +collection +aviary +achieves +belfry's +beech +baseman +bacterial +contestable +blond +contracting +comparably +consultation's +booster +conspiracies +belief +candidate's +boardinghouses +connectivity +check +crazy +collided +assistant's +critic +bilateral +cheapening +appalled +autopsy +balled +abnormally +acquires +aloofness +backwaters +combative +computerizing +craters +contributorily +behaved +comers +axiomatizations +analogously +banjo's +cleanser +capitalizes +chamberlain +aggregates +amenorrhea +begins +condone +cleaved +bustard +adsorb +airedale +bridles +audited +could +amour +checkbooks +admiring +arrested +commerce +asbestos +can's +clamping +bathers +acknowledgments +census +acrobat +bargains +apogee +creaking +busboy's +additional +chants +circumvents +afloat +anyplace +alumnae +anions +classroom's +ballerina's +convents +angered +climbers +citation +cools +clamor +capaciousness +beatific +abrades +advocating +coverings +claims +brethren +advertised +atrophies +coffer +beagle's +brazenly +bitterly +clergyman +braiding +compressible +convicting +agreeableness +antithesis +cogently +botanist's +bidirectional +bewilders +airlock +costumer +blamelessness +agglutinins +catalyst's +allocation +annunciates +borderings +accomplishes +confronters +clinically +breadbox's +canvassed +communicative +coercing +backpointer's +bramble +congregations +crave +courtesy's +cocoon's +admitting +chieftains +acclimate +consequences +cones +contradict +axolotls +contractual +artist +atrociously +consecutive +berated +bluing +attacks +choruses +blatant +balance +amplifier +assist +analyst's +ambler +conveyance +compromising +baffler +corridor +bed's +condoned +boulevard +anomie +averages +basics +apologia +cabbages +concretes +alcoholic +aliased +chocks +balsam +collies +censor +arouses +conundrum's +academically +bent +codings +coastal +allots +acclaim +citations +cantor +circularly +boarder +caribou +biologist's +cowling +connects +chasing +bootstrap +backscatter +abstractly +corrupt +alleviating +biasing +abrade +arraignment +beaten +blanketing +compactness +adage +coincided +borate +bra's +concepts +bootleger +christian +argos +basal +abate +campuses +abridging +confusers +cabin's +audition's +amphibians +attractively +adhesive's +ascendency +beforehand +ache +brokers +bowler +criminally +american's +chock's +artillerist +appropriation +characterization's +artifices +annoys +constituents +bottle +beaned +consisting +beholding +ceremony +carpeted +absolutely +anorexia +accredited +azaleas +amaze +commit +afflicting +contriving +adventure +blood +blabbing +absoluteness +appreciable +approachers +bumptious +behavioristic +anticipates +adults +barnyard's +banging +banana +bilge's +aware +coheres +bronchi +commissioned +arrogation +confines +core +attenuation +afterwards +clearing +applies +alphabetized +cemetery's +campaigning +abolishes +brig +cheer +combers +backtracker +clinker +clouds +clog +berries +advising +childish +clobbered +bride's +astrophysics +canker +concatenate +bite +chagrin +bodybuilders +calamity +admiralty +councillors +competitive +assessments +copper's +cabling +casket +conducted +backplane +boyfriends +bingo +broader +confiscates +communicated +baton +cocktails +albanians +boardinghouse's +brats +akimbo +categorizers +comparator's +blackbird's +accidentally +companion's +clippings +accosted +bell's +burly +aggregations +boathouses +airmails +abreactions +changers +carbon +cleaners +bookkeeping +correlations +backer +conclusions +brainstem's +anecdotes +chateau +cogitating +amphibious +compounded +completeness +comptroller's +boatswain's +bolstered +acquiescing +actors +calorie's +adaptability +abstractor +bimolecular +belly's +automobile +automotive +analyticities +awesome +colonizer +approximated +chemist +coronet's +classmate +anteater's +altars +adulthood +amid +assails +blizzards +corroborative +biographer +compartment +blooded +bipartisan +bluff +aloof +bronchiole +clincher +congratulations +ablation +caught +collier +chooses +antidotes +artery +clearance +civility +basketball +auscultated +behaviorally +crowning +autobiographical +cheaply +brutally +agonizing +clerk +comprising +baller +confuses +acquiesced +astonishingly +birthplace +covered +chopper +combinator +benignly +bedside +blasts +billboard +appraise +aboveground +comforter +credulousness +battlefield +barefoot +cleverness +apparatus +bartering +bromine +aerodynamic +crabs +chains +airflow +allegrettos +armchairs +blacklist +approvals +bait +collections +antecedent's +airbags +casted +content +conferrer's +crouching +coughs +canal +amphetamine +augustly +bedraggle +arithmetic +cataloger +alluding +credulity +coffees +crueler +beautifully +caresses +correlative +consul +criticizing +couched +baths +alchemy +bargain +accomplishments +conveyer +benevolence +broil +chilling +axed +attire +collisions +categorizes +cited +aeration +accommodating +coordinations +boxcar +cattle +bullion +afternoon's +captures +afghans +comets +component's +ark +bounds +adjusting +bravely +capability +chap +absolving +aspirating +arcs +conspires +collaborated +admonishment +astounds +brasses +compromise +changed +consumers +connoting +buttonholes +cordial +anionic +chastisers +archive +alleviate +burglarize +acquainted +copiers +cashers +antisocial +creations +bookie's +censure +beadle's +banded +circled +bulged +cheapness +attorney's +chewer +bookshelf's +councillor +assertion +broom's +contemplations +club's +balkans +cherubs +alas +chair +apologizes +compartments +beyond +aptly +censured +allegros +boosts +card +arithmetizes +attainment's +arrester +anding +asker +compatibilities +confidentially +commissioning +cleaner +aversion +cooperative +battalion's +cemented +charity's +conceited +capable +anymore +computing +aping +chiefly +affair +beaners +allying +caption's +antipathy +causal +abyss +botchers +burglarizing +confidant's +activator +continent's +census's +brat's +antagonism +bedspring's +antiserum +charge +connector's +alike +believable +belfry +cast's +bureaus +beneficiary +abolisher +artichoke's +broadly +concurrent +alteration +bookies +crafts +bays +ass +bouquet's +ave +chords +crazes +anemic +appoint +beets +billing +contest +assassination +allot +brindled +acute +absolves +adsorbed +auxiliaries +belatedly +businesslike +assassinates +bookkeepers +bevel +adders +automate +archangels +breakfasted +changeability +contested +cradles +combatants +besieging +certainty +attempts +bankrupting +compiler's +complications +banquets +ancestor's +ail +abbreviating +compacter +approvers +acknowledges +comically +almonds +counsellors +calmness +assailed +crane's +baser +big +corruption +circuitry +briefness +community's +banquetings +alms +bass's +bellowing +adoption's +blockading +compellingly +builders +befallen +bombproof +cartons +chore +crimson +anther +clucks +assemblies +beatitudes +aspiration +compels +angst +balancing +bowstrings +bayonet's +butte +biomedical +casualness +accolade +blackberry's +bunched +affright +clung +burlesque +bare +corrected +arbitrate +cropping +coherently +bloodhound +circularity +courtesies +articulating +concluded +analogy +brutalized +airmail +cooperator +cousins +centralization +bibbing +beside +bravo +abductors +cars +bovines +bump +absconding +chins +chasers +boundary's +antecedents +awed +counselled +aback +attenuator's +blazer +bettered +awaken +abreast +beagles +artisans +buckled +credence +control's +bewhiskered +calloused +breathe +collaring +blossoms +bring +actualities +bivalves +animals +cowboys +constituency +affordable +acrobatic +attiring +boatswain +concurrence +abrasions +babel's +cowerers +chiffon +bostonian +criterion +blinds +cased +affections +conditioners +clutter +accrued +attractors +botcher +compunction +bludgeoned +censored +allah's +chronic +burrs +commodity's +appraiser +asserters +cheaters +besting +anchorite +combine +afforded +cigarette's +bathrooms +apostles +chloroplast +bootlegging +bibliographical +beans +bylaw +benefited +brochure's +cordially +brashly +beastly +bologna +alderman's +burning +billow +convert +buffaloes +comparatives +assistances +camouflaged +announcement +bobwhite +brawl +adducted +cavern's +affectation's +bandying +brunette +architect's +aphorisms +cremate +bray +billed +conception +battlefield's +bandaged +broaches +bazaar's +beatification +bigotry +clergy +abstains +befits +bantering +conceivable +attachers +analogies +bimonthly +august +additionally +confirmation's +ballooning +cardboard +belle's +counterparts +candor +bishop +comprehension +affronted +bravura +courting +antidote +buggies +arisings +appendix's +bright +categorize +cooking +agnostic's +billets +amok +bewitching +audiograms +column's +bussed +checkbook +alteration's +atherosclerosis +broached +based +cacti +boardinghouse +bowdlerized +anchoritism +achievement's +bald +cover +codifications +capacitor +brashness +causes +acyclically +argument +boarders +audiometer +compute +contribute +crisply +bitters +circumvent +assailant +bosun +buyers +alibis +blurting +coasts +bivouacs +arrogating +albanian +attempted +acquisitiveness +applauding +alfalfa +cantors +canonicalizes +alkaloid +bruising +associativity +budgetary +carbolic +clashing +buffalo +acorn +analyzing +backyards +comedian +betwixt +aces +chartered +additivity +becalm +combat +characterizations +clinics +bulbs +bloc +amenable +civilian's +breech +attainment +bounding +compiler +cotyledons +billboard's +caper +aphasia +chester +combats +biddable +articulates +caps +assignees +bifocals +beady +chinese +assertions +allegation +championships +accrue +containment's +croaking +classifying +annum +brightened +bits +appointer +besieger +citizen's +cerebral +canto +bakers +capitol's +authorizer +blockaded +anodizes +alarmed +buttressing +attenuates +bumptiously +chronological +colleges +coward +contraption's +abstractions +controversial +boric +bids +agents +backpointer +bumped +bottoms +bowlines +captivated +article +cliche's +chases +choker +bremsstrahlung +consult +adjudged +auctioneer's +covers +accurateness +clues +bugler +bareness +cedar +alleviation +anesthetically +backpointers +arched +administered +arrowhead +continues +asks +confessor's +allure +backlogs +childishness +appointive +covering +conscience's +bellows +blanked +considerations +appalachian +aerate +budged +city's +accordion +cliche +collectors +comprehensive +boomed +chariot +baffling +bunkmate's +bumbles +contaminating +corroborating +applications +bursting +cabbage +befalling +acquittal +compromisers +components +arpeggio +brothel's +credibility +begrudge +confirmation +academy +appertains +calibrates +bureaucrats +bawl +costuming +biography +adoration +cloaks +aggregating +business +aphorism's +carters +admixture +coexistence +anomalously +adapts +amide +affiliation +capillary +biscuit +brainy +bellhops +chartings +cohered +austria +champions +basin's +cascading +consultants +bison's +admixed +arithmetically +clothed +betterments +conspirator's +addition +adolescence +bolsheviks +abominable +breathless +cozy +arouse +bumble +about +apace +astronaut +asteroid +cable +crab's +beachhead +assets +analyses +bisection +coconuts +alleys +armament's +bloodstains +arpeggios +apologist +blithely +anabaptist's +beadle +channelled +confuse +annoy +beautifiers +cheats +clenches +amuse +bewail +constitutional +birth +appendixes +amazed +berry's +bilingual +blustery +amplification +clogged +blackmailing +breakables +adduct +bondsmen +conferred +codewords +bequeathal +abundantly +banner's +atrocity +congested +closely +absolution +concatenations +anarchic +crag's +communicators +cavities +comptrollers +backstage +bewailing +charcoal +conveyances +collar +bores +briefest +comments +awning's +associator's +antarctica +correspondingly +bidden +ad +clings +bit's +apollo +bulldogs +chateau's +amounting +cogitates +bellhop +bookish +bout's +cannister +bicep's +asses +beef +battlefields +consort +auspicious +breezy +buried +beverages +approximates +conduction +bleakly +blanketers +ascertained +absentminded +bolivia +births +behave +bilk +breaths +charter +abstaining +appareled +boulder's +breadwinner's +correct +accessed +befitted +adulterer +axe +activation +betrothed +asymptote +bullet's +clusterings +baud +bustling +ballplayer +constraining +cleared +brown +affirmed +agencies +churches +backyard +burntness +bronchioles +charmers +backscattered +abridgment +claw +blow +adjourning +constantly +brightens +autobiography +cards +bypassing +alcibiades +concurrency +chuckles +bests +belligerents +adjustments +bolshevik +cabins +astronomically +cartridge +boxcars +boned +bottomed +burgeoned +adjourned +apprenticeship +chastiser +breached +boycott +butchered +coordinating +cottage +brainwashing +confinement +bandies +absentee +collapses +cruel +along +alloy +convoying +assignment's +crisp +ambidextrously +blindfolded +chilly +condenses +avers +broiler +anesthetics +beaker +cholera +brag +coffins +cranked +allocator +brutality +acquire +blushing +briar +abolish +crossovers +broiling +consolers +beatify +almanac's +cooled +commencements +clasp +committing +condemnations +altar +by +bombastic +confederates +bong +concerted +compilers +counterproductive +brig's +accurate +avidity +cleavage +blame +conceive +assessor +consolingly +concise +computes +alliance +clucked +axon's +annunciating +baseball's +allusion +brays +auras +blond's +bronchitis +ciphers +blowing +broth +canonically +baseness +byline's +appetite's +colonists +condensed +cawing +beaning +broadening +colonist's +apocrypha +chauffeured +cored +branding +carrier +assessed +collegiate +chirped +accounted +clubbed +antibodies +behalf +alphabetizing +conqueror +alpine +budgeters +casements +appropriate +compliments +cast +accountancy +cathedral +conserve +accorders +arbitrarily +cowing +bars +bagel's +climax +attention's +cautioning +centipede's +almost +abstractionist +carpenter +containing +arab's +courtesy +carton +accelerated +bowman +boastings +banal +bucking +accomplishment's +classification +baldly +abruptness +calibrations +blocs +biking +assenter +adversities +compartmentalized +chemical +attic +audiogram's +applauds +crests +bad +bounce +accelerators +contemptuous +attentions +cancellation +battles +aging +advantages +anthologies +answers +bruised +castes +any +coped +arcade's +adaptively +arsenal's +confessed +controllability +acceptor's +abrogated +abutted +amusingly +apology +broils +court +boundaries +bode +collie +adiabatic +ambitions +charged +awfulness +consorts +botanists +blurring +absents +batten +backwoods +breaks +certified +chattering +admitted +bathrobe's +analogous +corporacy +bijection's +combatant +checked +condition +amoral +bayed +bedroom +chanting +antics +charity +blip's +biped +brilliance +catchers +booted +anabaptist +clothe +comforted +complaints +coacher +admissible +bang +concisely +cookery +capita +assurance +codifying +benchmarks +aunts +commentaries +anon +applicators +constructor +associated +abuses +choicest +confiding +antislavery +apron +ashore +cheerfully +betterment +administration's +campaign +cremated +ambulatory +bleacher +afterthought +barkers +choir +crossly +conducive +cache's +battery +actinium +countryman +cajoled +appeasing +beamer +cleaves +anthem's +clearing's +cooperated +barker +crowing +apprising +accusation's +beginning +associator +booking +caved +amicable +codify +clairvoyant +bevels +becalms +brawn +bunkhouse's +arms +antiredeposition +belt +antiphonal +cried +brae's +bridal +acronym +clay's +checkers +auxiliary +bind +compares +agilely +askers +blankly +antagonist's +bimodal +captivation +creditable +concentration +calling +bartender's +autopsied +correspondent's +carnivals +abjure +bystander's +bungle +chanticleers +conceding +burghers +boards +accessions +compensations +arabian +churn +crowed +centering +abnormalities +courtier's +congregation +aberrant +annexing +blockhouse +anthropomorphic +bedder's +abutting +conundrums +affiliated +cancellation's +bolts +ballgowns +augmenting +bureaucracy's +bootlegged +audiometers +blueberry +affliction +appreciation +codifier +amasses +countering +crackle +canoe +consuls +breathes +broiled +amalgam's +bodes +ballooners +coating +corollaries +amphibology +agenda's +chafing +alcoholics +accredit +anisotropy +anchovies +carriers +acceptors +betrayed +buttocks +busy +bunny +cropper +accreditations +bumblebee's +adhesives +civilize +accedes +abroad +arch +crept +cotyledon +alphabetic +braille +amateur +adjure +ascertaining +budge +adulterate +additive's +cardiac +born +brewed +borneo +bun's +blue +cackled +acclimates +airline +blinder +brokerage +communicant +central +aggrieved +asynchronous +bough's +acidly +archaeology +complementary +animator's +bodyguards +climbs +apathy +constellation's +acculturate +archaeologists +contingents +control +anglophilia +billings +corporate +athlete +accusing +appear +announcing +accordions +computerize +combinations +bile +abut +charger +columnize +computer +blacks +converges +blamer +bulked +convincingly +checker +correspondence's +accelerate +accessible +conceivably +abscissa's +adsorbs +anglophobia +anomic +casters +churning +crease +brood +appendage +bulwark +bombers +arcaded +breadboard's +aphrodite +color +commodore's +answerer +bobolink +cloth +conversion +clime +artery's +birthplaces +compiled +arrack +beetles +bobs +compatibility +cocoon +counterpart +audible +colonies +airport's +beige +cogent +bromide +begrudging +acids +crucifies +beggary +archipelagoes +availably +counterfeiter +blanketed +amending +accelerometer's +advisors +byway +alignment +amber +austin +copyrights +beaus +brigantine +comforts +appointment's +crawler +bangles +contemplation +concur +characterizing +censoring +charters +catalogues +appropriately +builds +aeronautic +confused +comber +axially +cackler +coercive +ambassador +arcades +brash +amorality +belittling +battling +bloodied +acrylic +bantered +clasped +carcass +archangel +annunciators +aristotle +boulder +burglarproofs +chooser +abilities +calmest +bach +always +blaspheming +crossover +bakeries +clocks +ankle's +accidental +arbitration +chirp +aeronautical +boy's +acidic +bowline +anonymously +cod +couplers +beautifications +bluffing +backarrows +brow +covenant +acronym's +banning +albeit +ascetic +burn +animator +beatnik's +coveted +cipher's +broke +cap +bellman +bulldozed +clarifies +bathes +blip +availabilities +booth +clangs +audiences +cathedrals +confounding +bigot's +beecher +arts +company +attributed +avenged +bawling +caustics +alee +bordello's +banks +affords +complied +commas +collaborate +aquatic +ambitiously +burro's +beard +bittersweet +candlestick +bylaws +broadcastings +believe +barrels +braying +certifications +contrasts +crashes +audition +confine +bucks +abates +bureaucracy +ambles +besiege +broccoli +antibiotics +attenuators +accelerometer +caste +bib's +browbeaten +appurtenance +bauxite +asceticism +case +chewing +aerator +achievements +barricade's +agglutinates +bewildering +cartridge's +children +bufferrer +actuator +converging +bolted +chat +combs +chemist's +adduced +algebraic +circular +bloated +conclusion +burgess +certifies +absconds +comprise +benzedrine +bumbler +banjo +allow +appealing +cooperation +abraded +chaperoned +biracial +braced +censurer +acoustician +appraised +benefitting +constructs +convertible +administrative +asocial +area +creature +besetting +crater +begrudgingly +blanket +ablest +alba +airplanes +allowing +briefly +beneficences +concurring +adjective's +cork +aerospace +anomalies +asher +auger's +boilers +abhorring +broadenings +bladder +belay +approver +abdominal +commends +cringing +billiards +beater +auspice +contrasters +bights +absentees +atoll +cooler +activator's +basement +burgeon +allusiveness +codeword's +bandage +contemplate +adopted +coping +carving +baptism +colds +altos +background +closet +commuted +acre's +aliens +council +cans +cheese +ally +aseptic +belgian's +crossbar +addressed +commons +call +careers +breakfasting +brazilian +catholics +bachelors +consultant +brighter +crossword's +burglar +avoidable +batting +cigar +amps +axiological +combed +comforters +albumin +cookies +booming +archaize +canton's +bunkmate +combination +bondsman +anxiously +affixed +associatively +cigar's +backstitch +calls +captivates +commodities +atmosphere's +asserting +beaver +beatnik +container +activists +consoler +commoner +buttonhole's +abhorred +aggregate +cliff +antidisestablishmentarianism +broach +ambling +comer +bited +advocated +behaves +bosom +continents +conserves +bashful +ago +backarrow +circumventable +avocados +briar's +annuls +barnstorming +aired +carry +crossbar's +aspire +beards +abides +cliques +completes +brassiere +absorbs +annul +chairman +baron +battens +africans +abatement +colonization +carries +borough +allurement +breakfasters +alkali +acoustically +corners +capturer +casualties +asphyxia +animized +administrator +belying +basketballs +bylines +bandit +autopsies +braining +contradiction's +antic +butted +bacillus +blurt +conditioned +backers +agreeable +almanacs +cider +chicken +chambers +clutch +assailant's +conveyers +amazers +beribboned +breeder +caveat's +buffers +combination's +ampersand's +crafting +clanged +caving +aspirant +butlers +adjective +auckland +announced +creators +caches +baseline +codifies +baptism's +coarsened +cohesion +airman +avenge +backaches +budgeted +armpit +bicycled +converged +besmirched +autonomic +coming +assemblage's +chained +admissions +alcoholic's +branches +bunk +anciently +bloods +adventurers +amazes +coloring +abstractors +adaptation's +boar +amulet +agglutination +conquerable +booker +confronts +barometer's +bedbugs +barricades +cheap +bewitch +circus +backward +archeology +automobiles +bending +amino +beckoning +admits +berliners +borer +clambering +atomizing +banner +blissfully +catchable +breakdown +abjured +computerized +chaplain's +amphitheater +ballot's +craziness +croaks +counties +adopting +breast +airstrip's +basin +contemplating +commitments +critique +appears +bellies +baccalaureate +abducted +blackened +animosity +appraising +antiquity +assistants +asthma +bootstrapping +bounties +agleam +advertisements +benches +artful +broadens +chuck's +betrayal +blasphemed +brooms +castled +coroutine +conscious +beetle +banshee +advertising +baring +awakens +balm +billions +compromisingly +ballroom's +burrower +bayou's +ambiance +beheading +bought +adagios +adornment's +anointed +abolishment's +anesthetizes +badly +boyishness +consultant's +cheek +cannibals +breakdowns +assured +agates +bicker +appliances +cafe +bagpipes +adrenal +combinatorially +belligerence +bricked +adjacency +aimless +crook +cherry's +assessing +brushfire +cormorant +captained +blundered +conceptually +congress's +contraster +ambushes +bronze +autotransformer +corded +brisker +contently +announcements +bullet +apportionments +columnized +canon +conservation +algaecide +blackening +compassion +beaks +constructibility +chapter +abscond +costly +bacon +coldest +aptness +billionth +altercation +approbation +alternator's +criticizes +befell +canopy +buoyant +brazil +anticipate +absenteeism +champion +aesthetics +cadence +betroth +confidants +bean +braid +aphids +cluttering +cantankerously +bloom +barbarity +clawing +bogged +agreed +asia +abrasion +corporals +baselines +box +chartering +apotheosis +ampersands +conceit +creamer +adhered +circuit +carpet +accompaniments +boomerangs +blindness +chipmunks +bewitched +allocate +bicycle +compacted +cab +calcium +cellists +apex +borrows +completed +brightly +constables +ascertains +conspiracy's +badgers +bunion's +anabaptists +broadband +clefts +accepted +benched +catalogued +cadenced +alliteration +acquiesces +boxcar's +athlete's +bracing +cremations +analysis +crossings +assorts +apologize +brazier +configurable +basking +craves +belle +conversation's +belligerent +anesthetize +brewers +cackles +adventures +airlock's +booklet's +apply +anecdotal +bewails +computer's +autographs +acclimated +coefficients +avidly +beckoned +broadener +bulk +blacklisting +belly +acquit +convoy +achiever +aversions +advisor's +captor's +camel's +asset's +advantageous +basement's +confident +crescents +compiling +butler's +cartoon's +adaptive +chlorine +abets +cruelly +amiable +baleful +ceiling's +adumbrated +cherry +aspirant's +cashing +candidly +chaff +bitter +brim +alcove +bulb's +carbonizers +citizen +attic's +breed +consumer +conferrers +accommodations +contrapositive +beget +brilliantly +attentionality +continuation's +bosses +brave +configurations +benediction's +conferring +accessor's +bobolinks +bulled +cleanness +algorithm +advancements +altogether +accumulations +albacore +bowing +belching +apical +consequentiality +bagpipe's +ambrosial +bullying +cleans +attendance's +complimenter +blink +cager +assembling +coat +allowable +astringent +antiresonator +cardinal +clicks +commentator's +blossom +categorizing +amphibian's +commonality +consonant +classics +affable +accorded +aimlessly +archetype +administerings +boldness +anatomy +apprehensively +absence's +actuality +attempting +categorical +checkpoints +allemande +corer +behoove +bleaches +bough +blended +blotting +baptists +courtship +benevolent +bumptiousness +chum +anguished +auto +career +bookstore's +carbonized +autocratically +cherishes +attendees +contends +anastomotic +attributing +abbot +came +blunt +battlement's +affection +coordination +annotate +besets +bucked +boasting +benedictions +adherent +blimp's +acknowledging +cleverly +applejack +annexation +bat's +cantons +beetled +closed +country +creatively +bakery +blasphemously +chalking +bold +attended +crasher +backtrackers +artist's +bracelet's +allowably +affiliating +arrant +brayed +barbells +consigned +abolishers +climatic +atrophying +amigo +arsenal +ascribes +converses +aura's +allotted +bliss +classical +bigger +ahead +chopped +blade +casualty +acceded +bottling +axon +casement's +battlefront's +convinces +alerting +advertisers +blemish +agglutinating +commonplaces +autocorrelation +armistice +crediting +besmirch +amplify +auscultation +befalls +called +alnico +arbiter's +abort +argonauts +cessations +cribs +blare +aforementioned +condemners +contaminated +complained +bootstrapped +criticism +cooperatively +binding +bullies +basins +contrived +assort +adulterously +booms +abandons +also +appealed +count +contributed +beet +crashers +carryovers +clays +blackness +cosmetics +awkward +blurted +bothers +analyzer +backups +alarming +bicyclers +credit +abrogate +audience's +architecturally +alibi's +complicator's +chuckle +corporately +banishment +communist's +birdie +asymptotic +break +braze +benzene +bridgework's +beak +agitators +collateral +arranges +bayonet +breathlessly +counsellor +creates +convulsions +backdrops +applicants +altercation's +commission +breathtakingly +corresponds +backdrop +armaments +build +biannual +buttoning +computational +chaired +bather +critically +amanuensis +bantus +confidential +annoyance's +carder +authorizing +acquits +bipeds +cocktail +cinnamon +burros +brocade +abdomen's +creative +acquisition's +abdomen +baited +aristocratically +alive +committed +arrestor +cleaving +comedy's +baggage +bra +adaptors +afoot +bulls +contoured +amalgam +comprehensibility +amortizes +biographical +confront +covert +cravat +animates +booksellers +bypass +bootleggers +bedfast +affair's +buzzer +bellowed +aligning +bystander +acclimatized +accomplishing +against +blankness +adopt +addressing +croaked +boaters +behooves +audits +boatyard +cruise +agnostics +ailing +anchorage's +adaptations +conceptualize +advised +cries +bank +actuators +brazing +catalyst +beachheads +aplomb +compressed +amputated +contractor's +bedspreads +bowed +coon +chaplain +cannons +coffers +assembly +bouffant +converters +ampoule's +borderland +archaeologist +blankets +conserving +avalanche +assortment's +aspic +axle +bereaves +allowance +carbonization +bartender +clawed +coincidental +appeared +chipmunk's +countable +authenticators +bestow +alps +caw +aniseikonic +avows +blackmails +controlling +correlating +audiologist's +bit +approving +collapse +coon's +cleave +atheists +brigade +autopilots +bounteous +commercialness +accede +cavalierness +accustoming +burnishing +clobber +aspirates +brochures +cellar's +communes +berkelium +chickadee +cobweb +circumstances +chose +comprehend +baritone's +aggravation +adopts +cruelty +and +axer +cautioned +carbonic +babbles +bet +charitable +computable +cardinality +amenities +confiscating +catcher +audaciousness +complaint's +cooperator's +buddies +baking +constant +classmate's +accentuate +choices +crop's +authorization's +comedy +brushy +brotherly +canals +ads +causeway +abrading +cemetery +autocrat +briefing +abdomens +apparition's +consummately +alkaloids +bulkheads +cravats +bales +campaigners +bagpipe +accentuates +arm +barometric +bas +agitator +behavior +abutters +blockades +alertness +civilizes +chinner +anthropologist +artificialness +balkanize +automates +cackling +anarchists +amounted +cereal's +anodized +cobblers +acknowledgment's +blear +copper +alphabetics +blackboards +apish +answering +afternoon +arbors +accused +chickens +agency's +contractors +contraptions +cosmology +anomaly +bandstand +attempter +account +challengers +admiration +calculations +autocracy +analyticity +accord +buildup's +commonly +babbling +adjudication's +attain +ameliorating +candlestick's +chronicles +align +consensus +agate +adulation +aspirated +conclusive +biologists +cracks +conform +chambered +beryllium +connote +amusing +aquifer +ankle +batteries +conservationists +accountants +apiaries +actinometer +beckon +clearances +clouded +antitoxin's +consolation's +collectives +boxtops +bombarded +bombarding +bluest +allusion's +construction +ballpark's +codified +coincidence +celebration +chip +beginner's +algerian +boo +athletics +condenser +bytes +beauties +concerts +conductors +awl's +agitations +buttered +codifier's +armory +ascii +aspirin +arthritis +bylaw's +conformity +blasting +coinciding +aphid's +ceremonial +banisters +bristle +bid's +buckboard's +bandied +biopsy +ballrooms +chloroplasts +bidding +boil +algebra +constellation +chuck +cringes +cleanliness +apron's +cosmopolitan +bashes +abusive +believer +conductor +butters +breweries +allotment +artfulness +bunkmates +blares +connections +anticipated +classifies +commandments +beginnings +bend +brambles +blacked +basketball's +affectionate +cocoa +anacondas +busing +bone +birchen +creamed +aged +commemorates +brother +aberration +crawl +actuarial +apology's +alumnus +adversary's +anaphoric +aspiring +consciousness +cokes +assignee +boxing +blanched +camels +contemporaries +carnivorous +assigned +apologetically +corpus +accusations +beefing +champaign +claps +adherence +aloft +complication +citizenship +becomes +compound +arabesque +bronchiole's +appraises +breach +collection's +botched +bitches +biblically +bronchial +amalgamating +commoner's +barbarian's +arrange +cradle +conformed +complimentary +anodes +cowering +anoint +brocaded +bedazzling +avionics +burnishes +bulkhead +chink +consciously +contract +clinch +applicant's +awning +aloud +chandelier's +cathode's +babble +arachnid +biplane +clamorous +assuredly +consented +axing +avenger +commence +braving +brandishing +careless +burningly +boatsman +channelling +clarifying +beggar +berates +cite +cowered +buffer +condescending +admixes +bettering +bedazzlement +cord +burglary's +characteristics +aptitudes +adieu +agree +bends +ceremonies +accustom +accessibly +commanders +ask +cavalier +brayer +affront +courser +becoming +carves +configures +beasts +biters +conditionals +bodybuilding +accretions +chapter's +cleverer +corning +brat +classes +almsman +consumptive +antique +comprised +beholders +anthropologically +buns +bridge +accretion +acceptance's +confederacy +armorer +argumentative +crossword +cowslip's +analog +counselor +chastised +barters +clerked +americas +cloud +aide +alternators +admitters +bagatelle +bridges +civilizations +anion's +briton's +apartment +acquaints +consummation +chord +coated +barer +carnivorously +cheering +allergy +capacity +classrooms +assistantships +complimented +amphibiously +commandment's +audiogram +corked +badness +bewildered +assemblage +backplane's +asterisk's +blob +coexisting +approximations +counteractive +barns +adherer +aborigine's +brooding +conceived +adjustor +cabled +belongings +breadwinner +blot's +brightness +consigning +barflies +bisector's +basing +complement +conditioner +brazes +crank +antinomian +crowd +accelerometers +befitting +backlash +bastions +acceleration +briefcases +correlated +baffle +chew +accosts +agreeably +bassinets +cogitate +concerning +contouring +broadside +compact +brainstems +atom's +bondage +biter +archdioceses +basis +bellboy +blobs +barons +clods +campaigned +assessors +bubbles +annal +casual +altercations +clog's +biased +arianism +ancillary +collaborator +butter +bureau +blending +antiquities +brands +activism +crews +beats +broad +buds +baggers +cobbler's +condemns +cabinets +bomber +blinders +center +contacted +bewilderingly +circulates +burnings +achieved +belch +barbecue +angles +comparative +befuddle +cherished +chapters +chanter +allegation's +armstrong +converter +combinatoric +angrier +brooks +clinked +blubber +appointments +compactor +cleaned +car +contention's +artificial +cramp +consistency +aborting +collaboration +awarders +crippled +anaphora +creamy +buoyed +baptistery +altered +anchoring +alterer +adjuring +beacon's +commencement's +ascension +candidness +clouding +cigars +boiled +christmas +contingency's +alum +apparel +contributors +anisotropic +annotations +bushwhacks +brides +continuities +carton's +blurred +antibody +aorta +blankest +combinator's +banish +breaches +accumulates +bowling +braver +antibacterial +cooperators +banked +compensated +chartable +conjunctively +antelope's +bluefish +annoying +composed +barges +biconcave +australia +ballparks +bearers +acknowledged +advocates +crossed +competitor +blaming +andorra +baritone +collaborator's +accessibility +complains +commentator +bibliography +conference's +atmosphere +agrees +bedstead's +ardor +character's +conventionally +arena's +chokes +channel +bludgeon +convoys +condense +beautifier +ailerons +compacts +black +bell +completions +ballroom +besotting +conservatives +adventured +bulldog's +conversely +arroyos +compositional +alternative +association +broods +beefy +consolidated +balms +acquaint +animal +certificate +combustion +aims +cracker +abetted +cautionings +bread +attains +agriculturally +courtyards +bawls +country's +creator's +checkbook's +cliches +colonizing +biennial +aqueous +craftsman +contrivances +algorithmic +crate +barefooted +bodily +anthropologist's +but +climate's +campers +crackled +awakes +conveyed +borrowers +approached +avoids +crib +albania +bathrobe +admonitions +architectures +consenting +anastomosis +blob's +actual +arrowhead's +accountable +allegiances +commendation +appearers +comply +concurs +controversy +abstracting +artifact diff --git a/bdb/test/wrap.tcl b/bdb/test/wrap.tcl new file mode 100644 index 00000000000..4a5c825d8f0 --- /dev/null +++ b/bdb/test/wrap.tcl @@ -0,0 +1,58 @@ +# Sentinel file wrapper for multi-process tests. +# This is designed to avoid a set of nasty bugs, primarily on Windows, +# where pid reuse causes watch_procs to sit around waiting for some +# random process that's not DB's and is not exiting. + +source ./include.tcl + +# Arguments: +# +if { $argc < 3 } { + puts "FAIL: wrap.tcl: Usage: wrap.tcl script log scriptargs" + exit +} + +set script [lindex $argv 0] +set logfile [lindex $argv 1] +set args [lrange $argv 2 end] + +# Create a sentinel file to mark our creation and signal that watch_procs +# should look for us. +set parentpid [pid] +set parentsentinel $testdir/begin.$parentpid +set f [open $parentsentinel w] +close $f + +# Create a Tcl subprocess that will actually run the test. +set t [open "|$tclsh_path >& $logfile" w] + +# Create a sentinel for the subprocess. +set childpid [pid $t] +puts "Script watcher process $parentpid launching $script process $childpid." +set childsentinel $testdir/begin.$childpid +set f [open $childsentinel w] +close $f + +# Set up argv for the subprocess, since the args aren't passed in as true +# arguments thanks to the pipe structure. +puts $t "set argc [llength $args]" +puts $t "set argv [list $args]" + +# Command the test to run. +puts $t "source $test_path/$script" + +# Close the pipe. This will flush the above commands and actually run the +# test, and will also return an error a la exec if anything bad happens +# to the subprocess. The magic here is that closing a pipe blocks +# and waits for the exit of processes in the pipeline, at least according +# to Ousterhout (p. 115). + +set ret [catch {close $t} res] + +# Write ending sentinel files--we're done. +set f [open $testdir/end.$childpid w] +close $f +set f [open $testdir/end.$parentpid w] +close $f + +exit $ret |