← Back to branch summary

~ubuntu-branches/ubuntu/precise/rpm/precise-proposed

« back to all changes in this revision

Viewing changes to db/test/test102.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Michael Vogt
  • Date: 2009-06-25 18:57:20 UTC
  • mfrom: (1.1.5 upstream) (4.1.2 sid)
  • Revision ID: james.westby@ubuntu.com-20090625185720-617sjskgtgmf09vf
Tags: 4.7.0-7ubuntu1
* Merge from debian unstable, remaining changes:
  - change build depends from libdwarf-dev -> libdw-dev
    (libdwarf-dev is in universe)

Show diffs side-by-side

added added

removed removed

Lines of Context:
db/test/test102.tcl
1
 
# See the file LICENSE for redistribution information.
2
 
#
3
 
# Copyright (c) 2000-2004
4
 
#       Sleepycat Software.  All rights reserved.
5
 
#
6
 
# $Id: test102.tcl,v 1.9 2004/02/05 02:25:24 mjc Exp $
7
 
#
8
 
# TEST  test102
9
 
# TEST  Bulk get test for record-based methods. [#2934]
10
 
proc test102 { method {nsets 1000} {tnum "102"} args } {
11
 
        source ./include.tcl
12
 
        set args [convert_args $method $args]
13
 
        set omethod [convert_method $method]
14
 
 
15
 
        if { [is_rbtree $method] == 1 || [is_record_based $method] == 0} {
16
 
                puts "Test$tnum skipping for method $method"
17
 
                return
18
 
        }
19
 
 
20
 
        set txnenv 0
21
 
        set eindex [lsearch -exact $args "-env"]
22
 
        #
23
 
        # If we are using an env, then testfile should just be the db name.
24
 
        # Otherwise it is the test directory and the name.
25
 
        if { $eindex == -1 } {
26
 
                set basename $testdir/test$tnum
27
 
                set env NULL
28
 
                # If we've our own env, no reason to swap--this isn't
29
 
                # an mpool test.
30
 
                set carg { -cachesize {0 25000000 0} }
31
 
        } else {
32
 
                set basename test$tnum
33
 
                incr eindex
34
 
                set env [lindex $args $eindex]
35
 
                set txnenv [is_txnenv $env]
36
 
                if { $txnenv == 1 } {
37
 
                        puts "Skipping for environment with txns"
38
 
                        return
39
 
                }
40
 
                set testdir [get_home $env]
41
 
                set carg {}
42
 
        }
43
 
        cleanup $testdir $env
44
 
 
45
 
        puts "Test$tnum: $method ($args) Bulk get test"
46
 
 
47
 
        # Open and populate the database.
48
 
        puts "\tTest$tnum.a: Creating $method database\
49
 
            with $nsets entries."
50
 
        set dargs "$carg $args"
51
 
        set testfile $basename.db
52
 
        set db [eval {berkdb_open_noerr -create} $omethod $dargs $testfile]
53
 
        error_check_good db_open [is_valid_db $db] TRUE
54
 
        t102_populate $db $method $nsets $txnenv 0
55
 
 
56
 
        # Determine the pagesize so we can use it to size the buffer.
57
 
        set stat [$db stat]
58
 
        set pagesize [get_pagesize $stat]
59
 
 
60
 
        # Run get tests.  The gettest should succeed as long as
61
 
        # the buffer is at least as large as the page size.  Test for
62
 
        # failure of a small buffer unless the page size is so small
63
 
        # we can't define a smaller buffer (buffers must be multiples
64
 
        # of 1024).  A "big buffer" should succeed in all cases because
65
 
        # we define it to be larger than 65536, the largest page
66
 
        # currently allowed.
67
 
        set maxpage [expr 1024 * 64]
68
 
        set bigbuf [expr $maxpage + 1024]
69
 
        set smallbuf 1024
70
 
 
71
 
        # Run regular db->get tests.
72
 
        if { $pagesize > 1024 } {
73
 
                t102_gettest $db $tnum b $smallbuf 1
74
 
        } else {
75
 
                puts "Skipping Test$tnum.b for small pagesize."
76
 
        }
77
 
        t102_gettest $db $tnum c $bigbuf 0
78
 
 
79
 
        # Run cursor get tests.
80
 
        if { $pagesize > 1024 } {
81
 
                t102_gettest $db $tnum d $smallbuf 1
82
 
        } else {
83
 
                puts "Skipping Test$tnum.b for small pagesize."
84
 
        }
85
 
        t102_cgettest $db $tnum e $bigbuf 0
86
 
 
87
 
        if { [is_fixed_length $method] == 1 } {
88
 
                puts "Skipping overflow tests for fixed-length method $omethod."
89
 
        } else {
90
 
 
91
 
                # Set up for overflow tests
92
 
                puts "\tTest$tnum.f: Growing database with overflow sets"
93
 
                t102_populate $db $method [expr $nsets / 100] $txnenv 10000
94
 
 
95
 
                # Run overflow get tests.  Test should fail for overflow pages
96
 
                # with our standard big buffer but succeed at twice that size.
97
 
                t102_gettest $db $tnum g $bigbuf 1
98
 
                t102_gettest $db $tnum h [expr $bigbuf * 2] 0
99
 
 
100
 
                # Run overflow cursor get tests.  Test will fail for overflow
101
 
                # pages with 8K buffer but succeed with a large buffer.
102
 
                t102_cgettest $db $tnum i 8192 1
103
 
                t102_cgettest $db $tnum j $bigbuf 0
104
 
        }
105
 
        error_check_good db_close [$db close] 0
106
 
}
107
 
 
108
 
