1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2004
# Sleepycat Software. All rights reserved.
#
# $Id: sdb001.tcl,v 11.23 2004/04/05 17:49:25 carol Exp $
#
# TEST sdb001 Tests mixing db and subdb operations
# TEST Tests mixing db and subdb operations
# TEST Create a db, add data, try to create a subdb.
# TEST Test naming db and subdb with a leading - for correct parsing
# TEST Existence check -- test use of -excl with subdbs
# TEST
# TEST Test non-subdb and subdb operations
# TEST Test naming (filenames begin with -)
# TEST Test existence (cannot create subdb of same name with -excl)
proc sdb001 { method args } {
source ./include.tcl
global errorInfo
set args [convert_args $method $args]
set omethod [convert_method $method]
if { [is_queue $method] == 1 } {
puts "Subdb001: skipping for method $method"
return
}
puts "Subdb001: $method ($args) subdb and non-subdb tests"
set testfile $testdir/subdb001.db
set eindex [lsearch -exact $args "-env"]
if { $eindex != -1 } {
set env NULL
incr eindex
set env [lindex $args $eindex]
puts "Subdb001 skipping for env $env"
return
}
# Create the database and open the dictionary
set subdb subdb0
cleanup $testdir NULL
puts "\tSubdb001.a: Non-subdb database and subdb operations"
#
# Create a db with no subdbs. Add some data. Close. Try to
# open/add with a subdb. Should fail.
#
puts "\tSubdb001.a.0: Create db, add data, close, try subdb"
set db [eval {berkdb_open -create -mode 0644} \
$args {$omethod $testfile}]
error_check_good dbopen [is_valid_db $db] TRUE
set did [open $dict]
set pflags ""
set gflags ""
set count 0
if { [is_record_based $method] == 1 } {
append gflags " -recno"
}
while { [gets $did str] != -1 && $count < 5 } {
if { [is_record_based $method] == 1 } {
global kvals
set key [expr $count + 1]
set kvals($key) $str
} else {
set key $str
}
set ret [eval \
{$db put} $pflags {$key [chop_data $method $str]}]
error_check_good put $ret 0
set ret [eval {$db get} $gflags {$key}]
error_check_good \
get $ret [list [list $key [pad_data $method $str]]]
incr count
}
close $did
error_check_good db_close [$db close] 0
set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \
{$omethod $testfile $subdb}} db]
error_check_bad dbopen $ret 0
#
# Create a db with no subdbs. Add no data. Close. Try to
# open/add with a subdb. Should fail.
#
set testfile $testdir/subdb001a.db
puts "\tSubdb001.a.1: Create db, close, try subdb"
#
# !!!
# Using -truncate is illegal when opening for subdbs, but we
# can use it here because we are not using subdbs for this
# create.
#
set db [eval {berkdb_open -create -truncate -mode 0644} $args \
{$omethod $testfile}]
error_check_good dbopen [is_valid_db $db] TRUE
error_check_good db_close [$db close] 0
set ret [catch {eval {berkdb_open_noerr -create -mode 0644} $args \
{$omethod $testfile $subdb}} db]
error_check_bad dbopen $ret 0
if { [is_queue $method] == 1 } {
puts "Subdb001: skipping remainder of test for method $method"
return
}
#
# Test naming, db and subdb names beginning with -.
#
puts "\tSubdb001.b: Naming"
set cwd [pwd]
cd $testdir
set testfile1 -subdb001.db
set subdb -subdb
puts "\tSubdb001.b.0: Create db and subdb with -name, no --"
set ret [catch {eval {berkdb_open -create -mode 0644} $args \
{$omethod $testfile1 $subdb}} db]
error_check_bad dbopen $ret 0
puts "\tSubdb001.b.1: Create db and subdb with -name, with --"
set db [eval {berkdb_open -create -mode 0644} $args \
{$omethod -- $testfile1 $subdb}]
error_check_good dbopen [is_valid_db $db] TRUE
error_check_good db_close [$db close] 0
cd $cwd
#
# Create 1 db with 1 subdb. Try to create another subdb of
# the same name. Should fail.
#
puts "\tSubdb001.c: Existence check"
set testfile $testdir/subdb001d.db
set subdb subdb
set ret [catch {eval {berkdb_open -create -excl -mode 0644} $args \
{$omethod $testfile $subdb}} db]
error_check_good dbopen [is_valid_db $db] TRUE
set ret [catch {eval {berkdb_open_noerr -create -excl -mode 0644} \
$args {$omethod $testfile $subdb}} db1]
error_check_bad dbopen $ret 0
error_check_good db_close [$db close] 0
return
}
|
