← Back to branch summary

~ubuntu-branches/ubuntu/edgy/rpm/edgy

« back to all changes in this revision

Viewing changes to db/test/dbm.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2002-01-22 20:56:57 UTC
  • Revision ID: james.westby@ubuntu.com-20020122205657-l74j50mr9z8ofcl5
Tags: upstream-4.0.3
Import upstream version 4.0.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
db/test/dbm.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1996-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: dbm.tcl,v 11.13 2001/01/25 18:23:03 bostic Exp $
 
7
#
 
8
# Historic DBM interface test.
 
9
# Use the first 1000 entries from the dictionary.
 
10
# Insert each with self as key and data; retrieve each.
 
11
# After all are entered, retrieve all; compare output to original.
 
12
# Then reopen the file, re-retrieve everything.
 
13
# Finally, delete everything.
 
14
proc dbm { { nentries 1000 } } {
 
15
        source ./include.tcl
 
16
 
 
17
        puts "DBM interfaces test: $nentries"
 
18
 
 
19
        # Create the database and open the dictionary
 
20
        set testfile $testdir/dbmtest
 
21
        set t1 $testdir/t1
 
22
        set t2 $testdir/t2
 
23
        set t3 $testdir/t3
 
24
        cleanup $testdir NULL
 
25
 
 
26
        error_check_good dbminit [berkdb dbminit $testfile] 0
 
27
        set did [open $dict]
 
28
 
 
29
        set flags ""
 
30
        set txn ""
 
31
        set count 0
 
32
        set skippednullkey 0
 
33
 
 
34
        puts "\tDBM.a: put/get loop"
 
35
        # Here is the loop where we put and get each key/data pair
 
36
        while { [gets $did str] != -1 && $count < $nentries } {
 
37
                # DBM can't handle zero-length keys
 
38
                if { [string length $str] == 0 } {
 
39
                        set skippednullkey 1
 
40
                        continue
 
41
                }
 
42
 
 
43
                set ret [berkdb store $str $str]
 
44
                error_check_good dbm_store $ret 0
 
45
 
 
46
                set d [berkdb fetch $str]
 
47
                error_check_good dbm_fetch $d $str
 
48
                incr count
 
49
        }
 
50
        close $did
 
51
 
 
52
        # Now we will get each key from the DB and compare the results
 
53
        # to the original.
 
54
        puts "\tDBM.b: dump file"
 
55
        set oid [open $t1 w]
 
56
        for { set key [berkdb firstkey] } { $key != -1 } {\
 
57
                 set key [berkdb nextkey $key] } {
 
58
                puts $oid $key
 
59
                set d [berkdb fetch $key]
 
60
                error_check_good dbm_refetch $d $key
 
61
        }
 
62
 
 
63
        # If we had to skip a zero-length key, juggle things to cover up
 
64
        # this fact in the dump.
 
65
        if { $skippednullkey == 1 } {
 
66
                puts $oid ""
 
67
                incr nentries 1
 
68
        }
 
69
 
 
70
        close $oid
 
71
 
 
72
        # Now compare the keys to see if they match the dictionary (or ints)
 
73
        set q q
 
74
        filehead $nentries $dict $t3
 
75
        filesort $t3 $t2
 
76
        filesort $t1 $t3
 
77
 
 
78
        error_check_good DBM:diff($t3,$t2) \
 
79
            [filecmp $t3 $t2] 0
 
80
 
 
81
        puts "\tDBM.c: close, open, and dump file"
 
82
 
 
83
        # Now, reopen the file and run the last test again.
 
84
        error_check_good dbminit2 [berkdb dbminit $testfile] 0
 
85
        set oid [open $t1 w]
 
86
 
 
87
        for { set key [berkdb firstkey] } { $key != -1 } {\
 
88
                 set key [berkdb nextkey $key] } {
 
89
                puts $oid $key
 
90
                set d [berkdb fetch $key]
 
91
                error_check_good dbm_refetch $d $key
 
92
        }
 
93
        if { $skippednullkey == 1 } {
 
94
                puts $oid ""
 
95
        }
 
96
        close $oid
 
97
 
 
98
        # Now compare the keys to see if they match the dictionary (or ints)
 
99
        filesort $t1 $t3
 
100
 
 
101
        error_check_good DBM:diff($t2,$t3) \
 
102
            [filecmp $t2 $t3] 0
 
103
 
 
104
        # Now, reopen the file and delete each entry
 
105
        puts "\tDBM.d: sequential scan and delete"
 
106
 
 
107
        error_check_good dbminit3 [berkdb dbminit $testfile] 0
 
108
        set oid [open $t1 w]
 
109
 
 
110
        for { set key [berkdb firstkey] } { $key != -1 } {\
 
111
                 set key [berkdb nextkey $key] } {
 
112
                puts $oid $key
 
113
                set ret [berkdb delete $key]
 
114
                error_check_good dbm_delete $ret 0
 
115
        }
 
116
        if { $skippednullkey == 1 } {
 
117
                puts $oid ""
 
118
        }
 
119
        close $oid
 
120
 
 
121
        # Now compare the keys to see if they match the dictionary (or ints)
 
122
        filesort $t1 $t3
 
123
 
 
124
        error_check_good DBM:diff($t2,$t3) \
 
125
            [filecmp $t2 $t3] 0
 
126
 
 
127
        error_check_good "dbm_close" [berkdb dbmclose] 0
 
128
}