blob: ade3890c3f9c83ed8d0209bcd5351d36758f5792 (
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
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
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998, 1999, 2000
# Sleepycat Software. All rights reserved.
#
# $Id: test056.tcl,v 11.13 2000/08/25 14:21:57 sue Exp $
#
# Test056
# Check if deleting a key when a cursor is on a duplicate of that key works.
proc test056 { method args } {
global errorInfo
source ./include.tcl
set args [convert_args $method $args]
set omethod [convert_method $method]
append args " -create -truncate -mode 0644 -dup "
if { [is_record_based $method] == 1 || [is_rbtree $method] } {
puts "Test056: skipping for method $method"
return
}
puts "Test056: $method delete of key in presence of cursor"
# Create the database and open the dictionary
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/test056.db
set env NULL
} else {
set testfile test056.db
incr eindex
set env [lindex $args $eindex]
}
cleanup $testdir $env
set flags ""
set txn ""
set db [eval {berkdb_open} $args {$omethod $testfile}]
error_check_good db_open:dup [is_valid_db $db] TRUE
set curs [eval {$db cursor} $txn]
error_check_good curs_open:dup [is_substr $curs $db] 1
puts "\tTest056.a: Key delete with cursor on duplicate."
# Put three keys in the database
for { set key 1 } { $key <= 3 } {incr key} {
set r [eval {$db put} $txn $flags {$key datum$key}]
error_check_good put $r 0
}
# Retrieve keys sequentially so we can figure out their order
set i 1
for {set d [$curs get -first] } { [llength $d] != 0 } {
set d [$curs get -next] } {
set key_set($i) [lindex [lindex $d 0] 0]
incr i
}
# Now put in a bunch of duplicates for key 2
for { set d 1 } { $d <= 5 } {incr d} {
set r [eval {$db put} $txn $flags {$key_set(2) dup_$d}]
error_check_good dup:put $r 0
}
# Now put the cursor on a duplicate of key 2
# Now set the cursor on the first of the duplicate set.
set r [$curs get -set $key_set(2)]
error_check_bad cursor_get:DB_SET [llength $r] 0
set k [lindex [lindex $r 0] 0]
set d [lindex [lindex $r 0] 1]
error_check_good curs_get:DB_SET:key $k $key_set(2)
error_check_good curs_get:DB_SET:data $d datum$key_set(2)
# Now do two nexts
set r [$curs get -next]
error_check_bad cursor_get:DB_NEXT [llength $r] 0
set k [lindex [lindex $r 0] 0]
set d [lindex [lindex $r 0] 1]
error_check_good curs_get:DB_NEXT:key $k $key_set(2)
error_check_good curs_get:DB_NEXT:data $d dup_1
set r [$curs get -next]
error_check_bad cursor_get:DB_NEXT [llength $r] 0
set k [lindex [lindex $r 0] 0]
set d [lindex [lindex $r 0] 1]
error_check_good curs_get:DB_NEXT:key $k $key_set(2)
error_check_good curs_get:DB_NEXT:data $d dup_2
# Now do the delete
set r [eval {$db del} $txn $flags {$key_set(2)}]
error_check_good delete $r 0
# Now check the get current on the cursor.
set ret [$curs get -current]
error_check_good curs_after_del $ret [list [list [] []]]
# Now check that the rest of the database looks intact. There
# should be only two keys, 1 and 3.
set r [$curs get -first]
error_check_bad cursor_get:DB_FIRST [llength $r] 0
set k [lindex [lindex $r 0] 0]
set d [lindex [lindex $r 0] 1]
error_check_good curs_get:DB_FIRST:key $k $key_set(1)
error_check_good curs_get:DB_FIRST:data $d datum$key_set(1)
set r [$curs get -next]
error_check_bad cursor_get:DB_NEXT [llength $r] 0
set k [lindex [lindex $r 0] 0]
set d [lindex [lindex $r 0] 1]
error_check_good curs_get:DB_NEXT:key $k $key_set(3)
error_check_good curs_get:DB_NEXT:data $d datum$key_set(3)
set r [$curs get -next]
error_check_good cursor_get:DB_NEXT [llength $r] 0
puts "\tTest056.b:\
Cursor delete of first item, followed by cursor FIRST"
# Set to beginning
set r [$curs get -first]
error_check_bad cursor_get:DB_FIRST [llength $r] 0
set k [lindex [lindex $r 0] 0]
set d [lindex [lindex $r 0] 1]
error_check_good curs_get:DB_FIRST:key $k $key_set(1)
error_check_good curs_get:DB_FIRST:data $d datum$key_set(1)
# Now do delete
error_check_good curs_del [$curs del] 0
# Now do DB_FIRST
set r [$curs get -first]
error_check_bad cursor_get:DB_FIRST [llength $r] 0
set k [lindex [lindex $r 0] 0]
set d [lindex [lindex $r 0] 1]
error_check_good curs_get:DB_FIRST:key $k $key_set(3)
error_check_good curs_get:DB_FIRST:data $d datum$key_set(3)
error_check_good curs_close [$curs close] 0
error_check_good db_close [$db close] 0
}
|
