1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 2000,2008 Oracle.  All rights reserved.
4#
5# $Id: test085.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test085
8# TEST	Test of cursor behavior when a cursor is pointing to a deleted
9# TEST	btree key which then has duplicates added. [#2473]
10proc test085 { method {pagesize 512} {onp 3} {offp 10} {tnum "085"} args } {
11	source ./include.tcl
12	global alphabet
13
14	set omethod [convert_method $method]
15	set args [convert_args $method $args]
16	set encargs ""
17	set args [split_encargs $args encargs]
18
19	set txnenv 0
20	set eindex [lsearch -exact $args "-env"]
21	#
22	# If we are using an env, then testfile should just be the db name.
23	# Otherwise it is the test directory and the name.
24	if { $eindex == -1 } {
25		set testfile $testdir/test$tnum.db
26		set env NULL
27	} else {
28		set testfile test$tnum.db
29		incr eindex
30		set env [lindex $args $eindex]
31		set txnenv [is_txnenv $env]
32		if { $txnenv == 1 } {
33			append args " -auto_commit "
34		}
35		set testdir [get_home $env]
36	}
37
38	set pgindex [lsearch -exact $args "-pagesize"]
39	if { $pgindex != -1 } {
40		puts "Test085: skipping for specific pagesizes"
41		return
42	}
43	cleanup $testdir $env
44
45	# Keys must sort $prekey < $key < $postkey.
46	set prekey "AA"
47	set key "BBB"
48	set postkey "CCCC"
49
50	# Make these distinguishable from each other and from the
51	# alphabets used for the $key's data.
52	set predatum "1234567890"
53	set datum $alphabet
54	set postdatum "0987654321"
55	set txn ""
56
57	append args " -pagesize $pagesize -dup"
58
59	puts -nonewline "Test$tnum $omethod ($args): "
60
61	# Skip for all non-btrees.  (Rbtrees don't count as btrees, for
62	# now, since they don't support dups.)
63	if { [is_btree $method] != 1 } {
64		puts "Skipping for method $method."
65		return
66	} else {
67		puts "Duplicates w/ deleted item cursor."
68	}
69
70	# Repeat the test with both on-page and off-page numbers of dups.
71	foreach ndups "$onp $offp" {
72		# Put operations we want to test on a cursor set to the
73		# deleted item, the key to use with them, and what should
74		# come before and after them given a placement of
75		# the deleted item at the beginning or end of the dupset.
76		set final [expr $ndups - 1]
77		set putops {
78		{{-before} "" $predatum	{[test085_ddatum 0]} beginning}
79		{{-before} "" {[test085_ddatum $final]} $postdatum end}
80		{{-keyfirst} $key $predatum {[test085_ddatum 0]} beginning}
81		{{-keyfirst} $key $predatum {[test085_ddatum 0]} end}
82		{{-keylast} $key {[test085_ddatum $final]} $postdatum beginning}
83		{{-keylast} $key {[test085_ddatum $final]} $postdatum end}
84		{{-after} "" $predatum {[test085_ddatum 0]} beginning}
85		{{-after} "" {[test085_ddatum $final]} $postdatum end}
86		}
87
88		# Get operations we want to test on a cursor set to the
89		# deleted item, any args to get, and the expected key/data pair.
90		set getops {
91		{{-current} "" "" "" beginning}
92		{{-current} "" "" "" end}
93		{{-next} "" $key {[test085_ddatum 0]} beginning}
94		{{-next} "" $postkey $postdatum end}
95		{{-prev} "" $prekey $predatum beginning}
96		{{-prev} "" $key {[test085_ddatum $final]} end}
97		{{-first} "" $prekey $predatum beginning}
98		{{-first} "" $prekey $predatum end}
99		{{-last} "" $postkey $postdatum beginning}
100		{{-last} "" $postkey $postdatum end}
101		{{-nextdup} "" $key {[test085_ddatum 0]} beginning}
102		{{-nextdup} "" EMPTYLIST "" end}
103		{{-nextnodup} "" $postkey $postdatum beginning}
104		{{-nextnodup} "" $postkey $postdatum end}
105		{{-prevnodup} "" $prekey $predatum beginning}
106		{{-prevnodup} "" $prekey $predatum end}
107		}
108
109		set txn ""
110		foreach pair $getops {
111			set op [lindex $pair 0]
112			puts "\tTest$tnum: Get ($op) with $ndups duplicates,\
113			    cursor at the [lindex $pair 4]."
114			set db [eval {berkdb_open -create \
115			    -mode 0644} $omethod $encargs $args $testfile]
116			error_check_good "db open" [is_valid_db $db] TRUE
117
118			if { $txnenv == 1 } {
119				set t [$env txn]
120				error_check_good txn \
121				    [is_valid_txn $t $env] TRUE
122				set txn "-txn $t"
123			}
124			set dbc [test085_setup $db $txn]
125
126			set beginning [expr [string compare \
127			    [lindex $pair 4] "beginning"] == 0]
128
129			for { set i 0 } { $i < $ndups } { incr i } {
130				if { $beginning } {
131					error_check_good db_put($i) \
132					    [eval {$db put} $txn \
133					    {$key [test085_ddatum $i]}] 0
134				} else {
135					set c [eval {$db cursor} $txn]
136					set j [expr $ndups - $i - 1]
137					error_check_good db_cursor($j) \
138					    [is_valid_cursor $c $db] TRUE
139					set d [test085_ddatum $j]
140					error_check_good dbc_put($j) \
141					    [$c put -keyfirst $key $d] 0
142					error_check_good c_close [$c close] 0
143				}
144			}
145
146			set gargs [lindex $pair 1]
147			set ekey ""
148			set edata ""
149			eval set ekey [lindex $pair 2]
150			eval set edata [lindex $pair 3]
151
152			set dbt [eval $dbc get $op $gargs]
153			if { [string compare $ekey EMPTYLIST] == 0 || \
154			     [string compare $op -current] == 0 } {
155				error_check_good dbt($op,$ndups) \
156				    [llength $dbt] 0
157			} else {
158				error_check_good dbt($op,$ndups) $dbt \
159				    [list [list $ekey $edata]]
160			}
161			error_check_good "dbc close" [$dbc close] 0
162			if { $txnenv == 1 } {
163				error_check_good txn [$t commit] 0
164			}
165			error_check_good "db close" [$db close] 0
166			verify_dir $testdir "\t\t"
167
168			# Remove testfile so we can do without truncate flag.
169			# This is okay because we've already done verify and
170			# dump/load.
171			if { $env == "NULL" } {
172				set ret [eval {berkdb dbremove} \
173				    $encargs $testfile]
174			} elseif { $txnenv == 1 } {
175				set ret [eval "$env dbremove" \
176				    -auto_commit $encargs $testfile]
177			} else {
178				set ret [eval {berkdb dbremove} \
179				    -env $env $encargs $testfile]
180			}
181			error_check_good dbremove $ret 0
182
183		}
184
185		foreach pair $putops {
186			# Open and set up database.
187			set op [lindex $pair 0]
188			puts "\tTest$tnum: Put ($op) with $ndups duplicates,\
189			    cursor at the [lindex $pair 4]."
190			set db [eval {berkdb_open -create \
191			    -mode 0644} $omethod $args $encargs $testfile]
192			error_check_good "db open" [is_valid_db $db] TRUE
193
194			set beginning [expr [string compare \
195			    [lindex $pair 4] "beginning"] == 0]
196
197			if { $txnenv == 1 } {
198				set t [$env txn]
199				error_check_good txn [is_valid_txn $t $env] TRUE
200				set txn "-txn $t"
201			}
202			set dbc [test085_setup $db $txn]
203
204			# Put duplicates.
205			for { set i 0 } { $i < $ndups } { incr i } {
206				if { $beginning } {
207					error_check_good db_put($i) \
208					    [eval {$db put} $txn \
209					    {$key [test085_ddatum $i]}] 0
210				} else {
211					set c [eval {$db cursor} $txn]
212					set j [expr $ndups - $i - 1]
213					error_check_good db_cursor($j) \
214					    [is_valid_cursor $c $db] TRUE
215					set d [test085_ddatum $j]
216					error_check_good dbc_put($j) \
217					    [$c put -keyfirst $key $d] 0
218					error_check_good c_close [$c close] 0
219				}
220			}
221
222			# Set up cursors for stability test.
223			set pre_dbc [eval {$db cursor} $txn]
224			error_check_good pre_set [$pre_dbc get -set $prekey] \
225			    [list [list $prekey $predatum]]
226			set post_dbc [eval {$db cursor} $txn]
227			error_check_good post_set [$post_dbc get -set $postkey]\
228			    [list [list $postkey $postdatum]]
229			set first_dbc [eval {$db cursor} $txn]
230			error_check_good first_set \
231			    [$first_dbc get -get_both $key [test085_ddatum 0]] \
232			    [list [list $key [test085_ddatum 0]]]
233			set last_dbc [eval {$db cursor} $txn]
234			error_check_good last_set \
235			    [$last_dbc get -get_both $key [test085_ddatum \
236			    [expr $ndups - 1]]] \
237			    [list [list $key [test085_ddatum [expr $ndups -1]]]]
238
239			set k [lindex $pair 1]
240			set d_before ""
241			set d_after ""
242			eval set d_before [lindex $pair 2]
243			eval set d_after [lindex $pair 3]
244			set newdatum "NewDatum"
245			error_check_good dbc_put($op,$ndups) \
246			    [eval $dbc put $op $k $newdatum] 0
247			error_check_good dbc_prev($op,$ndups) \
248			    [lindex [lindex [$dbc get -prev] 0] 1] \
249			    $d_before
250			error_check_good dbc_current($op,$ndups) \
251			    [lindex [lindex [$dbc get -next] 0] 1] \
252			    $newdatum
253
254			error_check_good dbc_next($op,$ndups) \
255			    [lindex [lindex [$dbc get -next] 0] 1] \
256			    $d_after
257
258			# Verify stability of pre- and post- cursors.
259			error_check_good pre_stable [$pre_dbc get -current] \
260			    [list [list $prekey $predatum]]
261			error_check_good post_stable [$post_dbc get -current] \
262			    [list [list $postkey $postdatum]]
263			error_check_good first_stable \
264			    [$first_dbc get -current] \
265			    [list [list $key [test085_ddatum 0]]]
266			error_check_good last_stable \
267			    [$last_dbc get -current] \
268			    [list [list $key [test085_ddatum [expr $ndups -1]]]]
269
270			foreach c "$pre_dbc $post_dbc $first_dbc $last_dbc" {
271				error_check_good ${c}_close [$c close] 0
272			}
273
274			error_check_good "dbc close" [$dbc close] 0
275			if { $txnenv == 1 } {
276				error_check_good txn [$t commit] 0
277			}
278			error_check_good "db close" [$db close] 0
279			verify_dir $testdir "\t\t"
280
281			# Remove testfile so we can do without truncate flag.
282			# This is okay because we've already done verify and
283			# dump/load.
284			if { $env == "NULL" } {
285				set ret [eval {berkdb dbremove} \
286				    $encargs $testfile]
287			} elseif { $txnenv == 1 } {
288				set ret [eval "$env dbremove" \
289				    -auto_commit $encargs $testfile]
290			} else {
291				set ret [eval {berkdb dbremove} \
292				    -env $env $encargs $testfile]
293			}
294			error_check_good dbremove $ret 0
295		}
296	}
297}
298
299# Set up the test database;  put $prekey, $key, and $postkey with their
300# respective data, and then delete $key with a new cursor.  Return that
301# cursor, still pointing to the deleted item.
302proc test085_setup { db txn } {
303	upvar key key
304	upvar prekey prekey
305	upvar postkey postkey
306	upvar predatum predatum
307	upvar postdatum postdatum
308
309	# no one else should ever see this one!
310	set datum "bbbbbbbb"
311
312	error_check_good pre_put [eval {$db put} $txn {$prekey $predatum}] 0
313	error_check_good main_put [eval {$db put} $txn {$key $datum}] 0
314	error_check_good post_put [eval {$db put} $txn {$postkey $postdatum}] 0
315
316	set dbc [eval {$db cursor} $txn]
317	error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
318
319	error_check_good dbc_getset [$dbc get -get_both $key $datum] \
320	    [list [list $key $datum]]
321
322	error_check_good dbc_del [$dbc del] 0
323
324	return $dbc
325}
326
327proc test085_ddatum { a } {
328	global alphabet
329	return $a$alphabet
330}
331