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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2002
# Sleepycat Software. All rights reserved.
#
# $Id: sdb005.tcl,v 1.1.1.1 2003/11/20 22:13:58 toshok Exp $
#
# TEST subdb005
# TEST Tests cursor operations in subdbs
# TEST Put/get per key
# TEST Verify cursor operations work within subdb
# TEST Verify cursor operations do not work across subdbs
# TEST
#
# We should test this on all btrees, all hash, and a combination thereof
proc subdb005 {method {nentries 100} args } {
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
if { [is_queue $method] == 1 } {
puts "Subdb005: skipping for method $method"
return
}
puts "Subdb005: $method ( $args ) subdb cursor operations test"
set txnenv 0
set envargs ""
set eindex [lsearch -exact $args "-env"]
#
# If we are using an env, then testfile should just be the db name.
# Otherwise it is the test directory and the name.
if { $eindex == -1 } {
set testfile $testdir/subdb005.db
set env NULL
} else {
set testfile subdb005.db
incr eindex
set env [lindex $args $eindex]
set envargs " -env $env "
set txnenv [is_txnenv $env]
if { $txnenv == 1 } {
append args " -auto_commit "
append envargs " -auto_commit "
if { $nentries == 100 } {
set nentries 20
}
}
set testdir [get_home $env]
}
cleanup $testdir $env
set txn ""
set psize 8192
set duplist {-1 -1 -1 -1 -1}
build_all_subdb \
$testfile [list $method] $psize $duplist $nentries $args
set numdb [llength $duplist]
#
# Get a cursor in each subdb and move past the end of each
# subdb. Make sure we don't end up in another subdb.
#
puts "\tSubdb005.a: Cursor ops - first/prev and last/next"
if { $txnenv == 1 } {
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
}
for {set i 0} {$i < $numdb} {incr i} {
set db [eval {berkdb_open -unknown} $args {$testfile sub$i.db}]
error_check_good dbopen [is_valid_db $db] TRUE
set db_handle($i) $db
# Used in 005.c test
lappend subdbnames sub$i.db
set dbc [eval {$db cursor} $txn]
error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
set d [$dbc get -first]
error_check_good dbc_get [expr [llength $d] != 0] 1
# Used in 005.b test
set db_key($i) [lindex [lindex $d 0] 0]
set d [$dbc get -prev]
error_check_good dbc_get [expr [llength $d] == 0] 1
set d [$dbc get -last]
error_check_good dbc_get [expr [llength $d] != 0] 1
set d [$dbc get -next]
error_check_good dbc_get [expr [llength $d] == 0] 1
error_check_good dbc_close [$dbc close] 0
}
#
# Get a key from each subdb and try to get this key in a
# different subdb. Make sure it fails
#
puts "\tSubdb005.b: Get keys in different subdb's"
for {set i 0} {$i < $numdb} {incr i} {
set n [expr $i + 1]
if {$n == $numdb} {
set n 0
}
set db $db_handle($i)
if { [is_record_based $method] == 1 } {
set d [eval {$db get -recno} $txn {$db_key($n)}]
error_check_good \
db_get [expr [llength $d] == 0] 1
} else {
set d [eval {$db get} $txn {$db_key($n)}]
error_check_good db_get [expr [llength $d] == 0] 1
}
}
if { $txnenv == 1 } {
error_check_good txn [$t commit] 0
}
#
# Clean up
#
for {set i 0} {$i < $numdb} {incr i} {
error_check_good db_close [$db_handle($i) close] 0
}
#
# Check contents of DB for subdb names only. Makes sure that
# every subdbname is there and that nothing else is there.
#
puts "\tSubdb005.c: Check DB is read-only"
error_check_bad dbopen [catch \
{berkdb_open_noerr -unknown $testfile} ret] 0
puts "\tSubdb005.d: Check contents of DB for subdb names only"
set db [eval {berkdb_open -unknown -rdonly} $envargs {$testfile}]
error_check_good dbopen [is_valid_db $db] TRUE
set subdblist [$db get -glob *]
foreach kd $subdblist {
# subname also used in subdb005.e,f below
set subname [lindex $kd 0]
set i [lsearch $subdbnames $subname]
error_check_good subdb_search [expr $i != -1] 1
set subdbnames [lreplace $subdbnames $i $i]
}
error_check_good subdb_done [llength $subdbnames] 0
error_check_good db_close [$db close] 0
return
}
|
