← Back to branch summary

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

« back to all changes in this revision

Viewing changes to db/test/test094.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/test094.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1996-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: test094.tcl,v 11.5 2001/07/12 16:31:48 sue Exp $
 
7
#
 
8
# DB Test 94 {access method}
 
9
# Test bt comparison proc.
 
10
# Use the first 10,000 entries from the dictionary.
 
11
# Insert each with self as key and data; retrieve each.
 
12
# After all are entered, retrieve all; compare output to original.
 
13
# Close file, reopen, do retrieve and re-verify.
 
14
proc test094 { method {nentries 10000} {ndups 10} {tnum "94"} args} {
 
15
        source ./include.tcl
 
16
        global errorInfo
 
17
 
 
18
        set dbargs [convert_args $method $args]
 
19
        set omethod [convert_method $method]
 
20
 
 
21
        puts "Test0$tnum: $method ($args) $ndups dups using dupcompare"
 
22
 
 
23
        if { [is_btree $method] != 1 && [is_hash $method] != 1 } {
 
24
                puts "Skipping for method $method."
 
25
                return
 
26
        }
 
27
 
 
28
        # Create the database and open the dictionary
 
29
        set eindex [lsearch -exact $dbargs "-env"]
 
30
        #
 
31
        # If we are using an env, then testfile should just be the db name.
 
32
        # Otherwise it is the test directory and the name.
 
33
        if { $eindex == -1 } {
 
34
                set testfile $testdir/test0$tnum.db
 
35
                set env NULL
 
36
        } else {
 
37
                set testfile test0$tnum.db
 
38
                incr eindex
 
39
                set env [lindex $dbargs $eindex]
 
40
        }
 
41
        cleanup $testdir $env
 
42
 
 
43
        set stat [catch {eval {berkdb_open_noerr -dupcompare test094_cmp \
 
44
            -dup -dupsort \
 
45
            -create -truncate -mode 0644} $omethod $dbargs $testfile} db]
 
46
        if { $stat == 1 } {
 
47
                #
 
48
                # Only failure we expect is for RPC.   We want to skip
 
49
                # for RPC, but we cannot tell if we are using RPC except
 
50
                # by the error message.
 
51
                #
 
52
                error_check_good dbopen \
 
53
                    [is_substr $errorInfo "meaningless in RPC env"] 1
 
54
                puts "Skipping for RPC"
 
55
                return
 
56
        }
 
57
        error_check_good dbopen [is_valid_db $db] TRUE
 
58
 
 
59
        set did [open $dict]
 
60
        set t1 $testdir/t1
 
61
        set pflags ""
 
62
        set gflags ""
 
63
        set txn ""
 
64
        puts "\tTest0$tnum.a: $nentries put/get duplicates loop"
 
65
        # Here is the loop where we put and get each key/data pair
 
66
        set count 0
 
67
        set dlist {}
 
68
        for {set i 0} {$i < $ndups} {incr i} {
 
69
                set dlist [linsert $dlist 0 $i]
 
70
        }
 
71
        while { [gets $did str] != -1 && $count < $nentries } {
 
72
                set key $str
 
73
                for {set i 0} {$i < $ndups} {incr i} {
 
74
                        set data $i:$str
 
75
                        set ret [eval {$db put} \
 
76
                            $txn $pflags {$key [chop_data $omethod $data]}]
 
77
                        error_check_good put $ret 0
 
78
                }
 
79
 
 
80
                set ret [eval {$db get} $gflags {$key}]
 
81
                error_check_good get [llength $ret] $ndups
 
82
                incr count
 
83
        }
 
84
        close $did
 
85
        # Now we will get each key from the DB and compare the results
 
86
        # to the original.
 
87
        puts "\tTest0$tnum.b: traverse checking duplicates before close"
 
88
        dup_check $db $txn $t1 $dlist
 
89
        error_check_good db_close [$db close] 0
 
90
 
 
91
        #
 
92
        # Test dupcompare with data items big enough to force offpage dups.
 
93
        #
 
94
        puts "\tTest0$tnum.c: big key put/get dup loop key=filename data=filecontents"
 
95
        set db [eval {berkdb_open -dupcompare test094_cmp -dup -dupsort \
 
96
             -create -truncate -mode 0644} $omethod $dbargs $testfile]
 
97
        error_check_good dbopen [is_valid_db $db] TRUE
 
98
 
 
99
        # Here is the loop where we put and get each key/data pair
 
100
        set file_list [get_file_list 1]
 
101
 
 
102
        set count 0
 
103
        foreach f $file_list {
 
104
                set fid [open $f r]
 
105
                fconfigure $fid -translation binary
 
106
                set cont [read $fid]
 
107
                close $fid
 
108
 
 
109
                set key $f
 
110
                for {set i 0} {$i < $ndups} {incr i} {
 
111
                        set data $i:$cont
 
112
                        set ret [eval {$db put} \
 
113
                            $txn $pflags {$key [chop_data $omethod $data]}]
 
114
                        error_check_good put $ret 0
 
115
                }
 
116
 
 
117
                set ret [eval {$db get} $gflags {$key}]
 
118
                error_check_good get [llength $ret] $ndups
 
119
                incr count
 
120
        }
 
121
 
 
122
        puts "\tTest0$tnum.d: traverse checking duplicates before close"
 
123
        dup_file_check $db $txn $t1 $dlist
 
124
        error_check_good db_close [$db close] 0
 
125
 
 
126
        # Clean up the test directory, since there's currently
 
127
        # no way to specify a dup_compare function to berkdb dbverify
 
128
        # and without one it will fail.
 
129
        cleanup $testdir $env
 
130
}
 