proc t102_gettest { db tnum letter bufsize expectfail } {
109
 
        t102_gettest_body $db $tnum $letter $bufsize $expectfail 0
110
 
}
111
 
proc t102_cgettest { db tnum letter bufsize expectfail } {
112
 
        t102_gettest_body $db $tnum $letter $bufsize $expectfail 1
113
 
}
114
 
 
115
 
# Basic get test
116
 
proc t102_gettest_body { db tnum letter bufsize expectfail usecursor } {
117
 
        global errorCode
118
 
 
119
 
        foreach flag { multi multi_key } {
120
 
                if { $usecursor == 0 } {
121
 
                        if { $flag == "multi_key" } {
122
 
                                # db->get does not allow multi_key
123
 
                                continue
124
 
                        } else {
125
 
                                set action "db get -$flag"
126
 
                        }
127
 
                } else {
128
 
                        set action "dbc get -$flag -set/-next"
129
 
                }
130
 
                puts "\tTest$tnum.$letter: $action with bufsize $bufsize"
131
 
 
132
 
                set allpassed TRUE
133
 
                set saved_err ""
134
 
 
135
 
                # Cursor for $usecursor.
136
 
                if { $usecursor != 0 } {
137
 
                        set getcurs [$db cursor]
138
 
                        error_check_good \
139
 
                            getcurs [is_valid_cursor $getcurs $db] TRUE
140
 
                }
141
 
 
142
 
                # Traverse DB with cursor;  do get/c_get($flag) on each item.
143
 
                set dbc [$db cursor]
144
 
                error_check_good is_valid_dbc [is_valid_cursor $dbc $db] TRUE
145
 
                for { set dbt [$dbc get -first] } { [llength $dbt] != 0 } \
146
 
                    { set dbt [$dbc get -next] } {
147
 
                        set key [lindex [lindex $dbt 0] 0]
148
 
                        set datum [lindex [lindex $dbt 0] 1]
149
 
 
150
 
                        if { $usecursor == 0 } {
151
 
                                set ret [catch \
152
 
                                    {eval $db get -$flag $bufsize $key} res]
153
 
                        } else {
154
 
                                set res {}
155
 
                                for { set ret [catch {eval $getcurs get\
156
 
                                    -$flag $bufsize -set $key} tres] } \
157
 
                                    { $ret == 0 && [llength $tres] != 0 } \
158
 
                                    { set ret [catch {eval $getcurs get\
159
 
                                    -$flag $bufsize -next} tres]} {
160
 
                                        eval lappend res $tres
161
 
                                }
162
 
                        }
163
 
 
164
 
                        # If we expect a failure, be more tolerant if the above
165
 
                        # fails; just make sure it's a DB_BUFFER_SMALL or an
166
 
                        # EINVAL (if the buffer is smaller than the pagesize,
167
 
                        # it's EINVAL), mark it, and move along.
168
 
                        if { $expectfail != 0 && $ret != 0 } {
169
 
                                if { [is_substr $errorCode DB_BUFFER_SMALL] != 1 && \
170
 
                                    [is_substr $errorCode EINVAL] != 1 } {
171
 
                                        error_check_good \
172
 
                                            "$flag failure errcode" \
173
 
                                            $errorCode "DB_BUFFER_SMALL or EINVAL"
174
 
                                }
175
 
                                set allpassed FALSE
176
 
                                continue
177
 
                        }
178
 
                        error_check_good "get_$flag ($key)" $ret 0
179
 
                }
180
 
 
181
 
                if { $expectfail == 1 } {
182
 
                        error_check_good allpassed $allpassed FALSE
183
 
                        puts "\t\tTest$tnum.$letter:\
184
 
                            returned at least one DB_BUFFER_SMALL (as expected)"
185
 
                } else {
186
 
                        error_check_good allpassed $allpassed TRUE
187
 
                        puts "\t\tTest$tnum.$letter: succeeded (as expected)"
188
 
                }
189
 
 
190
 
                error_check_good dbc_close [$dbc close] 0
191
 
                if { $usecursor != 0 } {
192
 
                        error_check_good getcurs_close [$getcurs close] 0
193
 
                }
194
 
        }
195
 
}
196
 
 
197
 
proc t102_populate { db method nentries txnenv pad_bytes } {
198
 
        source ./include.tcl
199
 
 
200
 
        set did [open $dict]
201
 
        set count 0
202
 
        set txn ""
203
 
        set pflags ""
204
 
        set gflags " -recno "
205
 
 
206
 
        while { [gets $did str] != -1 && $count < $nentries } {
207
 
                set key [expr $count + 1]
208
 
                set datastr $str
209
 
                # Create overflow pages only if method is not fixed-length.
210
 
                if { [is_fixed_length $method] == 0 } {
211
 
                        append datastr [repeat "a" $pad_bytes]
212
 
                }
213
 
                if { $txnenv == 1 } {
214
 
                        set t [$env txn]
215
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
216
 
                        set txn "-txn $t"
217
 
                }
218
 
                set ret [eval {$db put} \
219
 
                    $txn $pflags {$key [chop_data $method $datastr]}]
220
 
                error_check_good put $ret 0
221
 
                if { $txnenv == 1 } {
222
 
                        error_check_good txn [$t commit] 0
223
 
                }
224
 
 
225
 
                set ret [eval {$db get} $gflags {$key}]
226
 
                error_check_good $key:dbget [llength $ret] 1
227
 
                incr count
228
 
        }
229
 
        close $did
230
 
 
231
 
        # This will make debugging easier, and since the database is
232
 
        # read-only from here out, it's cheap.
233
 
        error_check_good db_sync [$db sync] 0
234
 
}
235