← Back to branch summary

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

« back to all changes in this revision

Viewing changes to db/test/test036.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/test036.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1996-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: test036.tcl,v 11.14 2001/01/25 18:23:10 bostic Exp $
 
7
#
 
8
# DB Test 36 {access method}
 
9
# Put nentries key/data pairs (from the dictionary) using a cursor
 
10
# and KEYFIRST and KEYLAST (this tests the case where use use cursor
 
11
# put for non-existent keys).
 
12
proc test036 { method {nentries 10000} args } {
 
13
        source ./include.tcl
 
14
 
 
15
        set args [convert_args $method $args]
 
16
        set omethod [convert_method $method]
 
17
 
 
18
        puts "Test036: $method ($args) $nentries equal key/data pairs"
 
19
        if { [is_record_based $method] == 1 } {
 
20
                puts "Test036 skipping for method recno"
 
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/test036.db
 
31
                set env NULL
 
32
        } else {
 
33
                set testfile test036.db
 
34
                incr eindex
 
35
                set env [lindex $args $eindex]
 
36
        }
 
37
        set t1 $testdir/t1
 
38
        set t2 $testdir/t2
 
39
        set t3 $testdir/t3
 
40
        cleanup $testdir $env
 
41
        set db [eval {berkdb_open \
 
42
             -create -truncate -mode 0644} $args {$omethod $testfile}]
 
43
        error_check_good dbopen [is_valid_db $db] TRUE
 
44
        set did [open $dict]
 
45
 
 
46
        set pflags ""
 
47
        set gflags ""
 
48
        set txn ""
 
49
        set count 0
 
50
 
 
51
        if { [is_record_based $method] == 1 } {
 
52
                set checkfunc test036_recno.check
 
53
                append gflags " -recno"
 
54
        } else {
 
55
                set checkfunc test036.check
 
56
        }
 
57
        puts "\tTest036.a: put/get loop KEYFIRST"
 
58
        # Here is the loop where we put and get each key/data pair
 
59
        set dbc [eval {$db cursor} $txn]
 
60
        error_check_good cursor [is_substr $dbc $db] 1
 
61
        while { [gets $did str] != -1 && $count < $nentries } {
 
62
                if { [is_record_based $method] == 1 } {
 
63
                        global kvals
 
64
 
 
65
                        set key [expr $count + 1]
 
66
                        set kvals($key) $str
 
67
                } else {
 
68
                        set key $str
 
69
                }
 
70
                set ret [eval {$dbc put} $txn $pflags {-keyfirst $key $str}]
 
71
                error_check_good put $ret 0
 
72
 
 
73
                set ret [eval {$db get} $txn $gflags {$key}]
 
74
                error_check_good get [lindex [lindex $ret 0] 1] $str
 
75
                incr count
 
76
        }
 
77
        error_check_good dbc_close [$dbc close] 0
 
78
 
 
79
        puts "\tTest036.a: put/get loop KEYLAST"
 
80
        set dbc [eval {$db cursor} $txn]
 
81
        error_check_good cursor [is_substr $dbc $db] 1
 
82
        while { [gets $did str] != -1 && $count < $nentries } {
 
83
                if { [is_record_based $method] == 1 } {
 
84
                        global kvals
 
85
 
 
86
                        set key [expr $count + 1]
 
87
                        set kvals($key) $str
 
88
                } else {
 
89
                        set key $str
 
90
                }
 
91
                set ret [eval {$dbc put} $txn $pflags {-keylast $key $str}]
 
92
                error_check_good put $ret 0
 
93
 
 
94
                set ret [eval {$db get} $txn $gflags {$key}]
 
95
                error_check_good get [lindex [lindex $ret 0] 1] $str
 
96
                incr count
 
97
        }
 
98
        error_check_good dbc_close [$dbc close] 0
 
99
        close $did
 
100
 
 
101
        # Now we will get each key from the DB and compare the results
 
102
        # to the original.
 
103
        puts "\tTest036.c: dump file"
 
104
        dump_file $db $txn $t1 $checkfunc
 
105
        error_check_good db_close [$db close] 0
 
106
 
 
107
        # Now compare the keys to see if they match the dictionary (or ints)
 
108
        if { [is_record_based $method] == 1 } {
 
109
                set oid [open $t2 w]
 
110
                for {set i 1} {$i <= $nentries} {set i [incr i]} {
 
111
                        puts $oid $i
 
112
                }
 
113
                close $oid
 
114
                file rename -force $t1 $t3
 
115
        } else {
 
116
                set q q
 
117
                filehead $nentries $dict $t3
 
118
                filesort $t3 $t2
 
119
                filesort $t1 $t3
 
120
        }
 
121
 
 
122
}
 
123
 
 
124
# Check function for test036; keys and data are identical
 
125
proc test036.check { key data } {
 
126
        error_check_good "key/data mismatch" $data $key
 
127
}
 
128
 
 
129
proc test036_recno.check { key data } {
 
130
        global dict
 
131
        global kvals
 
132
 
 
133
        error_check_good key"$key"_exists [info exists kvals($key)] 1
 
134
        error_check_good "key/data mismatch, key $key" $data $kvals($key)
 
135
}