sdbtest002.tcl 5.16 KB
Newer Older
unknown's avatar
unknown committed
1 2
# See the file LICENSE for redistribution information.
#
unknown's avatar
unknown committed
3
# Copyright (c) 1999-2004
unknown's avatar
unknown committed
4 5
#	Sleepycat Software.  All rights reserved.
#
unknown's avatar
unknown committed
6
# $Id: sdbtest002.tcl,v 11.29 2004/01/28 03:36:30 bostic Exp $
unknown's avatar
unknown committed
7
#
unknown's avatar
unknown committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
# TEST	sdbtest002
# TEST	Tests multiple access methods in one subdb access by multiple
# TEST	processes.
# TEST		Open several subdbs, each with a different access method
# TEST		Small keys, small data
# TEST		Put/get per key per subdb
# TEST		Fork off several child procs to each delete selected
# TEST		    data from their subdb and then exit
# TEST		Dump file, verify contents of each subdb is correct
# TEST		Close, reopen per subdb
# TEST		Dump file, verify per subdb
# TEST
# TEST	Make several subdb's of different access methods all in one DB.
# TEST	Fork of some child procs to each manipulate one subdb and when
# TEST	they are finished, verify the contents of the databases.
# TEST	Use the first 10,000 entries from the dictionary.
# TEST	Insert each with self as key and data; retrieve each.
# TEST	After all are entered, retrieve all; compare output to original.
# TEST	Close file, reopen, do retrieve and re-verify.
proc sdbtest002 { {nentries 10000} } {
unknown's avatar
unknown committed
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
	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
unknown's avatar
unknown committed
46
	puts "\tSubdbtest002.a: create subdbs of different methods: $methods"
unknown's avatar
unknown committed
47
	set psize 4096
unknown's avatar
unknown committed
48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
	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
	}
unknown's avatar
unknown committed
78
	watch_procs $pidlist 5
unknown's avatar
unknown committed
79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136

	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.
unknown's avatar
unknown committed
137
		open_and_dump_subfile $testfile NULL $t1 $checkfunc \
unknown's avatar
unknown committed
138 139 140 141 142 143 144 145 146 147 148
		    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"
unknown's avatar
unknown committed
149
		open_and_dump_subfile $testfile NULL $t1 $checkfunc \
unknown's avatar
unknown committed
150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
		    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)
}