← Back to branch summary

~ubuntu-branches/ubuntu/maverick/evolution-data-server/maverick-proposed

« back to all changes in this revision

Viewing changes to libdb/test/test016.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Didier Roche
  • Date: 2010-05-17 17:02:06 UTC
  • mfrom: (1.1.79 upstream) (1.6.12 experimental)
  • Revision ID: james.westby@ubuntu.com-20100517170206-4ufr52vwrhh26yh0
Tags: 2.30.1-1ubuntu1
https://launchpad.net/bugs/42199
https://launchpad.net/bugs/229669
https://launchpad.net/bugs/173703
https://launchpad.net/bugs/360344
https://launchpad.net/bugs/508494
* Merge from debian experimental. Remaining change:
  (LP: #42199, #229669, #173703, #360344, #508494)
  + debian/control:
    - add Vcs-Bzr tag
    - don't use libgnome
    - Use Breaks instead of Conflicts against evolution 2.25 and earlier.
  + debian/evolution-data-server.install,
    debian/patches/45_libcamel_providers_version.patch:
    - use the upstream versioning, not a Debian-specific one 
  + debian/libedata-book1.2-dev.install, debian/libebackend-1.2-dev.install,
    debian/libcamel1.2-dev.install, debian/libedataserverui1.2-dev.install:
    - install html documentation
  + debian/rules:
    - don't build documentation it's shipped with the tarball

Show diffs side-by-side

added added

removed removed

Lines of Context:
libdb/test/test016.tcl
1
 
# See the file LICENSE for redistribution information.
2
 
#
3
 
# Copyright (c) 1996-2002
4
 
#       Sleepycat Software.  All rights reserved.
5
 
#
6
 
# $Id$
7
 
#
8
 
# TEST  test016
9
 
# TEST  Partial put test
10
 
# TEST  Partial put where the datum gets shorter as a result of the put.
11
 
# TEST
12
 
# TEST  Partial put test where partial puts make the record smaller.
13
 
# TEST  Use the first 10,000 entries from the dictionary.
14
 
# TEST  Insert each with self as key and a fixed, medium length data string;
15
 
# TEST  retrieve each. After all are entered, go back and do partial puts,
16
 
# TEST  replacing a random-length string with the key value.
17
 
# TEST  Then verify.
18
 
 
19
 
proc test016 { method {nentries 10000} args } {
20
 
        global datastr
21
 
        global dvals
22
 
        global rand_init
23
 
        source ./include.tcl
24
 
 
25
 
        berkdb srand $rand_init
26
 
 
27
 
        set args [convert_args $method $args]
28
 
        set omethod [convert_method $method]
29
 
 
30
 
        if { [is_fixed_length $method] == 1 } {
31
 
                puts "Test016: skipping for method $method"
32
 
                return
33
 
        }
34
 
 
35
 
        # Create the database and open the dictionary
36
 
        set txnenv 0
37
 
        set eindex [lsearch -exact $args "-env"]
38
 
        #
39
 
        # If we are using an env, then testfile should just be the db name.
40
 
        # Otherwise it is the test directory and the name.
41
 
        if { $eindex == -1 } {
42
 
                set testfile $testdir/test016.db
43
 
                set env NULL
44
 
        } else {
45
 
                set testfile test016.db
46
 
                incr eindex
47
 
                set env [lindex $args $eindex]
48
 
                set txnenv [is_txnenv $env]
49
 
                if { $txnenv == 1 } {
50
 
                        append args " -auto_commit "
51
 
                        #
52
 
                        # If we are using txns and running with the
53
 
                        # default, set the default down a bit.
54
 
                        #
55
 
                        if { $nentries == 10000 } {
56
 
                                set nentries 100
57
 
                        }
58
 
                }
59
 
                set testdir [get_home $env]
60
 
        }
61
 
        puts "Test016: $method ($args) $nentries partial put shorten"
62
 
 
63
 
        set t1 $testdir/t1
64
 
        set t2 $testdir/t2
65
 
        set t3 $testdir/t3
66
 
        cleanup $testdir $env
67
 
        set db [eval {berkdb_open \
68
 
             -create -mode 0644} $args {$omethod $testfile}]
69
 
        error_check_good dbopen [is_valid_db $db] TRUE
70
 
 
71
 
        set pflags ""
72
 
        set gflags ""
73
 
        set txn ""
74
 
        set count 0
75
 
 
76
 
        if { [is_record_based $method] == 1 } {
77
 
                append gflags " -recno"
78
 
        }
79
 
 
80
 
        # Here is the loop where we put and get each key/data pair
81
 
        puts "\tTest016.a: put/get loop"
82
 
        set did [open $dict]
83
 
        while { [gets $did str] != -1 && $count < $nentries } {
84
 
                if { [is_record_based $method] == 1 } {
85
 
                        set key [expr $count + 1]
86
 
                } else {
87
 
                        set key $str
88
 
                }
89
 
                if { $txnenv == 1 } {
90
 
                        set t [$env txn]
91
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
92
 
                        set txn "-txn $t"
93
 
                }
94
 
                set ret [eval {$db put} \
95
 
                    $txn $pflags {$key [chop_data $method $datastr]}]
96
 
                error_check_good put $ret 0
97
 
 
98
 
                set ret [eval {$db get} $txn $gflags {$key}]
99
 
                error_check_good \
100
 
                    get $ret [list [list $key [pad_data $method $datastr]]]
101
 
                if { $txnenv == 1 } {
102
 
                        error_check_good txn [$t commit] 0
103
 
                }
104
 
                incr count
105
 
        }
106
 
        close $did
107
 
 
108
 
        # Next we will do a partial put replacement, making the data
109
 
        # shorter
110
 
        puts "\tTest016.b: partial put loop"
111
 
        set did [open $dict]
112
 
        set count 0
113
 
        set len [string length $datastr]
114
 
        while { [gets $did str] != -1 && $count < $nentries } {
115
 
                if { [is_record_based $method] == 1 } {
116
 
                        set key [expr $count + 1]
117
 
                } else {
118
 
                        set key $str
119
 
                }
120
 
 
121
 
                set repl_len [berkdb random_int [string length $key] $len]
122
 
                set repl_off [berkdb random_int 0 [expr $len - $repl_len] ]
123
 
                set s1 [string range $datastr 0 [ expr $repl_off - 1] ]
124
 
                set s2 [string toupper $key]
125
 
                set s3 [string range $datastr [expr $repl_off + $repl_len] end ]
126
 
                set dvals($key) [pad_data $method $s1$s2$s3]
127
 
                if { $txnenv == 1 } {
128
 
                        set t [$env txn]
129
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
130
 
                        set txn "-txn $t"
131
 
                }
132
 
                set ret [eval {$db put} $txn {-partial \
133
 
                    [list $repl_off $repl_len] $key [chop_data $method $s2]}]
134
 
                error_check_good put $ret 0
135
 
                set ret [eval {$db get} $txn $gflags {$key}]
136
 
                error_check_good \
137
 
                    put $ret [list [list $key [pad_data $method $s1$s2$s3]]]
138
 
                if { $txnenv == 1 } {
139
 
                        error_check_good txn [$t commit] 0
140
 
                }
141
 
                incr count
142
 
        }
143
 
        close $did
144
 
 
145
 
        # Now we will get each key from the DB and compare the results
146
 
        # to the original.
147
 
        puts "\tTest016.c: dump file"
148
 
        if { $txnenv == 1 } {
149
 
                set t [$env txn]
150
 
                error_check_good txn [is_valid_txn $t $env] TRUE
151
 
                set txn "-txn $t"
152
 
        }
153
 
        dump_file $db $txn $t1 test016.check
154
 
        if { $txnenv == 1 } {
155
 
                error_check_good txn [$t commit] 0
156
 
        }
157
 
        error_check_good db_close [$db close] 0
158
 
 
159
 
        # Now compare the keys to see if they match the dictionary
160
 
        if { [is_record_based $method] == 1 } {
161
 
                set oid [open $t2 w]
162
 
                for {set i 1} {$i <= $nentries} {set i [incr i]} {
163
 
                        puts $oid $i
164
 
                }
165
 
                close $oid
166
 
                file rename -force $t1 $t3
167
 
        } else {
168
 
                set q q
169
 
                filehead $nentries $dict $t3
170
 
                filesort $t3 $t2
171
 
                filesort $t1 $t3
172
 
        }
173
 
 
174
 
        error_check_good Test016:diff($t3,$t2) \
175
 
            [filecmp $t3 $t2] 0
176
 
 
177
 
        # Now, reopen the file and run the last test again.
178
 
        puts "\tTest016.d: close, open, and dump file"
179
 
        open_and_dump_file $testfile $env $t1 test016.check \
180
 
            dump_file_direction "-first" "-next"
181
 
 
182
 
        if { [ is_record_based $method ] == 0 } {
183
 
                filesort $t1 $t3
184
 
        }
185
 
        error_check_good Test016:diff($t3,$t2) \
186
 
            [filecmp $t3 $t2] 0
187
 
 
188
 
        # Now, reopen the file and run the last test again in reverse direction.
189
 
        puts "\tTest016.e: close, open, and dump file in reverse direction"
190
 
        open_and_dump_file $testfile $env $t1 test016.check \
191
 
            dump_file_direction "-last" "-prev"
192
 
 
193
 
        if { [ is_record_based $method ] == 0 } {
194
 
                filesort $t1 $t3
195
 
        }
196
 
        error_check_good Test016:diff($t3,$t2) \
197
 
            [filecmp $t3 $t2] 0
198
 
}
199
 
 
200
 
# Check function for test016; data should be whatever is set in dvals
201
 
proc test016.check { key data } {
202
 
        global datastr
203
 
        global dvals
204
 
 
205
 
        error_check_good key"$key"_exists [info exists dvals($key)] 1
206
 
        error_check_good "data mismatch for key $key" $data $dvals($key)
207
 
}