blob: 22e4083c46c9dc1df285fc2a2ab3d2775de9438f (
plain)
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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999, 2000
# Sleepycat Software. All rights reserved.
#
# $Id: sdb005.tcl,v 11.12 2000/08/25 14:21:53 sue Exp $
#
# Test cursor operations between subdbs.
#
# 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 txn ""
cleanup $testdir NULL
set psize 8192
set testfile $testdir/subdb005.db
set duplist {-1 -1 -1 -1 -1}
build_all_subdb \
$testfile [list $method] [list $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"
for {set i 0} {$i < $numdb} {incr i} {
set db [berkdb_open -unknown $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
}
#
# 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 [$db get -recno $db_key($n)]
error_check_good \
db_get [expr [llength $d] == 0] 1
} else {
set d [$db get $db_key($n)]
error_check_good db_get [expr [llength $d] == 0] 1
}
}
#
# 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 [berkdb_open -unknown -rdonly $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
}
|
