dbm.tcl 3.14 KB
Newer Older
1 2
# See the file LICENSE for redistribution information.
#
ram@mysql.r18.ru's avatar
ram@mysql.r18.ru committed
3
# Copyright (c) 1996-2002
4 5
#	Sleepycat Software.  All rights reserved.
#
ram@mysql.r18.ru's avatar
ram@mysql.r18.ru committed
6
# $Id: dbm.tcl,v 11.15 2002/01/11 15:53:19 bostic Exp $
7
#
ram@mysql.r18.ru's avatar
ram@mysql.r18.ru committed
8 9 10 11 12 13
# TEST	dbm
# TEST	Historic DBM interface test.  Use the first 1000 entries from the
# TEST	dictionary.  Insert each with self as key and data; retrieve each.
# TEST	After all are entered, retrieve all; compare output to original.
# TEST	Then reopen the file, re-retrieve everything.  Finally, delete
# TEST	everything.
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 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 78 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
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
}