← Back to branch summary

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

« back to all changes in this revision

Viewing changes to db/test/test019.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/test019.tcl
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1996-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: test019.tcl,v 11.17 2001/07/02 01:08:46 bostic Exp $
 
7
#
 
8
# Test019 { access_method nentries }
 
9
# Test the partial get functionality.
 
10
proc test019 { method {nentries 10000} args } {
 
11
        global fixed_len
 
12
        global rand_init
 
13
        source ./include.tcl
 
14
 
 
15
        set args [convert_args $method $args]
 
16
        set omethod [convert_method $method]
 
17
        puts "Test019: $method ($args) $nentries partial get test"
 
18
 
 
19
        # Create the database and open the dictionary
 
20
        set eindex [lsearch -exact $args "-env"]
 
21
        #
 
22
        # If we are using an env, then testfile should just be the db name.
 
23
        # Otherwise it is the test directory and the name.
 
24
        if { $eindex == -1 } {
 
25
                set testfile $testdir/test019.db
 
26
                set env NULL
 
27
        } else {
 
28
                set testfile test019.db
 
29
                incr eindex
 
30
                set env [lindex $args $eindex]
 
31
        }
 
32
        cleanup $testdir $env
 
33
 
 
34
        set db [eval {berkdb_open \
 
35
             -create -truncate -mode 0644} $args {$omethod $testfile}]
 
36
        error_check_good dbopen [is_valid_db $db] TRUE
 
37
        set did [open $dict]
 
38
        berkdb srand $rand_init
 
39
 
 
40
        set pflags ""
 
41
        set gflags ""
 
42
        set txn ""
 
43
        set count 0
 
44
 
 
45
        if { [is_record_based $method] == 1 } {
 
46
                append gflags " -recno"
 
47
        }
 
48
 
 
49
        puts "\tTest019.a: put/get loop"
 
50
        for { set i 0 } { [gets $did str] != -1 && $i < $nentries } \
 
51
            { incr i } {
 
52
 
 
53
                if { [is_record_based $method] == 1 } {
 
54
                        set key [expr $i + 1]
 
55
                } else {
 
56
                        set key $str
 
57
                }
 
58
                set repl [berkdb random_int $fixed_len 100]
 
59
                set data [chop_data $method [replicate $str $repl]]
 
60
                set ret [eval {$db put} $txn {-nooverwrite $key $data}]
 
61
                error_check_good dbput:$key $ret 0
 
62
 
 
63
                set ret [eval {$db get} $txn $gflags {$key}]
 
64
                error_check_good \
 
65
                    dbget:$key $ret [list [list $key [pad_data $method $data]]]
 
66
                set kvals($key) $repl
 
67
        }
 
68
        close $did
 
69
 
 
70
        puts "\tTest019.b: partial get loop"
 
71
        set did [open $dict]
 
72
        for { set i 0 } { [gets $did str] != -1 && $i < $nentries } \
 
73
            { incr i } {
 
74
                if { [is_record_based $method] == 1 } {
 
75
                        set key [expr $i + 1]
 
76
                } else {
 
77
                        set key $str
 
78
                }
 
79
                set data [pad_data $method [replicate $str $kvals($key)]]
 
80
 
 
81
                set maxndx [expr [string length $data] - 1]
 
82
 
 
83
                set beg [berkdb random_int 0 [expr $maxndx - 1]]
 
84
                set len [berkdb random_int 0 [expr $maxndx * 2]]
 
85
 
 
86
                set ret [eval {$db get} \
 
87
                    $txn {-partial [list $beg $len]} $gflags {$key}]
 
88
 
 
89
                # In order for tcl to handle this, we have to overwrite the
 
90
                # last character with a NULL.  That makes the length one less
 
91
                # than we expect.
 
92
                set k [lindex [lindex $ret 0] 0]
 
93
                set d [lindex [lindex $ret 0] 1]
 
94
                error_check_good dbget_key $k $key
 
95
 
 
96
                error_check_good dbget_data $d \
 
97
                    [string range $data $beg [expr $beg + $len - 1]]
 
98
 
 
99
        }
 
100
        error_check_good db_close [$db close] 0
 
101
        close $did
 
102
}