1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test056.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test056
8# TEST	Cursor maintenance during deletes.
9# TEST	Check if deleting a key when a cursor is on a duplicate of that
10# TEST	key works.
11proc test056 { method args } {
12	global errorInfo
13	source ./include.tcl
14
15	set args [convert_args $method $args]
16	set omethod [convert_method $method]
17
18	append args " -create -mode 0644 -dup "
19	if { [is_record_based $method] == 1 || [is_rbtree $method] } {
20		puts "Test056: skipping for method $method"
21		return
22	}
23	puts "Test056: $method delete of key in presence of cursor"
24
25	# Create the database and open the dictionary
26	set txnenv 0
27	set eindex [lsearch -exact $args "-env"]
28	#
29	# If we are using an env, then testfile should just be the db name.
30	# Otherwise it is the test directory and the name.
31	if { $eindex == -1 } {
32		set testfile $testdir/test056.db
33		set env NULL
34	} else {
35		set testfile test056.db
36		incr eindex
37		set env [lindex $args $eindex]
38		set txnenv [is_txnenv $env]
39		if { $txnenv == 1 } {
40			append args " -auto_commit "
41		}
42		set testdir [get_home $env]
43	}
44	cleanup $testdir $env
45
46	set flags ""
47	set txn  ""
48
49	set db [eval {berkdb_open} $args {$omethod $testfile}]
50	error_check_good db_open:dup [is_valid_db $db] TRUE
51
52	puts "\tTest056.a: Key delete with cursor on duplicate."
53	# Put three keys in the database
54	for { set key 1 } { $key <= 3 } {incr key} {
55		if { $txnenv == 1 } {
56			set t [$env txn]
57			error_check_good txn [is_valid_txn $t $env] TRUE
58			set txn "-txn $t"
59		}
60		set r [eval {$db put} $txn $flags {$key datum$key}]
61		error_check_good put $r 0
62		if { $txnenv == 1 } {
63			error_check_good txn [$t commit] 0
64		}
65	}
66
67	# Retrieve keys sequentially so we can figure out their order
68	set i 1
69	if { $txnenv == 1 } {
70		set t [$env txn]
71		error_check_good txn [is_valid_txn $t $env] TRUE
72		set txn "-txn $t"
73	}
74	set curs [eval {$db cursor} $txn]
75	error_check_good curs_open:dup [is_valid_cursor $curs $db] TRUE
76
77	for {set d [$curs get -first] } { [llength $d] != 0 } {
78	    set d [$curs get -next] } {
79		set key_set($i) [lindex [lindex $d 0] 0]
80		incr i
81	}
82
83	# Now put in a bunch of duplicates for key 2
84	for { set d 1 } { $d <= 5 } {incr d} {
85		set r [eval {$db put} $txn $flags {$key_set(2) dup_$d}]
86		error_check_good dup:put $r 0
87	}
88
89	# Now put the cursor on a duplicate of key 2
90
91	# Now set the cursor on the first of the duplicate set.
92	set r [$curs get -set $key_set(2)]
93	error_check_bad cursor_get:DB_SET [llength $r] 0
94	set k [lindex [lindex $r 0] 0]
95	set d [lindex [lindex $r 0] 1]
96	error_check_good curs_get:DB_SET:key $k $key_set(2)
97	error_check_good curs_get:DB_SET:data $d datum$key_set(2)
98
99	# Now do two nexts
100	set r [$curs get -next]
101	error_check_bad cursor_get:DB_NEXT [llength $r] 0
102	set k [lindex [lindex $r 0] 0]
103	set d [lindex [lindex $r 0] 1]
104	error_check_good curs_get:DB_NEXT:key $k $key_set(2)
105	error_check_good curs_get:DB_NEXT:data $d dup_1
106
107	set r [$curs get -next]
108	error_check_bad cursor_get:DB_NEXT [llength $r] 0
109	set k [lindex [lindex $r 0] 0]
110	set d [lindex [lindex $r 0] 1]
111	error_check_good curs_get:DB_NEXT:key $k $key_set(2)
112	error_check_good curs_get:DB_NEXT:data $d dup_2
113
114	# Now do the delete
115	set r [eval {$db del} $txn $flags {$key_set(2)}]
116	error_check_good delete $r 0
117
118	# Now check the get current on the cursor.
119	set ret [$curs get -current]
120	error_check_good curs_after_del $ret ""
121
122	# Now check that the rest of the database looks intact.  There
123	# should be only two keys, 1 and 3.
124
125	set r [$curs get -first]
126	error_check_bad cursor_get:DB_FIRST [llength $r] 0
127	set k [lindex [lindex $r 0] 0]
128	set d [lindex [lindex $r 0] 1]
129	error_check_good curs_get:DB_FIRST:key $k $key_set(1)
130	error_check_good curs_get:DB_FIRST:data $d datum$key_set(1)
131
132	set r [$curs get -next]
133	error_check_bad cursor_get:DB_NEXT [llength $r] 0
134	set k [lindex [lindex $r 0] 0]
135	set d [lindex [lindex $r 0] 1]
136	error_check_good curs_get:DB_NEXT:key $k $key_set(3)
137	error_check_good curs_get:DB_NEXT:data $d datum$key_set(3)
138
139	set r [$curs get -next]
140	error_check_good cursor_get:DB_NEXT [llength $r] 0
141
142	puts "\tTest056.b:\
143	    Cursor delete of first item, followed by cursor FIRST"
144	# Set to beginning
145	set r [$curs get -first]
146	error_check_bad cursor_get:DB_FIRST [llength $r] 0
147	set k [lindex [lindex $r 0] 0]
148	set d [lindex [lindex $r 0] 1]
149	error_check_good curs_get:DB_FIRST:key $k $key_set(1)
150	error_check_good curs_get:DB_FIRST:data $d datum$key_set(1)
151
152	# Now do delete
153	error_check_good curs_del [$curs del] 0
154
155	# Now do DB_FIRST
156	set r [$curs get -first]
157	error_check_bad cursor_get:DB_FIRST [llength $r] 0
158	set k [lindex [lindex $r 0] 0]
159	set d [lindex [lindex $r 0] 1]
160	error_check_good curs_get:DB_FIRST:key $k $key_set(3)
161	error_check_good curs_get:DB_FIRST:data $d datum$key_set(3)
162
163	error_check_good curs_close [$curs close] 0
164	if { $txnenv == 1 } {
165		error_check_good txn [$t commit] 0
166	}
167	error_check_good db_close [$db close] 0
168}
169