← Back to branch summary

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

« back to all changes in this revision

Viewing changes to db/test/test086.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/test086.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1999-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: test086.tcl,v 11.4 2001/05/17 20:37:09 bostic Exp $
 
7
 
 
8
# Test086: Cursor stability across btree splits w/ subtransaction abort [#2373].
 
9
proc test086 { method args } {
 
10
        global errorCode
 
11
        source ./include.tcl
 
12
 
 
13
        set tstn 086
 
14
 
 
15
        if { [is_btree $method] != 1 } {
 
16
                puts "Test$tstn skipping for method $method."
 
17
                return
 
18
        }
 
19
 
 
20
        set method "-btree"
 
21
 
 
22
        puts "\tTest$tstn: Test of cursor stability across aborted\
 
23
            btree splits."
 
24
 
 
25
        set key "key"
 
26
        set data "data"
 
27
        set txn ""
 
28
        set flags ""
 
29
 
 
30
        set eindex [lsearch -exact $args "-env"]
 
31
        #
 
32
        # If we are using an env, then this test won't work.
 
33
        if { $eindex == -1 } {
 
34
                # But we will be using our own env...
 
35
                set testfile test0$tstn.db
 
36
        } else {
 
37
                puts "\tTest$tstn: Environment provided;  skipping test."
 
38
                return
 
39
        }
 
40
        set t1 $testdir/t1
 
41
        env_cleanup $testdir
 
42
 
 
43
        set env [berkdb env -create -home $testdir -txn]
 
44
        error_check_good berkdb_env [is_valid_env $env] TRUE
 
45
 
 
46
        puts "\tTest$tstn.a: Create $method database."
 
47
        set oflags "-create -env $env -mode 0644 $args $method"
 
48
        set db [eval {berkdb_open} $oflags $testfile]
 
49
        error_check_good dbopen [is_valid_db $db] TRUE
 
50
 
 
51
        set nkeys 5
 
52
        # Fill page w/ small key/data pairs, keep at leaf
 
53
        #
 
54
        puts "\tTest$tstn.b: Fill page with $nkeys small key/data pairs."
 
55
        set txn [$env txn]
 
56
        error_check_good txn [is_valid_txn $txn $env] TRUE
 
57
        for { set i 0 } { $i < $nkeys } { incr i } {
 
58
                set ret [$db put -txn $txn key000$i $data$i]
 
59
                error_check_good dbput $ret 0
 
60
        }
 
61
        error_check_good commit [$txn commit] 0
 
62
 
 
63
        # get db ordering, set cursors
 
64
        puts "\tTest$tstn.c: Set cursors on each of $nkeys pairs."
 
65
        set txn [$env txn]
 
66
        error_check_good txn [is_valid_txn $txn $env] TRUE
 
67
        for {set i 0; set ret [$db get -txn $txn key000$i]} {\
 
68
                        $i < $nkeys && [llength $ret] != 0} {\
 
69
                        incr i; set ret [$db get -txn $txn key000$i]} {
 
70
                set key_set($i) [lindex [lindex $ret 0] 0]
 
71
                set data_set($i) [lindex [lindex $ret 0] 1]
 
72
                set dbc [$db cursor -txn $txn]
 
73
                set dbc_set($i) $dbc
 
74
                error_check_good db_cursor:$i [is_substr $dbc_set($i) $db] 1
 
75
                set ret [$dbc_set($i) get -set $key_set($i)]
 
76
                error_check_bad dbc_set($i)_get:set [llength $ret] 0
 
77
        }
 
78
 
 
79
        # Create child txn.
 
80
        set ctxn [$env txn -parent $txn]
 
81
        error_check_good ctxn [is_valid_txn $txn $env] TRUE
 
82
 
 
83
        # if mkeys is above 1000, need to adjust below for lexical order
 
84
        set mkeys 1000
 
85
        puts "\tTest$tstn.d: Add $mkeys pairs to force split."
 
86
        for {set i $nkeys} { $i < $mkeys } { incr i } {
 
87
                if { $i >= 100 } {
 
88
                        set ret [$db put -txn $ctxn key0$i $data$i]
 
89
                } elseif { $i >= 10 } {
 
90
                        set ret [$db put -txn $ctxn key00$i $data$i]
 
91
                } else {
 
92
                        set ret [$db put -txn $ctxn key000$i $data$i]
 
93
                }
 
94
                error_check_good dbput:more $ret 0
 
95
        }
 
96
 
 
97
        puts "\tTest$tstn.e: Abort."
 
98
        error_check_good ctxn_abort [$ctxn abort] 0
 
99
 
 
100
        puts "\tTest$tstn.f: Check and see that cursors maintained reference."
 
101
        for {set i 0} { $i < $nkeys } {incr i} {
 
102
                set ret [$dbc_set($i) get -current]
 
103
                error_check_bad dbc$i:get:current [llength $ret] 0
 
104
                set ret2 [$dbc_set($i) get -set $key_set($i)]
 
105
                error_check_bad dbc$i:get:set [llength $ret2] 0
 
106
                error_check_good dbc$i:get(match) $ret $ret2
 
107
        }
 
108
 
 
109
        # Put (and this time keep) the keys that caused the split.
 
110
        # We'll delete them to test reverse splits.
 
111
        puts "\tTest$tstn.g: Put back added keys."
 
112
        for {set i $nkeys} { $i < $mkeys } { incr i } {
 
113
                if { $i >= 100 } {
 
114
                        set ret [$db put -txn $txn key0$i $data$i]
 
115
                } elseif { $i >= 10 } {
 
116
                        set ret [$db put -txn $txn key00$i $data$i]
 
117
                } else {
 
118
                        set ret [$db put -txn $txn key000$i $data$i]
 
119
                }
 
120
                error_check_good dbput:more $ret 0
 
121
        }
 
122
 
 
123
        puts "\tTest$tstn.h: Delete added keys to force reverse split."
 
124
        set ctxn [$env txn -parent $txn]
 
125
        error_check_good ctxn [is_valid_txn $txn $env] TRUE
 
126
        for {set i $nkeys} { $i < $mkeys } { incr i } {
 
127
                if { $i >= 100 } {
 
128
                        error_check_good db_del:$i [$db del -txn $ctxn key0$i] 0
 
129
                } elseif { $i >= 10 } {
 
130
                        error_check_good db_del:$i \
 
131
                            [$db del -txn $ctxn key00$i] 0
 
132
                } else {
 
133
                        error_check_good db_del:$i \
 
134
                            [$db del -txn $ctxn key000$i] 0
 
135
                }
 
136
        }
 
137
 
 
138
        puts "\tTest$tstn.i: Abort."
 
139
        error_check_good ctxn_abort [$ctxn abort] 0
 
140
 
 
141
        puts "\tTest$tstn.j: Verify cursor reference."
 
142
        for {set i 0} { $i < $nkeys } {incr i} {
 
143
                set ret [$dbc_set($i) get -current]
 
144
                error_check_bad dbc$i:get:current [llength $ret] 0
 
145
                set ret2 [$dbc_set($i) get -set $key_set($i)]
 
146
                error_check_bad dbc$i:get:set [llength $ret2] 0
 
147
                error_check_good dbc$i:get(match) $ret $ret2
 
148
        }
 
149
 
 
150
        puts "\tTest$tstn.j: Cleanup."
 
151
        # close cursors
 
152
        for {set i 0} { $i < $nkeys } {incr i} {
 
153
                error_check_good dbc_close:$i [$dbc_set($i) close] 0
 
154
        }
 
155
 
 
156
        error_check_good commit [$txn commit] 0
 
157
        error_check_good dbclose [$db close] 0
 
158
        error_check_good envclose [$env close] 0
 
159
 
 
160
        puts "\tTest$tstn complete."
 
161
}