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

« back to all changes in this revision

Viewing changes to libdb/test/sdb011.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  subdb011
9
 
# TEST  Test deleting Subdbs with overflow pages
10
 
# TEST  Create 1 db with many large subdbs.
11
 
# TEST  Test subdatabases with overflow pages.
12
 
proc subdb011 { method {ndups 13} {nsubdbs 10} args} {
13
 
        global names
14
 
        source ./include.tcl
15
 
 
16
 
        set args [convert_args $method $args]
17
 
        set omethod [convert_method $method]
18
 
 
19
 
        if { [is_queue $method] == 1 || [is_fixed_length $method] == 1 } {
20
 
                puts "Subdb011: skipping for method $method"
21
 
                return
22
 
        }
23
 
        set txnenv 0
24
 
        set envargs ""
25
 
        set max_files 0
26
 
        set eindex [lsearch -exact $args "-env"]
27
 
        #
28
 
        # If we are using an env, then testfile should just be the db name.
29
 
        # Otherwise it is the test directory and the name.
30
 
        if { $eindex == -1 } {
31
 
                set testfile $testdir/subdb011.db
32
 
                set env NULL
33
 
                set tfpath $testfile
34
 
        } else {
35
 
                set testfile subdb011.db
36
 
                incr eindex
37
 
                set env [lindex $args $eindex]
38
 
                set envargs " -env $env "
39
 
                set txnenv [is_txnenv $env]
40
 
                if { $txnenv == 1 } {
41
 
                        append args " -auto_commit "
42
 
                        append envargs " -auto_commit "
43
 
                        set max_files 50
44
 
                        if { $ndups == 13 } {
45
 
                                set ndups 7
46
 
                        }
47
 
                }
48
 
                set testdir [get_home $env]
49
 
                set tfpath $testdir/$testfile
50
 
        }
51
 
 
52
 
        # Create the database and open the dictionary
53
 
 
54
 
        cleanup $testdir $env
55
 
        set txn ""
56
 
 
57
 
        # Here is the loop where we put and get each key/data pair
58
 
        set file_list [get_file_list]
59
 
        if { $max_files != 0 && [llength $file_list] > $max_files } {
60
 
                set fend [expr $max_files - 1]
61
 
                set file_list [lrange $file_list 0 $fend]
62
 
        }
63
 
        set flen [llength $file_list]
64
 
        puts "Subdb011: $method ($args) $ndups overflow dups with \
65
 
            $flen filename=key filecontents=data pairs"
66
 
 
67
 
        puts "\tSubdb011.a: Create each of $nsubdbs subdbs and dups"
68
 
        set slist {}
69
 
        set i 0
70
 
        set count 0
71
 
        foreach f $file_list {
72
 
                set i [expr $i % $nsubdbs]
73
 
                if { [is_record_based $method] == 1 } {
74
 
                        set key [expr $count + 1]
75
 
                        set names([expr $count + 1]) $f
76
 
                } else {
77
 
                        set key $f
78
 
                }
79
 
                # Should really catch errors
80
 
                set fid [open $f r]
81
 
                fconfigure $fid -translation binary
82
 
                set filecont [read $fid]
83
 
                set subdb subdb$i
84
 
                lappend slist $subdb
85
 
                close $fid
86
 
                set db [eval {berkdb_open -create -mode 0644} \
87
 
                    $args {$omethod $testfile $subdb}]
88
 
                error_check_good dbopen [is_valid_db $db] TRUE
89
 
                for {set dup 0} {$dup < $ndups} {incr dup} {
90
 
                        set data $dup:$filecont
91
 
                        if { $txnenv == 1 } {
92
 
                                set t [$env txn]
93
 
                                error_check_good txn [is_valid_txn $t $env] TRUE
94
 
                                set txn "-txn $t"
95
 
                        }
96
 
                        set ret [eval {$db put} $txn {$key \
97
 
                            [chop_data $method $data]}]
98
 
                        error_check_good put $ret 0
99
 
                        if { $txnenv == 1 } {
100
 
                                error_check_good txn [$t commit] 0
101
 
                        }
102
 
                }
103
 
                error_check_good dbclose [$db close] 0
104
 
                incr i
105
 
                incr count
106
 
        }
107
 
 
108
 
        puts "\tSubdb011.b: Verify overflow pages"
109
 
        foreach subdb $slist {
110
 
                set db [eval {berkdb_open -create -mode 0644} \
111
 
                    $args {$omethod $testfile $subdb}]
112
 
                error_check_good dbopen [is_valid_db $db] TRUE
113
 
                set stat [$db stat]
114
 
 
115
 
                # What everyone else calls overflow pages, hash calls "big
116
 
                # pages", so we need to special-case hash here.  (Hash
117
 
                # overflow pages are additional pages after the first in a
118
 
                # bucket.)
119
 
                if { [string compare [$db get_type] hash] == 0 } {
120
 
                        error_check_bad overflow \
121
 
                            [is_substr $stat "{{Number of big pages} 0}"] 1
122
 
                } else {
123
 
                        error_check_bad overflow \
124
 
                            [is_substr $stat "{{Overflow pages} 0}"] 1
125
 
                }
126
 
                error_check_good dbclose [$db close] 0
127
 
        }
128
 
 
129
 
        puts "\tSubdb011.c: Delete subdatabases"
130
 
        for {set i $nsubdbs} {$i > 0} {set i [expr $i - 1]} {
131
 
                #
132
 
                # Randomly delete a subdatabase
133
 
                set sindex [berkdb random_int 0 [expr $i - 1]]
134
 
                set subdb [lindex $slist $sindex]
135
 
                #
136
 
                # Delete the one we did from the list
137
 
                set slist [lreplace $slist $sindex $sindex]
138
 
                error_check_good file_exists_before [file exists $tfpath] 1
139
 
                error_check_good db_remove [eval {berkdb dbremove} $envargs \
140
 
                    {$testfile $subdb}] 0
141
 
        }
142
 
}
143