← Back to branch summary

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

« back to all changes in this revision

Viewing changes to db/test/test043.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/test043.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1996-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: test043.tcl,v 11.13 2001/01/25 18:23:10 bostic Exp $
 
7
#
 
8
# DB Test 43 {method nentries}
 
9
# Test the Record number implicit creation and renumbering options.
 
10
proc test043 { method {nentries 10000} args} {
 
11
        source ./include.tcl
 
12
 
 
13
        set do_renumber [is_rrecno $method]
 
14
        set args [convert_args $method $args]
 
15
        set omethod [convert_method $method]
 
16
 
 
17
        puts "Test043: $method ($args)"
 
18
 
 
19
        if { [is_record_based $method] != 1 } {
 
20
                puts "Test043 skipping for method $method"
 
21
                return
 
22
        }
 
23
 
 
24
        # Create the database and open the dictionary
 
25
        set eindex [lsearch -exact $args "-env"]
 
26
        #
 
27
        # If we are using an env, then testfile should just be the db name.
 
28
        # Otherwise it is the test directory and the name.
 
29
        if { $eindex == -1 } {
 
30
                set testfile $testdir/test043.db
 
31
                set env NULL
 
32
        } else {
 
33
                set testfile test043.db
 
34
                incr eindex
 
35
                set env [lindex $args $eindex]
 
36
        }
 
37
        cleanup $testdir $env
 
38
 
 
39
        # Create the database
 
40
        set db [eval {berkdb_open -create -truncate -mode 0644} $args \
 
41
                {$omethod $testfile}]
 
42
        error_check_good dbopen [is_valid_db $db] TRUE
 
43
 
 
44
        set pflags ""
 
45
        set gflags " -recno"
 
46
        set txn ""
 
47
 
 
48
        # First test implicit creation and retrieval
 
49
        set count 1
 
50
        set interval 5
 
51
        if { $nentries < $interval } {
 
52
                set nentries [expr $interval + 1]
 
53
        }
 
54
        puts "\tTest043.a: insert keys at $interval record intervals"
 
55
        while { $count <= $nentries } {
 
56
                set ret [eval {$db put} \
 
57
                    $txn $pflags {$count [chop_data $method $count]}]
 
58
                error_check_good "$db put $count" $ret 0
 
59
                set last $count
 
60
                incr count $interval
 
61
        }
 
62
 
 
63
        puts "\tTest043.b: get keys using DB_FIRST/DB_NEXT"
 
64
        set dbc [eval {$db cursor} $txn]
 
65
        error_check_good "$db cursor" [is_substr $dbc $db] 1
 
66
 
 
67
        set check 1
 
68
        for { set rec [$dbc get -first] } { [llength $rec] != 0 } {
 
69
            set rec [$dbc get -next] } {
 
70
                set k [lindex [lindex $rec 0] 0]
 
71
                set d [pad_data $method [lindex [lindex $rec 0] 1]]
 
72
                error_check_good "$dbc get key==data" [pad_data $method $k] $d
 
73
                error_check_good "$dbc get sequential" $k $check
 
74
                if { $k > $nentries } {
 
75
                        error_check_good "$dbc get key too large" $k $nentries
 
76
                }
 
77
                incr check $interval
 
78
        }
 
79
 
 
80
        # Now make sure that we get DB_KEYEMPTY for non-existent keys
 
81
        puts "\tTest043.c: Retrieve non-existent keys"
 
82
        global errorInfo
 
83
 
 
84
        set check 1
 
85
        for { set rec [$dbc get -first] } { [llength $rec] != 0 } {
 
86
                set rec [$dbc get -next] } {
 
87
                set k [lindex [lindex $rec 0] 0]
 
88
 
 
89
                set ret [eval {$db get} $txn $gflags {[expr $k + 1]}]
 
90
                error_check_good "$db \
 
91
                    get [expr $k + 1]" $ret [list]
 
92
 
 
93
                incr check $interval
 
94
                # Make sure we don't do a retrieve past the end of file
 
95
                if { $check >= $last }  {
 
96
                        break
 
97
                }
 
98
        }
 
99
 
 
100
        # Now try deleting and make sure the right thing happens.
 
101
        puts "\tTest043.d: Delete tests"
 
102
        set rec [$dbc get -first]
 
103
        error_check_bad "$dbc get -first" [llength $rec] 0
 
104
        error_check_good  "$dbc get -first key" [lindex [lindex $rec 0] 0] 1
 
105
        error_check_good  "$dbc get -first data" \
 
106
            [lindex [lindex $rec 0] 1] [pad_data $method 1]
 
107
 
 
108
        # Delete the first item
 
109
        error_check_good "$dbc del" [$dbc del] 0
 
110
 
 
111
        # Retrieving 1 should always fail
 
112
        set ret [eval {$db get} $txn $gflags {1}]
 
113
        error_check_good "$db get 1" $ret [list]
 
114
 
 
115
        # Now, retrieving other keys should work; keys will vary depending
 
116
        # upon renumbering.
 
117
        if { $do_renumber == 1 } {
 
118
                set count [expr 0 + $interval]
 
119
                set max [expr $nentries - 1]
 
120
        } else {
 
121
                set count [expr 1 + $interval]
 
122
                set max $nentries
 
123
        }
 
124
 
 
125
        while { $count <= $max } {
 
126
        set rec [eval {$db get} $txn $gflags {$count}]
 
127
                if { $do_renumber == 1 } {
 
128
                        set data [expr $count + 1]
 
129
                } else {
 
130
                        set data $count
 
131
                }
 
132
                error_check_good "$db get $count" \
 
133
                    [pad_data $method $data] [lindex [lindex $rec 0] 1]
 
134
                incr count $interval
 
135
        }
 
136
        set max [expr $count - $interval]
 
137
 
 
138
        puts "\tTest043.e: Verify LAST/PREV functionality"
 
139
        set count $max
 
140
        for { set rec [$dbc get -last] } { [llength $rec] != 0 } {
 
141
            set rec [$dbc get -prev] } {
 
142
                set k [lindex [lindex $rec 0] 0]
 
143
                set d [lindex [lindex $rec 0] 1]
 
144
                if { $do_renumber == 1 } {
 
145
                        set data [expr $k + 1]
 
146
                } else {
 
147
                        set data $k
 
148
                }
 
149
                error_check_good \
 
150
                    "$dbc get key==data" [pad_data $method $data] $d
 
151
                error_check_good "$dbc get sequential" $k $count
 
152
                if { $k > $nentries } {
 
153
                        error_check_good "$dbc get key too large" $k $nentries
 
154
                }
 
155
                set count [expr $count - $interval]
 
156
                if { $count < 1 } {
 
157
                        break
 
158
                }
 
159
        }
 
160
        error_check_good dbc_close [$dbc close] 0
 
161
        error_check_good db_close [$db close] 0
 
162
}