← Back to branch summary

~vlad-lesin/percona-server/mysql-5.0.33-original

« back to all changes in this revision

Viewing changes to bdb/test/test052.tcl

  • Committer: Vlad Lesin
  • Date: 2012-07-31 09:21:34 UTC
  • Revision ID: vladislav.lesin@percona.com-20120731092134-zfodx022b7992wsi
Virgin 5.0.33

Show diffs side-by-side

added added

removed removed

Lines of Context:
bdb/test/test052.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1999-2002
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: test052.tcl,v 11.16 2002/07/08 20:48:58 sandstro Exp $
 
7
#
 
8
# TEST  test052
 
9
# TEST  Renumbering record Recno test.
 
10
proc test052 { method args } {
 
11
        global alphabet
 
12
        global errorInfo
 
13
        global errorCode
 
14
        source ./include.tcl
 
15
 
 
16
        set args [convert_args $method $args]
 
17
        set omethod [convert_method $method]
 
18
 
 
19
        puts "Test052: Test of renumbering recno."
 
20
        if { [is_rrecno $method] != 1} {
 
21
                puts "Test052: skipping for method $method."
 
22
                return
 
23
        }
 
24
 
 
25
        set data "data"
 
26
        set txn ""
 
27
        set flags ""
 
28
 
 
29
        puts "\tTest052: Create $method database."
 
30
        set txnenv 0
 
31
        set eindex [lsearch -exact $args "-env"]
 
32
        #
 
33
        # If we are using an env, then testfile should just be the db name.
 
34
        # Otherwise it is the test directory and the name.
 
35
        if { $eindex == -1 } {
 
36
                set testfile $testdir/test052.db
 
37
                set env NULL
 
38
        } else {
 
39
                set testfile test052.db
 
40
                incr eindex
 
41
                set env [lindex $args $eindex]
 
42
                set txnenv [is_txnenv $env]
 
43
                if { $txnenv == 1 } {
 
44
                        append args " -auto_commit "
 
45
                }
 
46
                set testdir [get_home $env]
 
47
        }
 
48
        set t1 $testdir/t1
 
49
        cleanup $testdir $env
 
50
 
 
51
        set oflags "-create -mode 0644 $args $omethod"
 
52
        set db [eval {berkdb_open} $oflags $testfile]
 
53
        error_check_good dbopen [is_valid_db $db] TRUE
 
54
 
 
55
        # keep nkeys even
 
56
        set nkeys 20
 
57
 
 
58
        # Fill page w/ small key/data pairs
 
59
        puts "\tTest052: Fill page with $nkeys small key/data pairs."
 
60
        for { set i 1 } { $i <= $nkeys } { incr i } {
 
61
                if { $txnenv == 1 } {
 
62
                        set t [$env txn]
 
63
                        error_check_good txn [is_valid_txn $t $env] TRUE
 
64
                        set txn "-txn $t"
 
65
                }
 
66
                set ret [eval {$db put} $txn {$i $data$i}]
 
67
                error_check_good dbput $ret 0
 
68
                if { $txnenv == 1 } {
 
69
                        error_check_good txn [$t commit] 0
 
70
                }
 
71
        }
 
72
 
 
73
        # open curs to db
 
74
        if { $txnenv == 1 } {
 
75
                set t [$env txn]
 
76
                error_check_good txn [is_valid_txn $t $env] TRUE
 
77
                set txn "-txn $t"
 
78
        }
 
79
        set dbc [eval {$db cursor} $txn]
 
80
        error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
 
81
 
 
82
        # get db order of keys
 
83
        for {set i 1; set ret [$dbc get -first]} { [llength $ret] != 0} { \
 
84
            set ret [$dbc get -next]} {
 
85
                set keys($i) [lindex [lindex $ret 0] 0]
 
86
                set darray($i) [lindex [lindex $ret 0] 1]
 
87
                incr i
 
88
        }
 
89
 
 
90
        puts "\tTest052: Deletes by key."
 
91
        puts "\t  Test052.a: Get data with SET, then delete before cursor."
 
92
        # get key in middle of page, call this the nth set curr to it
 
93
        set i [expr $nkeys/2]
 
94
        set k $keys($i)
 
95
        set ret [$dbc get -set $k]
 
96
        error_check_bad dbc_get:set [llength $ret] 0
 
97
        error_check_good dbc_get:set [lindex [lindex $ret 0] 1] $darray($i)
 
98
 
 
99
        # delete by key before current
 
100
        set i [incr i -1]
 
101
        error_check_good db_del:before [eval {$db del} $txn {$keys($i)}] 0
 
102
        # with renumber, current's data should be constant, but key==--key
 
103
        set i [incr i +1]
 
104
        error_check_good dbc:data \
 
105
            [lindex [lindex [$dbc get -current] 0] 1] $darray($i)
 
106
        error_check_good dbc:keys \
 
107
            [lindex [lindex [$dbc get -current] 0] 0] $keys([expr $nkeys/2 - 1])
 
108
 
 
109
        puts "\t  Test052.b: Delete cursor item by key."
 
110
        set i [expr $nkeys/2 ]
 
111
 
 
112
        set ret [$dbc get -set $keys($i)]
 
113
        error_check_bad dbc:get [llength $ret] 0
 
114
        error_check_good dbc:get:curs [lindex [lindex $ret 0] 1] \
 
115
            $darray([expr $i + 1])
 
116
        error_check_good db_del:curr [eval {$db del} $txn {$keys($i)}] 0
 
117
        set ret [$dbc get -current]
 
118
 
 
119
        # After a delete, cursor should return DB_NOTFOUND.
 
120
        error_check_good dbc:get:key [llength [lindex [lindex $ret 0] 0]] 0
 
121
        error_check_good dbc:get:data [llength [lindex [lindex $ret 0] 1]] 0
 
122
 
 
123
        # And the item after the cursor should now be
 
124
        # key: $nkeys/2, data: $nkeys/2 + 2
 
125
        set ret [$dbc get -next]
 
126
        error_check_bad dbc:getnext [llength $ret] 0
 
127
        error_check_good dbc:getnext:data \
 
128
            [lindex [lindex $ret 0] 1] $darray([expr $i + 2])
 
129
        error_check_good dbc:getnext:keys \
 
130
            [lindex [lindex $ret 0] 0] $keys($i)
 
131
 
 
132
        puts "\t  Test052.c: Delete item after cursor."
 
133
        # should be { keys($nkeys/2), darray($nkeys/2 + 2) }
 
134
        set i [expr $nkeys/2]
 
135
        # deleting data for key after current (key $nkeys/2 + 1)
 
136
        error_check_good db_del [eval {$db del} $txn {$keys([expr $i + 1])}] 0
 
137
 
 
138
        # current should be constant
 
139
        set ret [$dbc get -current]
 
140
        error_check_bad dbc:get:current [llength $ret] 0
 
141
        error_check_good dbc:get:keys [lindex [lindex $ret 0] 0] \
 
142
            $keys($i)
 
143
        error_check_good dbc:get:data [lindex [lindex $ret 0] 1] \
 
144
            $darray([expr $i + 2])
 
145
 
 
146
        puts "\tTest052: Deletes by cursor."
 
147
        puts "\t  Test052.d: Delete, do DB_NEXT."
 
148
        set i 1
 
149
        set ret [$dbc get -first]
 
150
        error_check_bad dbc_get:first [llength $ret] 0
 
151
        error_check_good dbc_get:first [lindex [lindex $ret 0] 1] $darray($i)
 
152
        error_check_good dbc_del [$dbc del] 0
 
153
        set ret [$dbc get -current]
 
154
        error_check_bad dbc_get:current [llength $ret] 0
 
155
        error_check_good dbc:getcurrent:key \
 
156
            [llength [lindex [lindex $ret 0] 0]] 0
 
157
        error_check_good dbc:getcurrent:data \
 
158
            [llength [lindex [lindex $ret 0] 1]] 0
 
159
 
 
160
        set ret [$dbc get -next]
 
161
        error_check_bad dbc_get:next [llength $ret] 0
 
162
        error_check_good dbc:get:curs \
 
163
            [lindex [lindex $ret 0] 1] $darray([expr $i + 1])
 
164
        error_check_good dbc:get:keys \
 
165
            [lindex [lindex $ret 0] 0] $keys($i)
 
166
 
 
167
        # Move one more forward, so we're not on the first item.
 
168
        error_check_bad dbc:getnext [llength [$dbc get -next]] 0
 
169
 
 
170
        puts "\t  Test052.e: Delete, do DB_PREV."
 
171
        error_check_good dbc:del [$dbc del] 0
 
172
        set ret [$dbc get -current]
 
173
        error_check_bad dbc:get:curr [llength $ret] 0
 
174
        error_check_good dbc:getcurrent:key \
 
175
            [llength [lindex [lindex $ret 0] 0]] 0
 
176
        error_check_good dbc:getcurrent:data \
 
177
            [llength [lindex [lindex $ret 0] 1]] 0
 
178
 
 
179
        # next should now reference the record that was previously after
 
180
        # old current
 
181
        set ret [$dbc get -next]
 
182
        error_check_bad get:next [llength $ret] 0
 
183
        error_check_good dbc:get:next:data \
 
184
            [lindex [lindex $ret 0] 1] $darray([expr $i + 3])
 
185
        error_check_good dbc:get:next:keys \
 
186
            [lindex [lindex $ret 0] 0] $keys([expr $i + 1])
 
187
 
 
188
        set ret [$dbc get -prev]
 
189
        error_check_bad dbc:get:curr [llength $ret] 0
 
190
        error_check_good dbc:get:curr:compare \
 
191
            [lindex [lindex $ret 0] 1] $darray([expr $i + 1])
 
192
        error_check_good dbc:get:curr:keys \
 
193
            [lindex [lindex $ret 0] 0] $keys($i)
 
194
 
 
195
        # The rest of the test was written with the old rrecno semantics,
 
196
        # which required a separate c_del(CURRENT) test;  to leave
 
197
        # the database in the expected state, we now delete the first item.
 
198
        set ret [$dbc get -first]
 
199
        error_check_bad getfirst [llength $ret] 0
 
200
        error_check_good delfirst [$dbc del] 0
 
201
 
 
202
        puts "\tTest052: Inserts."
 
203
        puts "\t  Test052.g: Insert before (DB_BEFORE)."
 
204
        set i 1
 
205
        set ret [$dbc get -first]
 
206
        error_check_bad dbc:get:first [llength $ret] 0
 
207
        error_check_good dbc_get:first \
 
208
            [lindex [lindex $ret 0] 0] $keys($i)
 
209
        error_check_good dbc_get:first:data \
 
210
            [lindex [lindex $ret 0] 1] $darray([expr $i + 3])
 
211
 
 
212
        set ret [$dbc put -before $darray($i)]
 
213
        # should return new key, which should be $keys($i)
 
214
        error_check_good dbc_put:before $ret $keys($i)
 
215
        # cursor should adjust to point to new item
 
216
        set ret [$dbc get -current]
 
217
        error_check_bad dbc_get:curr [llength $ret] 0
 
218
        error_check_good dbc_put:before:keys \
 
219
            [lindex [lindex $ret 0] 0] $keys($i)
 
220
        error_check_good dbc_put:before:data \
 
221
            [lindex [lindex $ret 0] 1] $darray($i)
 
222
 
 
223
        set ret [$dbc get -next]
 
224
        error_check_bad dbc_get:next [llength $ret] 0
 
225
        error_check_good dbc_get:next:compare \
 
226
           $ret [list [list $keys([expr $i + 1]) $darray([expr $i + 3])]]
 
227
        set ret [$dbc get -prev]
 
228
        error_check_bad dbc_get:prev [llength $ret] 0
 
229
 
 
230
        puts "\t  Test052.h: Insert by cursor after (DB_AFTER)."
 
231
        set i [incr i]
 
232
        set ret [$dbc put -after $darray($i)]
 
233
        # should return new key, which should be $keys($i)
 
234
        error_check_good dbcput:after $ret $keys($i)
 
235
        # cursor should reference new item
 
236
        set ret [$dbc get -current]
 
237
        error_check_good dbc:get:current:keys \
 
238
            [lindex [lindex $ret 0] 0] $keys($i)
 
239
        error_check_good dbc:get:current:data \
 
240
            [lindex [lindex $ret 0] 1] $darray($i)
 
241
 
 
242
        # items after curs should be adjusted
 
243
        set ret [$dbc get -next]
 
244
        error_check_bad dbc:get:next [llength $ret] 0
 
245
        error_check_good dbc:get:next:compare \
 
246
            $ret [list [list $keys([expr $i + 1]) $darray([expr $i + 2])]]
 
247
 
 
248
        puts "\t  Test052.i: Insert (overwrite) current item (DB_CURRENT)."
 
249
        set i 1
 
250
        set ret [$dbc get -first]
 
251
        error_check_bad dbc_get:first [llength $ret] 0
 
252
        # choose a datum that is not currently in db
 
253
        set ret [$dbc put -current $darray([expr $i + 2])]
 
254
        error_check_good dbc_put:curr $ret 0
 
255
        # curs should be on new item
 
256
        set ret [$dbc get -current]
 
257
        error_check_bad dbc_get:current [llength $ret] 0
 
258
        error_check_good dbc_get:curr:keys \
 
259
            [lindex [lindex $ret 0] 0] $keys($i)
 
260
        error_check_good dbc_get:curr:data \
 
261
            [lindex [lindex $ret 0] 1] $darray([expr $i + 2])
 
262
 
 
263
        set ret [$dbc get -next]
 
264
        error_check_bad dbc_get:next [llength $ret] 0
 
265
        set i [incr i]
 
266
        error_check_good dbc_get:next \
 
267
            $ret [list [list $keys($i) $darray($i)]]
 
268
 
 
269
        error_check_good dbc_close [$dbc close] 0
 
270
        if { $txnenv == 1 } {
 
271
                error_check_good txn [$t commit] 0
 
272
        }
 
273
        error_check_good db_close [$db close] 0
 
274
 
 
275
        puts "\tTest052 complete."
 
276
}