131
 
 
132
# Simple dup comparison.
 
133
proc test094_cmp { a b } {
 
134
        return [string compare $b $a]
 
135
}
 
136
 
 
137
# Check if each key appears exactly [llength dlist] times in the file with
 
138
# the duplicate tags matching those that appear in dlist.
 
139
proc test094_dup_big { db txn tmpfile dlist {extra 0}} {
 
140
        source ./include.tcl
 
141
 
 
142
        set outf [open $tmpfile w]
 
143
        # Now we will get each key from the DB and dump to outfile
 
144
        set c [eval {$db cursor} $txn]
 
145
        set lastkey ""
 
146
        set done 0
 
147
        while { $done != 1} {
 
148
                foreach did $dlist {
 
149
                        set rec [$c get "-next"]
 
150
                        if { [string length $rec] == 0 } {
 
151
                                set done 1
 
152
                                break
 
153
                        }
 
154
                        set key [lindex [lindex $rec 0] 0]
 
155
                        set fulldata [lindex [lindex $rec 0] 1]
 
156
                        set id [id_of $fulldata]
 
157
                        set d [data_of $fulldata]
 
158
                        if { [string compare $key $lastkey] != 0 && \
 
159
                            $id != [lindex $dlist 0] } {
 
160
                                set e [lindex $dlist 0]
 
161
                                error "FAIL: \tKey \
 
162
                                    $key, expected dup id $e, got $id"
 
163
                        }
 
164
                        error_check_good dupget.data $d $key
 
165
                        error_check_good dupget.id $id $did
 
166
                        set lastkey $key
 
167
                }
 
168
                #
 
169
                # Some tests add an extra dup (like overflow entries)
 
170
                # Check id if it exists.
 
171
                if { $extra != 0} {
 
172
                        set okey $key
 
173
                        set rec [$c get "-next"]
 
174
                        if { [string length $rec] != 0 } {
 
175
                                set key [lindex [lindex $rec 0] 0]
 
176
                                #
 
177
                                # If this key has no extras, go back for
 
178
                                # next iteration.
 
179
                                if { [string compare $key $lastkey] != 0 } {
 
180
                                        set key $okey
 
181
                                        set rec [$c get "-prev"]
 
182
                                } else {
 
183
                                        set fulldata [lindex [lindex $rec 0] 1]
 
184
                                        set id [id_of $fulldata]
 
185
                                        set d [data_of $fulldata]
 
186
                                        error_check_bad dupget.data1 $d $key
 
187
                                        error_check_good dupget.id1 $id $extra
 
188
                                }
 
189
                        }
 
190
                }
 
191
                if { $done != 1 } {
 
192
                        puts $outf $key
 
193
                }
 
194
        }
 
195
        close $outf
 
196
        error_check_good curs_close [$c close] 0
 
197
}