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

« back to all changes in this revision

Viewing changes to libdb/test/sdb003.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
* 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:
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  subdb003
9
 
# TEST  Tests many subdbs
10
 
# TEST          Creates many subdbs and puts a small amount of
11
 
# TEST          data in each (many defaults to 2000)
12
 
# TEST
13
 
# TEST  Use the first 10,000 entries from the dictionary as subdbnames.
14
 
# TEST  Insert each with entry as name of subdatabase and a partial list
15
 
# TEST  as key/data.  After all are entered, retrieve all; compare output
16
 
# TEST  to original.  Close file, reopen, do retrieve and re-verify.
17
 
proc subdb003 { method {nentries 1000} args } {
18
 
        source ./include.tcl
19
 
 
20
 
        set args [convert_args $method $args]
21
 
        set omethod [convert_method $method]
22
 
 
23
 
        if { [is_queue $method] == 1 } {
24
 
                puts "Subdb003: skipping for method $method"
25
 
                return
26
 
        }
27
 
 
28
 
        puts "Subdb003: $method ($args) many subdb tests"
29
 
 
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/subdb003.db
37
 
                set env NULL
38
 
        } else {
39
 
                set testfile subdb003.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
 
                        if { $nentries == 1000 } {
46
 
                                set nentries 100
47
 
                        }
48
 
                }
49
 
                set testdir [get_home $env]
50
 
        }
51
 
        # Create the database and open the dictionary
52
 
        set t1 $testdir/t1
53
 
        set t2 $testdir/t2
54
 
        set t3 $testdir/t3
55
 
        cleanup $testdir $env
56
 
 
57
 
        set pflags ""
58
 
        set gflags ""
59
 
        set txn ""
60
 
        set fcount 0
61
 
 
62
 
        if { [is_record_based $method] == 1 } {
63
 
                set checkfunc subdb003_recno.check
64
 
                append gflags " -recno"
65
 
        } else {
66
 
                set checkfunc subdb003.check
67
 
        }
68
 
 
69
 
        # Here is the loop where we put and get each key/data pair
70
 
        set ndataent 10
71
 
        set fdid [open $dict]
72
 
        while { [gets $fdid str] != -1 && $fcount < $nentries } {
73
 
                set subdb $str
74
 
                set db [eval {berkdb_open -create -mode 0644} \
75
 
                    $args {$omethod $testfile $subdb}]
76
 
                error_check_good dbopen [is_valid_db $db] TRUE
77
 
 
78
 
                set count 0
79
 
                set did [open $dict]
80
 
                while { [gets $did str] != -1 && $count < $ndataent } {
81
 
                        if { [is_record_based $method] == 1 } {
82
 
                                global kvals
83
 
 
84
 
                                set key [expr $count + 1]
85
 
                                set kvals($key) [pad_data $method $str]
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 $str]}]
96
 
                        error_check_good put $ret 0
97
 
                        if { $txnenv == 1 } {
98
 
                                error_check_good txn [$t commit] 0
99
 
                        }
100
 
 
101
 
                        set ret [eval {$db get} $gflags {$key}]
102
 
                        error_check_good get $ret [list [list $key \
103
 
                            [pad_data $method $str]]]
104
 
                        incr count
105
 
                }
106
 
                close $did
107
 
                incr fcount
108
 
 
109
 
                if { $txnenv == 1 } {
110
 
                        set t [$env txn]
111
 
                        error_check_good txn [is_valid_txn $t $env] TRUE
112
 
                        set txn "-txn $t"
113
 
                }
114
 
                dump_file $db $txn $t1 $checkfunc
115
 
                if { $txnenv == 1 } {
116
 
                        error_check_good txn [$t commit] 0
117
 
                }
118
 
                error_check_good db_close [$db close] 0
119
 
 
120
 
                # Now compare the keys to see if they match
121
 
                if { [is_record_based $method] == 1 } {
122
 
                        set oid [open $t2 w]
123
 
                        for {set i 1} {$i <= $ndataent} {set i [incr i]} {
124
 
                                puts $oid $i
125
 
                        }
126
 
                        close $oid
127
 
                        file rename -force $t1 $t3
128
 
                } else {
129
 
                        set q q
130
 
                        filehead $ndataent $dict $t3
131
 
                        filesort $t3 $t2
132
 
                        filesort $t1 $t3
133
 
                }
134
 
 
135
 
                error_check_good Subdb003:diff($t3,$t2) \
136
 
                    [filecmp $t3 $t2] 0
137
 
 
138
 
                # Now, reopen the file and run the last test again.
139
 
                open_and_dump_subfile $testfile $env $t1 $checkfunc \
140
 
                dump_file_direction "-first" "-next" $subdb
141
 
                if { [is_record_based $method] != 1 } {
142
 
                        filesort $t1 $t3
143
 
                }
144
 
 
145
 
                error_check_good Subdb003:diff($t2,$t3) \
146
 
                    [filecmp $t2 $t3] 0
147
 
 
148
 
                # Now, reopen the file and run the last test again in the
149
 
                # reverse direction.
150
 
                open_and_dump_subfile $testfile $env $t1 $checkfunc \
151
 
                    dump_file_direction "-last" "-prev" $subdb
152
 
 
153
 
                if { [is_record_based $method] != 1 } {
154
 
                        filesort $t1 $t3
155
 
                }
156
 
 
157
 
                error_check_good Subdb003:diff($t3,$t2) \
158
 
                    [filecmp $t3 $t2] 0
159
 
                if { [expr $fcount % 100] == 0 } {
160
 
                        puts -nonewline "$fcount "
161
 
                        flush stdout
162
 
                }
163
 
        }
164
 
        close $fdid
165
 
        puts ""
166
 
}
167
 
 
168
 
# Check function for Subdb003; keys and data are identical
169
 
proc subdb003.check { key data } {
170
 
        error_check_good "key/data mismatch" $data $key
171
 
}
172
 
 
173
 
proc subdb003_recno.check { key data } {
174
 
        global dict
175
 
        global kvals
176
 
 
177
 
        error_check_good key"$key"_exists [info exists kvals($key)] 1
178
 
        error_check_good "key/data mismatch, key $key" $data $kvals($key)
179
 
}