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

« back to all changes in this revision

Viewing changes to db/test/sdb001.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:
 
1
# See the file LICENSE for redistribution information.
 
2
#
 
3
# Copyright (c) 1999-2001
 
4
#       Sleepycat Software.  All rights reserved.
 
5
#
 
6
# $Id: sdb001.tcl,v 11.13 2001/01/25 18:23:06 bostic Exp $
 
7
#
 
8
# Sub DB Test 1 {access method}
 
9
# Test non-subdb and subdb operations
 
10
# Test naming (filenames begin with -)
 
11
# Test existence (cannot create subdb of same name with -excl)
 
12
proc subdb001 { method args } {
 
13
        source ./include.tcl
 
14
 
 
15
        set args [convert_args $method $args]
 
16
        set omethod [convert_method $method]
 
17
 
 
18
        puts "Subdb001: $method ($args) subdb and non-subdb tests"
 
19
 
 
20
        # Create the database and open the dictionary
 
21
        set testfile $testdir/subdb001.db
 
22
        set subdb subdb0
 
23
        cleanup $testdir NULL
 
24
        puts "\tSubdb001.a: Non-subdb database and subdb operations"
 
25
        #
 
26
        # Create a db with no subdbs.  Add some data.  Close.  Try to
 
27
        # open/add with a subdb.  Should fail.
 
28
        #
 
29
        puts "\tSubdb001.a.0: Create db, add data, close, try subdb"
 
30
        set db [eval {berkdb_open -create -truncate -mode 0644} \
 
31
            $args {$omethod $testfile}]
 
32
        error_check_good dbopen [is_valid_db $db] TRUE
 
33
 
 
34
        set did [open $dict]
 
35
 
 
36
        set pflags ""
 
37
        set gflags ""
 
38
        set txn ""
 
39
        set count 0
 
40
 
 
41
        if { [is_record_based $method] == 1 } {
 
42
                append gflags " -recno"
 
43
        }
 
44
        while { [gets $did str] != -1 && $count < 5 } {
 
45
                if { [is_record_based $method] == 1 } {
 
46
                        global kvals
 
47
 
 
48
                        set key [expr $count + 1]
 
49
                        set kvals($key) $str
 
50
                } else {
 
51
                        set key $str
 
52
                }
 
53
                set ret [eval \
 
54
                    {$db put} $txn $pflags {$key [chop_data $method $str]}]
 
55
                error_check_good put $ret 0
 
56
 
 
57
                set ret [eval {$db get} $gflags {$key}]
 
58
                error_check_good \
 
59
                    get $ret [list [list $key [pad_data $method $str]]]
 
60
                incr count
 
61
        }
 
62
        close $did
 
63
        error_check_good db_close [$db close] 0
 
64
        set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \
 
65
            {$omethod $testfile $subdb}} db]
 
66
        error_check_bad dbopen $ret 0
 
67
        #
 
68
        # Create a db with no subdbs.  Add no data.  Close.  Try to
 
69
        # open/add with a subdb.  Should fail.
 
70
        #
 
71
        set testfile $testdir/subdb001a.db
 
72
        puts "\tSubdb001.a.1: Create db, close, try subdb"
 
73
        set db [eval {berkdb_open -create -truncate -mode 0644} $args \
 
74
            {$omethod $testfile}]
 
75
        error_check_good dbopen [is_valid_db $db] TRUE
 
76
        error_check_good db_close [$db close] 0
 
77
 
 
78
        set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \
 
79
            {$omethod $testfile $subdb}} db]
 
80
        error_check_bad dbopen $ret 0
 
81
 
 
82
        if { [is_queue $method] == 1 } {
 
83
                puts "Subdb001: skipping remainder of test for method $method"
 
84
                return
 
85
        }
 
86
 
 
87
        #
 
88
        # Test naming, db and subdb names beginning with -.
 
89
        #
 
90
        puts "\tSubdb001.b: Naming"
 
91
        set cwd [pwd]
 
92
        cd $testdir
 
93
        set testfile1 -subdb001.db
 
94
        set subdb -subdb
 
95
        puts "\tSubdb001.b.0: Create db and subdb with -name, no --"
 
96
        set ret [catch {eval {berkdb_open -create -mode 0644} $args \
 
97
            {$omethod $testfile1 $subdb}} db]
 
98
        error_check_bad dbopen $ret 0
 
99
        puts "\tSubdb001.b.1: Create db and subdb with -name, with --"
 
100
        set db [eval {berkdb_open -create -mode 0644} $args \
 
101
            {$omethod -- $testfile1 $subdb}]
 
102
        error_check_good dbopen [is_valid_db $db] TRUE
 
103
        error_check_good db_close [$db close] 0
 
104
 
 
105
        cd $cwd
 
106
 
 
107
        #
 
108
        # Create 1 db with 1 subdb.  Try to create another subdb of
 
109
        # the same name.  Should fail.
 
110
        #
 
111
        puts "\tSubdb001.c: Existence check"
 
112
        set testfile $testdir/subdb001c.db
 
113
        set subdb subdb
 
114
        set ret [catch {eval {berkdb_open -create -excl -mode 0644} $args \
 
115
            {$omethod $testfile $subdb}} db]
 
116
        error_check_good dbopen [is_valid_db $db] TRUE
 
117
        set ret [catch {eval {berkdb_open_noerr -create -excl -mode 0644} \
 
118
            $args {$omethod $testfile $subdb}} db1]
 
119
        error_check_bad dbopen $ret 0
 
120
        error_check_good db_close [$db close] 0
 
121
 
 
122
        return
 
123
}