1# See the file LICENSE for redistribution information.
2#
3# Copyright (c) 1996,2008 Oracle.  All rights reserved.
4#
5# $Id: test023.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $
6#
7# TEST	test023
8# TEST	Duplicate test
9# TEST	Exercise deletes and cursor operations within a duplicate set.
10# TEST	Add a key with duplicates (first time on-page, second time off-page)
11# TEST	Number the dups.
12# TEST	Delete dups and make sure that CURRENT/NEXT/PREV work correctly.
13proc test023 { method args } {
14	global alphabet
15	global dupnum
16	global dupstr
17	global errorInfo
18	source ./include.tcl
19
20	set args [convert_args $method $args]
21	set omethod [convert_method $method]
22	puts "Test023: $method delete duplicates/check cursor operations"
23	if { [is_record_based $method] == 1 || \
24	    [is_rbtree $method] == 1 } {
25		puts "Test023: skipping for method $omethod"
26		return
27	}
28
29	# Create the database and open the dictionary
30	set txnenv 0
31	set eindex [lsearch -exact $args "-env"]
32	#
33	# If we are using an env, then testfile should just be the db name.
34	# Otherwise it is the test directory and the name.
35	if { $eindex == -1 } {
36		set testfile $testdir/test023.db
37		set env NULL
38	} else {
39		set testfile test023.db
40		incr eindex
41		set env [lindex $args $eindex]
42		set txnenv [is_txnenv $env]
43		if { $txnenv == 1 } {
44			append args " -auto_commit "
45		}
46		set testdir [get_home $env]
47	}
48	set t1 $testdir/t1
49	cleanup $testdir $env
50	set db [eval {berkdb_open \
51	    -create -mode 0644 -dup} $args {$omethod $testfile}]
52	error_check_good dbopen [is_valid_db $db] TRUE
53
54	set pflags ""
55	set gflags ""
56	set txn ""
57
58	if { $txnenv == 1 } {
59		set t [$env txn]
60		error_check_good txn [is_valid_txn $t $env] TRUE
61		set txn "-txn $t"
62	}
63	set dbc [eval {$db cursor} $txn]
64	error_check_good db_cursor [is_valid_cursor $dbc $db] TRUE
65
66	foreach i { onpage offpage } {
67		if { $i == "onpage" } {
68			set dupstr DUP
69		} else {
70			set dupstr [repeat $alphabet 50]
71		}
72		puts "\tTest023.a: Insert key w/$i dups"
73		set key "duplicate_val_test"
74		for { set count 0 } { $count < 20 } { incr count } {
75			set ret \
76			    [eval {$db put} $txn $pflags {$key $count$dupstr}]
77			error_check_good db_put $ret 0
78		}
79
80		# Now let's get all the items and make sure they look OK.
81		puts "\tTest023.b: Check initial duplicates"
82		set dupnum 0
83		dump_file $db $txn $t1 test023.check
84
85		# Delete a couple of random items (FIRST, LAST one in middle)
86		# Make sure that current returns an error and that NEXT and
87		# PREV do the right things.
88
89		set ret [$dbc get -set $key]
90		error_check_bad dbc_get:SET [llength $ret] 0
91
92		puts "\tTest023.c: Delete first and try gets"
93		# This should be the first duplicate
94		error_check_good \
95		    dbc_get:SET $ret [list [list duplicate_val_test 0$dupstr]]
96
97		# Now delete it.
98		set ret [$dbc del]
99		error_check_good dbc_del:FIRST $ret 0
100
101		# Now current should fail
102		set ret [$dbc get -current]
103		error_check_good dbc_get:CURRENT $ret ""
104
105		# Now Prev should fail
106		set ret [$dbc get -prev]
107		error_check_good dbc_get:prev0 [llength $ret] 0
108
109		# Now 10 nexts should work to get us in the middle
110		for { set j 1 } { $j <= 10 } { incr j } {
111			set ret [$dbc get -next]
112			error_check_good \
113			    dbc_get:next [llength [lindex $ret 0]] 2
114			error_check_good \
115			    dbc_get:next [lindex [lindex $ret 0] 1] $j$dupstr
116		}
117
118		puts "\tTest023.d: Delete middle and try gets"
119		# Now do the delete on the current key.
120		set ret [$dbc del]
121		error_check_good dbc_del:10 $ret 0
122
123		# Now current should fail
124		set ret [$dbc get -current]
125		error_check_good dbc_get:deleted $ret ""
126
127		# Prev and Next should work
128		set ret [$dbc get -next]
129		error_check_good dbc_get:next [llength [lindex $ret 0]] 2
130		error_check_good \
131		    dbc_get:next [lindex [lindex $ret 0] 1] 11$dupstr
132
133		set ret [$dbc get -prev]
134		error_check_good dbc_get:next [llength [lindex $ret 0]] 2
135		error_check_good \
136		    dbc_get:next [lindex [lindex $ret 0] 1] 9$dupstr
137
138		# Now go to the last one
139		for { set j 11 } { $j <= 19 } { incr j } {
140			set ret [$dbc get -next]
141			error_check_good \
142			    dbc_get:next [llength [lindex $ret 0]] 2
143			error_check_good \
144			    dbc_get:next [lindex [lindex $ret 0] 1] $j$dupstr
145		}
146
147		puts "\tTest023.e: Delete last and try gets"
148		# Now do the delete on the current key.
149		set ret [$dbc del]
150		error_check_good dbc_del:LAST $ret 0
151
152		# Now current should fail
153		set ret [$dbc get -current]
154		error_check_good dbc_get:deleted $ret ""
155
156		# Next should fail
157		set ret [$dbc get -next]
158		error_check_good dbc_get:next19 [llength $ret] 0
159
160		# Prev should work
161		set ret [$dbc get -prev]
162		error_check_good dbc_get:next [llength [lindex $ret 0]] 2
163		error_check_good \
164		    dbc_get:next [lindex [lindex $ret 0] 1] 18$dupstr
165
166		# Now overwrite the current one, then count the number
167		# of data items to make sure that we have the right number.
168
169		puts "\tTest023.f: Count keys, overwrite current, count again"
170		# At this point we should have 17 keys the (initial 20 minus
171		# 3 deletes)
172		set dbc2 [eval {$db cursor} $txn]
173		error_check_good db_cursor:2 [is_substr $dbc2 $db] 1
174
175		set count_check 0
176		for { set rec [$dbc2 get -first] } {
177		    [llength $rec] != 0 } { set rec [$dbc2 get -next] } {
178			incr count_check
179		}
180		error_check_good numdups $count_check 17
181
182		set ret [$dbc put -current OVERWRITE]
183		error_check_good dbc_put:current $ret 0
184
185		set count_check 0
186		for { set rec [$dbc2 get -first] } {
187		    [llength $rec] != 0 } { set rec [$dbc2 get -next] } {
188			incr count_check
189		}
190		error_check_good numdups $count_check 17
191		error_check_good dbc2_close [$dbc2 close] 0
192
193		# Done, delete all the keys for next iteration
194		set ret [eval {$db del} $txn {$key}]
195		error_check_good db_delete $ret 0
196
197		# database should be empty
198
199		set ret [$dbc get -first]
200		error_check_good first_after_empty [llength $ret] 0
201	}
202
203	error_check_good dbc_close [$dbc close] 0
204	if { $txnenv == 1 } {
205		error_check_good txn [$t commit] 0
206	}
207	error_check_good db_close [$db close] 0
208
209}
210
211# Check function for test023; keys and data are identical
212proc test023.check { key data } {
213	global dupnum
214	global dupstr
215	error_check_good "bad key" $key duplicate_val_test
216	error_check_good "data mismatch for $key" $data $dupnum$dupstr
217	incr dupnum
218}
219