← 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/sdb004.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/sdb004.tcl
1
 
# See the file LICENSE for redistribution information.
2
 
#
3
 
# Copyright (c) 1999-2002
4
 
#       Sleepycat Software.  All rights reserved.
5
 
#
6
 
# $Id$
7
 
#
8
 
# TEST  subdb004
9
 
# TEST  Tests large subdb names
10
 
# TEST          subdb name = filecontents,
11
 
# TEST          key = filename, data = filecontents
12
 
# TEST                  Put/get per key
13
 
# TEST                  Dump file
14
 
# TEST                  Dump subdbs, verify data and subdb name match
15
 
# TEST
16
 
# TEST  Create 1 db with many large subdbs.  Use the contents as subdb names.
17
 
# TEST  Take the source files and dbtest executable and enter their names as
18
 
# TEST  the key with their contents as data.  After all are entered, retrieve
19
 
# TEST  all; compare output to original. Close file, reopen, do retrieve and
20
 
# TEST  re-verify.
21
 
proc subdb004 { method args} {
22
 
        global names
23
 
        source ./include.tcl
24
 
 
25
 
        set args [convert_args $method $args]
26
 
        set omethod [convert_method $method]
27
 
 
28
 
        if { [is_queue $method] == 1 || [is_fixed_length $method] == 1 } {
29
 
                puts "Subdb004: skipping for method $method"
30
 
                return
31
 
        }
32
 
 
33
 
        puts "Subdb004: $method ($args) \
34
 
            filecontents=subdbname filename=key filecontents=data pairs"
35
 
 
36
 
        set txnenv 0
37
 
        set envargs ""
38
 
        set eindex [lsearch -exact $args "-env"]
39
 
        #
40
 
        # If we are using an env, then testfile should just be the db name.
41
 
        # Otherwise it is the test directory and the name.
42
 
        if { $eindex == -1 } {
43
 
                set testfile $testdir/subdb004.db
44
 
                set env NULL
45
 
        } else {
46
 
                set testfile subdb004.db
47
 
                incr eindex
48
 
                set env [lindex $args $eindex]
49
 
                set envargs " -env $env "
50
 
                set txnenv [is_txnenv $env]
51
 
                if { $txnenv == 1 } {
52
 
                        append args " -auto_commit "
53
 
                        append envargs " -auto_commit "
54
 
                }
55
 
                set testdir [get_home $env]
56
 
        }
57
 
        # Create the database and open the dictionary
58
 
        set t1 $testdir/t1
59
 
        set t2 $testdir/t2
60
 
        set t3 $testdir/t3
61
 
        set t4 $testdir/t4
62
 
 
63
 
        cleanup $testdir $env
64
 
        set pflags ""
65
 
        set gflags ""
66
 
        set txn ""
67
 
        if { [is_record_based $method] == 1 } {
68
 
                set checkfunc subdb004_recno.check
69
 
                append gflags "-recno"
70
 
        } else {
71
 
                set checkfunc subdb004.check
72
 
        }
73
 
 
74
 
        # Here is the loop where we put and get each key/data pair
75
 
        # Note that the subdatabase name is passed in as a char *, not
76
 
        # in a DBT, so it may not contain nulls;  use only source files.
77
 
        set file_list [glob $src_root/*/*.c]
78
 
        set fcount [llength $file_list]
79
 
        if { $txnenv == 1 && $fcount > 100 } {
80
 
                set file_list [lrange $file_list 0 99]
81
 
                set fcount 100
82
 
        }
83
 
 
84
 
        set count 0
85
 
        if { [is_record_based $method] == 1 } {
86
 
                set oid [open $t2 w]
87
 
                for {set i 1} {$i <= $fcount} {set i [incr i]} {
88
 
                        puts $oid $i
89
 
                }
90
 
                close $oid
91
 
        } else {
92
 
                set oid [open $t2.tmp w]
93
 
                foreach f $file_list {
94
 
                        puts $oid $f
95
 
                }
96
 
                close $oid
97
 
                filesort $t2.tmp $t2
98
 
        }
99
 
        puts "\tSubdb004.a: Set/Check each subdb"
100
 
        foreach f $file_list {
101
 
                if { [is_record_based $method] == 1 } {
102
 
                        set key [expr $count + 1]
103
 
                        set names([expr $count + 1]) $f
104
 
                } else {
105
 
                        set key $f
106
 
                }
107
 
                # Should really catch errors
108
 
                set fid [open $f r]
109
 
                fconfigure $fid -translation binary
110
 
                set data [read $fid]
111
 
                set subdb $data
112
 
                close $fid
113
 
                set db [eval {berkdb_open -create -mode 0644} \
114
 
                    $args {$omethod $testfile $subdb}]
115
 
                error_check_good dbopen [is_valid_db $db] TRUE
116
 
                if { $txnenv == 1 } {
117
 
                        set t [$env txn]
118
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
119
 
                        set txn "-txn $t"
120
 
                }
121
 
                set ret [eval \
122
 
                    {$db put} $txn $pflags {$key [chop_data $method $data]}]
123
 
                error_check_good put $ret 0
124
 
                if { $txnenv == 1 } {
125
 
                        error_check_good txn [$t commit] 0
126
 
                }
127
 
 
128
 
                # Should really catch errors
129
 
                set fid [open $t4 w]
130
 
                fconfigure $fid -translation binary
131
 
                if [catch {eval {$db get} $gflags {$key}} data] {
132
 
                        puts -nonewline $fid $data
133
 
                } else {
134
 
                        # Data looks like {{key data}}
135
 
                        set key [lindex [lindex $data 0] 0]
136
 
                        set data [lindex [lindex $data 0] 1]
137
 
                        puts -nonewline $fid $data
138
 
                }
139
 
                close $fid
140
 
 
141
 
                error_check_good Subdb004:diff($f,$t4) \
142
 
                    [filecmp $f $t4] 0
143
 
 
144
 
                incr count
145
 
 
146
 
                # Now we will get each key from the DB and compare the results
147
 
                # to the original.
148
 
                # puts "\tSubdb004.b: dump file"
149
 
                if { $txnenv == 1 } {
150
 
                        set t [$env txn]
151
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
152
 
                        set txn "-txn $t"
153
 
                }
154
 
                dump_bin_file $db $txn $t1 $checkfunc
155
 
                if { $txnenv == 1 } {
156
 
                        error_check_good txn [$t commit] 0
157
 
                }
158
 
                error_check_good db_close [$db close] 0
159
 
 
160
 
        }
161
 
 
162
 
        #
163
 
        # Now for each file, check that the subdb name is the same
164
 
        # as the data in that subdb and that the filename is the key.
165
 
        #
166
 
        puts "\tSubdb004.b: Compare subdb names with key/data"
167
 
        set db [eval {berkdb_open -rdonly} $envargs {$testfile}]
168
 
        error_check_good dbopen [is_valid_db $db] TRUE
169
 
        if { $txnenv == 1 } {
170
 
                set t [$env txn]
171
 
                error_check_good txn [is_valid_txn $t $env] TRUE
172
 
                set txn "-txn $t"
173
 
        }
174
 
        set c [eval {$db cursor} $txn]
175
 
        error_check_good db_cursor [is_valid_cursor $c $db] TRUE
176
 
 
177
 
        for {set d [$c get -first] } { [llength $d] != 0 } \
178
 
            {set d [$c get -next] } {
179
 
                set subdbname [lindex [lindex $d 0] 0]
180
 
                set subdb [eval {berkdb_open} $args {$testfile $subdbname}]
181
 
                error_check_good dbopen [is_valid_db $db] TRUE
182
 
 
183
 
                # Output the subdb name
184
 
                set ofid [open $t3 w]
185
 
                fconfigure $ofid -translation binary
186
 
                if { [string compare "\0" \
187
 
                    [string range $subdbname end end]] == 0 } {
188
 
                        set slen [expr [string length $subdbname] - 2]
189
 
                        set subdbname [string range $subdbname 1 $slen]
190
 
                }
191
 
                puts -nonewline $ofid $subdbname
192
 
                close $ofid
193
 
 
194
 
                # Output the data
195
 
                set subc [eval {$subdb cursor} $txn]
196
 
                error_check_good db_cursor [is_valid_cursor $subc $subdb] TRUE
197
 
                set d [$subc get -first]
198
 
                error_check_good dbc_get [expr [llength $d] != 0] 1
199
 
                set key [lindex [lindex $d 0] 0]
200
 
                set data [lindex [lindex $d 0] 1]
201
 
 
202
 
                set ofid [open $t1 w]
203
 
                fconfigure $ofid -translation binary
204
 
                puts -nonewline $ofid $data
205
 
                close $ofid
206
 
 
207
 
                $checkfunc $key $t1
208
 
                $checkfunc $key $t3
209
 
 
210
 
                error_check_good Subdb004:diff($t3,$t1) \
211
 
                    [filecmp $t3 $t1] 0
212
 
                error_check_good curs_close [$subc close] 0
213
 
                error_check_good db_close [$subdb close] 0
214
 
        }
215
 
        error_check_good curs_close [$c close] 0
216
 
        if { $txnenv == 1 } {
217
 
                error_check_good txn [$t commit] 0
218
 
        }
219
 
        error_check_good db_close [$db close] 0
220
 
 
221
 
        if { [is_record_based $method] != 1 } {
222
 
                fileremove $t2.tmp
223
 
        }
224
 
}
225
 
 
226
 
# Check function for subdb004; key should be file name; data should be contents
227
 
proc subdb004.check { binfile tmpfile } {
228
 
        source ./include.tcl
229
 
 
230
 
        error_check_good Subdb004:datamismatch($binfile,$tmpfile) \
231
 
            [filecmp $binfile $tmpfile] 0
232
 
}
233
 
proc subdb004_recno.check { binfile tmpfile } {
234
 
        global names
235
 
        source ./include.tcl
236
 
 
237
 
        set fname $names($binfile)
238
 
        error_check_good key"$binfile"_exists [info exists names($binfile)] 1
239
 
        error_check_good Subdb004:datamismatch($fname,$tmpfile) \
240
 
            [filecmp $fname $tmpfile] 0
241
 
}